From 9669067924e6149410845d47bdebeab3159c476c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 27 Dec 2004 20:27:18 +0000 Subject: [PATCH] partial evaluation of branches --- library/cli.factor | 11 +++++----- library/compiler/compiler.factor | 3 ++- library/inference/branches.factor | 35 ++++++++++++++++++++---------- library/inference/inference.factor | 9 +------- library/inference/words.factor | 21 +++--------------- library/test/inference.factor | 14 +++++++++--- 6 files changed, 47 insertions(+), 46 deletions(-) diff --git a/library/cli.factor b/library/cli.factor index 600d146f8e..91774132a7 100644 --- a/library/cli.factor +++ b/library/cli.factor @@ -85,11 +85,12 @@ USE: kernel-internals : default-cli-args #! Some flags are *on* by default, unless user specifies #! -no- CLI switch - t "user-init" set - t "interactive" set - t "smart-terminal" set - t "verbose-compile" set - t "compile" set ; + "user-init" on + "interactive" on + "smart-terminal" on + "verbose-compile" on + "compile" on + os "win32" = [ "graphical" on ] when ; : cli-args ( -- args ) 10 getenv ; diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor index 1f0bb60ee4..66b245e222 100644 --- a/library/compiler/compiler.factor +++ b/library/compiler/compiler.factor @@ -41,6 +41,7 @@ USE: strings USE: unparser USE: vectors USE: words +USE: test : supported-cpu? ( -- ? ) cpu "unknown" = not ; @@ -97,7 +98,7 @@ M: compound (compile) ( word -- ) : compile-all ( -- ) #! Compile all words. supported-cpu? [ - [ try-compile ] each-word + [ [ try-compile ] each-word ] time ] [ "Unsupported CPU" print ] ifte ; diff --git a/library/inference/branches.factor b/library/inference/branches.factor index fd643a95b2..250a4fd5bf 100644 --- a/library/inference/branches.factor +++ b/library/inference/branches.factor @@ -39,6 +39,10 @@ USE: words USE: hashtables USE: prettyprint +! If this symbol is on, partial evalution of conditionals is +! disabled. +SYMBOL: inferring-base-case + : vector-length< ( vec1 vec2 -- ? ) swap vector-length swap vector-length < ; @@ -127,9 +131,8 @@ SYMBOL: cloned d-in [ deep-clone-vector ] change dataflow-graph off ; -: infer-branch ( value save-effect -- namespace ) +: infer-branch ( value -- namespace ) [ - save-effect set uncons [ unswons [ \ value-class set ] bind ] when* dup value-recursion recursive-state set copy-inference @@ -154,7 +157,7 @@ SYMBOL: dual-recursive-state #! Return effect namespace if inference didn't fail. [ [ dual-branch dual-recursive-state set ] keep - f infer-branch + infer-branch ] [ [ 2drop f ] when ] catch ; @@ -167,12 +170,16 @@ SYMBOL: dual-recursive-state #! Either the word is not recursive, or it is recursive #! and the base case throws an error. [ + inferring-base-case on + [ terminator-quot? not ] subset dup length 1 > [ infer-base-cases unify-effects effect dual-recursive-state get set-base ] [ drop ] ifte + + inferring-base-case off ] with-scope ; : (infer-branches) ( branchlist -- list ) @@ -182,7 +189,7 @@ SYMBOL: dual-recursive-state #! is a pair [ value | class ] indicating a type propagation #! for the given branch. dup infer-base-case [ - dup t infer-branch swap terminator-quot? [ + dup infer-branch swap terminator-quot? [ [ meta-d off meta-r off d-in off ] extend ] when ] map ; @@ -198,11 +205,17 @@ SYMBOL: dual-recursive-state #! parameter is a vector. (infer-branches) dup unify-effects unify-dataflow ; +: static-branch? ( value -- ) + literal? inferring-base-case get not and ; + : static-ifte ( true false -- ) #! If the branch taken is statically known, just infer #! along that branch. - pop-d literal-value [ drop ] [ nip ] ifte - literal-value infer-quot ; + dataflow-drop, pop-d literal-value [ drop ] [ nip ] ifte + gensym [ + dup value-recursion recursive-state set + literal-value infer-quot + ] (with-block) ; : dynamic-ifte ( true false -- ) #! If branch taken is computed, infer along both paths and @@ -219,11 +232,11 @@ SYMBOL: dual-recursive-state [ object general-list general-list ] ensure-d dataflow-drop, pop-d dataflow-drop, pop-d swap -! peek-d literal? [ -! static-ifte -! ] [ - dynamic-ifte ; -! ] ifte ; + peek-d static-branch? [ + static-ifte + ] [ + dynamic-ifte + ] ifte ; \ ifte [ infer-ifte ] "infer" set-word-property diff --git a/library/inference/inference.factor b/library/inference/inference.factor index d19ee27022..b7fa68452b 100644 --- a/library/inference/inference.factor +++ b/library/inference/inference.factor @@ -59,12 +59,6 @@ SYMBOL: entry-effect ! makes a local jump to this label. SYMBOL: recursive-label -! When inferring stack effects of mutually recursive words, we -! don't want to save the fact that one word does not have a -! stack effect before the base case of its mutual pair is -! inferred. -SYMBOL: save-effect - ! A value has the following slots: GENERIC: literal-value ( value -- obj ) GENERIC: value= ( literal value -- ? ) @@ -149,8 +143,7 @@ M: literal value-class-and ( class value -- ) init-interpreter 0 d-in set recursive-state set - dataflow-graph off - save-effect on ; + dataflow-graph off ; DEFER: apply-word diff --git a/library/inference/words.factor b/library/inference/words.factor index f5e1a1d4ce..aa954b2c41 100644 --- a/library/inference/words.factor +++ b/library/inference/words.factor @@ -109,29 +109,14 @@ USE: prettyprint [ swap rethrow ] when* ] catch ; -: (infer-compound) ( word -- effect ) +: infer-compound ( word -- effect ) #! Infer a word's stack effect in a separate inferencer #! instance. [ recursive-state get init-inference - dup inline-compound + dup dup inline-compound [ "infer-effect" set-word-property ] keep - ] with-scope ; - -: infer-compound ( word -- ) - #! Infer the stack effect of a compound word in a separate - #! inferencer instance, caching the result. - [ - dup (infer-compound) consume/produce - ] [ - [ - swap save-effect get [ - t "no-effect" set-word-property - ] [ - drop - ] ifte rethrow - ] when* - ] catch ; + ] with-scope consume/produce ; GENERIC: (apply-word) diff --git a/library/test/inference.factor b/library/test/inference.factor index 89173069ac..09696199a5 100644 --- a/library/test/inference.factor +++ b/library/test/inference.factor @@ -41,7 +41,6 @@ USE: generic [ [ call ] infer old-effect ] unit-test-fails [ [ 2 | 4 ] ] [ [ 2dup ] infer old-effect ] unit-test -[ [ 2 | 0 ] ] [ [ set-vector-length ] infer old-effect ] unit-test [ [ 2 | 0 ] ] [ [ vector-push ] infer old-effect ] unit-test [ [ 1 | 0 ] ] [ [ [ ] [ ] ifte ] infer old-effect ] unit-test @@ -99,6 +98,13 @@ USE: generic [ [ bad-recursion-2 ] infer old-effect ] unit-test-fails +! Not sure how to fix this one + +! : funny-recursion +! dup [ funny-recursion 1 ] [ 2 ] ifte drop ; +! +! [ [ 1 | 1 ] ] [ [ funny-recursion ] infer old-effect ] unit-test + ! Simple combinators [ [ 1 | 2 ] ] [ [ [ car ] keep cdr ] infer old-effect ] unit-test @@ -123,6 +129,9 @@ DEFER: foe 2drop f ] ifte ; +[ [ 2 | 1 ] ] [ [ fie ] infer old-effect ] unit-test +[ [ 2 | 1 ] ] [ [ foe ] infer old-effect ] unit-test + ! This form should not have a stack effect : bad-bin 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] ifte ; [ [ bad-bin ] infer old-effect ] unit-test-fails @@ -149,9 +158,8 @@ SYMBOL: sym-test [ [ 0 | 1 ] ] [ [ sym-test ] infer old-effect ] unit-test -[ [ 2 | 1 ] ] [ [ fie ] infer old-effect ] unit-test -[ [ 2 | 1 ] ] [ [ foe ] infer old-effect ] unit-test +[ [ 2 | 0 ] ] [ [ set-vector-length ] infer old-effect ] unit-test [ [ 2 | 1 ] ] [ [ 2list ] infer old-effect ] unit-test [ [ 3 | 1 ] ] [ [ 3list ] infer old-effect ] unit-test [ [ 2 | 1 ] ] [ [ append ] infer old-effect ] unit-test