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

More aggressive tree shaker

db4
slava 2008-07-05 03:07:10 -05:00
parent bae00e8bab
commit d9bb18b193
1 changed files with 31 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -4,7 +4,7 @@ USING: accessors qualified io.streams.c init fry namespaces
assocs kernel parser lexer strings.parser tools.deploy.config assocs kernel parser lexer strings.parser tools.deploy.config
vocabs sequences words words.private memory kernel.private vocabs sequences words words.private memory kernel.private
continuations io prettyprint vocabs.loader debugger system continuations io prettyprint vocabs.loader debugger system
strings sets ; strings sets vectors quotations byte-arrays ;
QUALIFIED: bootstrap.stage2 QUALIFIED: bootstrap.stage2
QUALIFIED: classes QUALIFIED: classes
QUALIFIED: command-line QUALIFIED: command-line
@ -79,8 +79,8 @@ IN: tools.deploy.shaker
[ [
[ [
props>> swap props>> swap
'[ drop , member? not ] assoc-filter '[ drop , member? not ] assoc-filter sift-assoc
sift-assoc f assoc-like dup assoc-empty? [ drop f ] [ >alist >vector ] if
] keep (>>props) ] keep (>>props)
] with each ; ] with each ;
@ -93,7 +93,10 @@ IN: tools.deploy.shaker
"compiled-uses" "compiled-uses"
"constraints" "constraints"
"declared-effect" "declared-effect"
"default"
"default-method"
"default-output-classes" "default-output-classes"
"derived-from"
"identities" "identities"
"if-intrinsics" "if-intrinsics"
"infer" "infer"
@ -103,15 +106,18 @@ IN: tools.deploy.shaker
"loc" "loc"
"members" "members"
"methods" "methods"
"method-class"
"method-generic"
"combination" "combination"
"cannot-infer" "cannot-infer"
"default-method" "no-compile"
"optimizer-hooks" "optimizer-hooks"
"output-classes" "output-classes"
"participants" "participants"
"predicate" "predicate"
"predicate-definition" "predicate-definition"
"predicating" "predicating"
"tuple-dispatch-generic"
"slots" "slots"
"slot-names" "slot-names"
"specializer" "specializer"
@ -127,6 +133,8 @@ IN: tools.deploy.shaker
strip-prettyprint? [ strip-prettyprint? [
{ {
"break-before"
"break-after"
"delimiter" "delimiter"
"flushable" "flushable"
"foldable" "foldable"
@ -265,13 +273,27 @@ IN: tools.deploy.shaker
21 setenv 21 setenv
] [ drop ] if ; ] [ drop ] if ;
: compress ( pred string -- )
"Compressing " prepend show
instances
dup H{ } clone [ [ ] cache ] curry map
become ; inline
: compress-byte-arrays ( -- )
[ byte-array? ] "byte arrays" compress ;
: compress-quotations ( -- )
[ quotation? ] "quotations" compress ;
: compress-strings ( -- )
[ string? ] "strings" compress ;
: finish-deploy ( final-image -- ) : finish-deploy ( final-image -- )
"Finishing up" show "Finishing up" show
>r { } set-datastack r> >r { } set-datastack r>
{ } set-retainstack { } set-retainstack
V{ } set-namestack V{ } set-namestack
V{ } set-catchstack V{ } set-catchstack
"Saving final image" show "Saving final image" show
[ save-image-and-exit ] call-clear ; [ save-image-and-exit ] call-clear ;
@ -295,7 +317,10 @@ SYMBOL: deploy-vocab
deploy-vocab get vocab-main set-boot-quot* deploy-vocab get vocab-main set-boot-quot*
stripped-word-props >r stripped-word-props >r
stripped-globals strip-globals stripped-globals strip-globals
r> strip-words ; r> strip-words
compress-byte-arrays
compress-quotations
compress-strings ;
: (deploy) ( final-image vocab config -- ) : (deploy) ( final-image vocab config -- )
#! Does the actual work of a deployment in the slave #! Does the actual work of a deployment in the slave