steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Tree-shaker now computes which globals it needs to strip, not which ones it needs to keep

db4
Slava Pestov 2008-03-13 03:46:25 -05:00
parent 5d1dbeeaf6
commit cf4dee6e0f
10 changed files with 237 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
extra/tools/deploy/backend/backend.factor
View File

@ -34,31 +34,33 @@ IN: tools.deploy.backend
: ?, [ , ] [ drop ] if ;
: bootstrap-profile ( config -- profile )
: bootstrap-profile ( -- profile )
[
[
"math" deploy-math? get ?,
"compiler" deploy-compiler? get ?,
"ui" deploy-ui? get ?,
"io" native-io? ?,
] { } make
] bind ;
"math" deploy-math? get ?,
"compiler" deploy-compiler? get ?,
"ui" deploy-ui? get ?,
"io" native-io? ?,
] { } make ;
: staging-image-name ( profile -- name )
"staging." swap bootstrap-profile "-" join ".image" 3append ;
: staging-image-name ( -- name )
"staging."
bootstrap-profile strip-word-names? [ "strip" add ] when
"-" join ".image" 3append ;
: staging-command-line ( config -- flags )
[
"-i=" my-boot-image-name append ,
[
"-i=" my-boot-image-name append ,
"-output-image=" over staging-image-name append ,
"-output-image=" staging-image-name append ,
"-include=" swap bootstrap-profile " " join append ,
"-include=" bootstrap-profile " " join append ,
"-no-stack-traces" ,
strip-word-names? [ "-no-stack-traces" , ] when
"-no-user-init" ,
] { } make ;
"-no-user-init" ,
] { } make
] bind ;
: run-factor ( vm flags -- )
swap add* dup . run-with-output ; inline
@ -68,16 +70,18 @@ IN: tools.deploy.backend
: deploy-command-line ( image vocab config -- flags )
[
"-i=" swap staging-image-name append ,
[
"-i=" staging-image-name append ,
"-run=tools.deploy.shaker" ,
"-run=tools.deploy.shaker" ,
"-deploy-vocab=" swap append ,
"-deploy-vocab=" swap append ,
"-output-image=" swap append ,
"-output-image=" swap append ,
"-no-stack-traces" ,
] { } make ;
strip-word-names? [ "-no-stack-traces" , ] when
] { } make
] bind ;
: make-deploy-image ( vm image vocab config -- )
make-boot-image

2
extra/tools/deploy/config/config.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: vocabs.loader io.files io kernel sequences assocs
splitting parser prettyprint namespaces math vocabs
hashtables tools.browser ;
hashtables tools.vocabs ;
IN: tools.deploy.config
SYMBOL: deploy-name

24
extra/tools/deploy/deploy-tests.factor
View File

@ -5,7 +5,7 @@ tools.deploy.backend math ;
: shake-and-bake
"." resource-path [
vm
"hello.image" temp-file
"test.image" temp-file
rot dup deploy-config make-deploy-image
] with-directory ;
@ -15,8 +15,30 @@ tools.deploy.backend math ;
"hello.image" temp-file file-length 500000 <=
] unit-test
[ ] [ "sudoku" shake-and-bake ] unit-test
[ t ] [
"hello.image" temp-file file-length 1500000 <=
] unit-test
[ ] [ "hello-ui" shake-and-bake ] unit-test
[ t ] [
"hello.image" temp-file file-length 2000000 <=
] unit-test
[ ] [ "bunny" shake-and-bake ] unit-test
[ t ] [
"hello.image" temp-file file-length 3000000 <=
] unit-test
[ ] [
"tools.deploy.test.1" shake-and-bake
vm "-i=" "test.image" temp-file append try-process
] unit-test
[ ] [
"tools.deploy.test.2" shake-and-bake
vm "-i=" "test.image" temp-file append try-process
] unit-test

190
extra/tools/deploy/shaker/shaker.factor
View File

@ -1,11 +1,29 @@
! Copyright (C) 2007 Slava Pestov.
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces continuations.private kernel.private init
assocs kernel vocabs words sequences memory io system arrays
continuations math definitions mirrors splitting parser classes
inspector layouts vocabs.loader prettyprint.config prettyprint
debugger io.streams.c io.streams.duplex io.files io.backend
quotations words.private tools.deploy.config compiler.units ;
USING: qualified io.streams.c init fry namespaces assocs kernel
parser tools.deploy.config vocabs sequences words words.private
memory kernel.private continuations io prettyprint
vocabs.loader debugger system strings ;
QUALIFIED: bootstrap.stage2
QUALIFIED: classes
QUALIFIED: compiler.errors.private
QUALIFIED: compiler.units
QUALIFIED: continuations
QUALIFIED: definitions
QUALIFIED: init
QUALIFIED: inspector
QUALIFIED: io.backend
QUALIFIED: io.nonblocking
QUALIFIED: io.thread
QUALIFIED: layouts
QUALIFIED: libc.private
QUALIFIED: libc.private
QUALIFIED: listener
QUALIFIED: prettyprint.config
QUALIFIED: random.private
QUALIFIED: source-files
QUALIFIED: threads
QUALIFIED: vocabs
IN: tools.deploy.shaker
: strip-init-hooks ( -- )
@ -43,9 +61,6 @@ IN: tools.deploy.shaker
run-file
] when ;
: strip-assoc ( retained-keys assoc -- newassoc )
swap [ nip member? ] curry assoc-subset ;
: strip-word-names ( words -- )
"Stripping word names" show
[ f over set-word-name f swap set-word-vocabulary ] each ;
@ -57,8 +72,11 @@ IN: tools.deploy.shaker
: strip-word-props ( retain-props words -- )
"Stripping word properties" show
[
[ word-props strip-assoc f assoc-like ] keep
set-word-props
[
word-props swap
'[ , nip member? ] assoc-subset
f assoc-like
] keep set-word-props
] with each ;
: retained-props ( -- seq )
@ -81,10 +99,101 @@ IN: tools.deploy.shaker
strip-word-names? [ dup strip-word-names ] when
2drop ;
: strip-environment ( retain-globals -- )
: strip-recompile-hook ( -- )
[ [ f ] { } map>assoc ]
compiler.units:recompile-hook
set-global ;
: strip-vocab-globals ( except names -- words )
[ child-vocabs [ words ] map concat ] map concat seq-diff ;
: stripped-globals ( -- seq )
[
random.private:mt ,
{
bootstrap.stage2:bootstrap-time
continuations:error
continuations:error-continuation
continuations:error-thread
continuations:restarts
error-hook
init:init-hooks
inspector:inspector-hook
io.thread:io-thread
libc.private:mallocs
source-files:source-files
stderr
stdio
} %
deploy-threads? [
threads:initial-thread ,
] unless
strip-io? [ io.backend:io-backend , ] when
{ io.backend:io-backend io.nonblocking:default-buffer-size }
{ "alarms" "io" "tools" } strip-vocab-globals %
strip-dictionary? [
{ } { "cpu" } strip-vocab-globals %
{
vocabs:dictionary
lexer-factory
vocabs:load-vocab-hook
layouts:num-tags
layouts:num-types
layouts:tag-mask
layouts:tag-numbers
layouts:type-numbers
classes:typemap
vocab-roots
definitions:crossref
compiled-crossref
interactive-vocabs
word
compiler.units:recompile-hook
listener:listener-hook
lexer-factory
classes:update-map
classes:class<map
} %
] when
strip-prettyprint? [
{
prettyprint.config:margin
prettyprint.config:string-limit
prettyprint.config:tab-size
} %
] when
strip-debugger? [
{
compiler.errors.private:compiler-errors
continuations:thread-error-hook
} %
] when
deploy-c-types? get [
"c-types" "alien.c-types" lookup ,
] unless
deploy-ui? get [
"ui-error-hook" "ui.gadgets.worlds" lookup ,
] when
] { } make ;
: strip-globals ( stripped-globals -- )
strip-globals? [
"Stripping environment" show
global strip-assoc 21 setenv
"Stripping globals" show
global swap
'[ drop , member? not ] assoc-subset
[ drop string? not ] assoc-subset ! strip CLI args
dup keys .
21 setenv
] [ drop ] if ;
: finish-deploy ( final-image -- )
@ -108,55 +217,6 @@ SYMBOL: deploy-vocab
] [ ] make "Boot quotation: " write dup . flush
set-boot-quot ;
: retained-globals ( -- seq )
[
builtins ,
strip-io? [ io-backend , ] unless
strip-dictionary? [
{
dictionary
inspector-hook
lexer-factory
load-vocab-hook
num-tags
num-types
tag-bits
tag-mask
tag-numbers
typemap
vocab-roots
} %
] unless
strip-prettyprint? [
{
tab-size
margin
} %
] unless
deploy-c-types? get [
"c-types" "alien.c-types" lookup ,
] when
native-io? [
"default-buffer-size" "io.nonblocking" lookup ,
] when
deploy-ui? get [
"ui" child-vocabs
"cocoa" child-vocabs
deploy-vocab get child-vocabs 3append
global keys [ word? ] subset
swap [ >r word-vocabulary r> member? ] curry
subset %
] when
] { } make dup . ;
: strip-recompile-hook ( -- )
[ [ f ] { } map>assoc ] recompile-hook set-global ;
: strip ( -- )
strip-libc
strip-cocoa
@ -165,7 +225,7 @@ SYMBOL: deploy-vocab
strip-init-hooks
deploy-vocab get vocab-main set-boot-quot*
retained-props >r
retained-globals strip-environment
stripped-globals strip-globals
r> strip-words ;
: (deploy) ( final-image vocab config -- )

6
extra/tools/deploy/test/1/1.factor Executable file
View File

@ -0,0 +1,6 @@
IN: tools.deploy.test.1
USING: threads ;
: deploy-test-1 1000 sleep ;
MAIN: deploy-test-1

14
extra/tools/deploy/test/1/deploy.factor Executable file
View File

@ -0,0 +1,14 @@
USING: tools.deploy.config ;
H{
{ deploy-c-types? f }
{ deploy-io 2 }
{ deploy-reflection 1 }
{ deploy-threads? t }
{ deploy-word-props? f }
{ deploy-word-defs? f }
{ deploy-name "tools.deploy.test.1" }
{ deploy-math? t }
{ deploy-compiler? t }
{ "stop-after-last-window?" t }
{ deploy-ui? f }
}

6
extra/tools/deploy/test/2/2.factor Executable file
View File

@ -0,0 +1,6 @@
IN: tools.deploy.test.2
USING: calendar calendar.format ;
: deploy-test-2 now (timestamp>string) ;
MAIN: deploy-test-2

14
extra/tools/deploy/test/2/deploy.factor Executable file
View File

@ -0,0 +1,14 @@
USING: tools.deploy.config ;
H{
{ deploy-c-types? f }
{ deploy-io 2 }
{ deploy-reflection 1 }
{ deploy-threads? t }
{ deploy-word-props? f }
{ deploy-word-defs? f }
{ deploy-name "tools.deploy.test.2" }
{ deploy-math? t }
{ deploy-compiler? t }
{ "stop-after-last-window?" t }
{ deploy-ui? f }
}

8
extra/tools/deploy/test/3/3.factor Executable file
View File

@ -0,0 +1,8 @@
IN: tools.deploy.test.3
USING: io.encodings.ascii io.files kernel ;
: deploy-test-3
"resource:extra/tools/deploy/test/3/3.factor"
?resource-path ascii file-contents drop ;
MAIN: deploy-test-3

14
extra/tools/deploy/test/3/deploy.factor Executable file
View File

@ -0,0 +1,14 @@
USING: tools.deploy.config ;
H{
{ deploy-math? t }
{ deploy-reflection 1 }
{ deploy-name "tools.deploy.test.3" }
{ deploy-threads? t }
{ deploy-word-props? f }
{ "stop-after-last-window?" t }
{ deploy-ui? f }
{ deploy-io 3 }
{ deploy-compiler? t }
{ deploy-word-defs? f }
{ deploy-c-types? f }
}