diff --git a/basis/compiler/tree/cleanup/cleanup-tests.factor b/basis/compiler/tree/cleanup/cleanup-tests.factor index 15bc6444ac..2e8eb15959 100644 --- a/basis/compiler/tree/cleanup/cleanup-tests.factor +++ b/basis/compiler/tree/cleanup/cleanup-tests.factor @@ -10,12 +10,13 @@ compiler.tree compiler.tree.combinators compiler.tree.cleanup compiler.tree.builder +compiler.tree.recursive compiler.tree.normalization compiler.tree.propagation compiler.tree.checker ; : cleaned-up-tree ( quot -- nodes ) - build-tree normalize propagate cleanup dup check-nodes ; + build-tree analyze-recursive normalize propagate cleanup dup check-nodes ; [ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor index e8d2b29027..7b15fdf856 100644 --- a/basis/compiler/tree/dead-code/dead-code-tests.factor +++ b/basis/compiler/tree/dead-code/dead-code-tests.factor @@ -3,16 +3,17 @@ compiler.tree.dead-code compiler.tree.def-use compiler.tree compiler.tree.combinators compiler.tree.propagation compiler.tree.cleanup compiler.tree.escape-analysis compiler.tree.tuple-unboxing compiler.tree.debugger -compiler.tree.normalization compiler.tree.checker tools.test -kernel math stack-checker.state accessors combinators io -prettyprint words sequences.deep sequences.private arrays -classes kernel.private ; +compiler.tree.recursive compiler.tree.normalization +compiler.tree.checker tools.test kernel math stack-checker.state +accessors combinators io prettyprint words sequences.deep +sequences.private arrays classes kernel.private ; IN: compiler.tree.dead-code.tests \ remove-dead-code must-infer : count-live-values ( quot -- n ) build-tree + analyze-recursive normalize propagate cleanup @@ -64,6 +65,7 @@ IN: compiler.tree.dead-code.tests : optimize-quot ( quot -- quot' ) build-tree + analyze-recursive normalize propagate cleanup diff --git a/basis/compiler/tree/def-use/def-use-tests.factor b/basis/compiler/tree/def-use/def-use-tests.factor index 993627eb15..d970e04afd 100755 --- a/basis/compiler/tree/def-use/def-use-tests.factor +++ b/basis/compiler/tree/def-use/def-use-tests.factor @@ -1,9 +1,10 @@ USING: accessors namespaces assocs kernel sequences math tools.test words sets combinators.short-circuit stack-checker.state compiler.tree compiler.tree.builder -compiler.tree.normalization compiler.tree.propagation -compiler.tree.cleanup compiler.tree.def-use arrays kernel.private -sorting math.order binary-search compiler.tree.checker ; +compiler.tree.recursive compiler.tree.normalization +compiler.tree.propagation compiler.tree.cleanup +compiler.tree.def-use arrays kernel.private sorting math.order +binary-search compiler.tree.checker ; IN: compiler.tree.def-use.tests \ compute-def-use must-infer @@ -18,6 +19,7 @@ IN: compiler.tree.def-use.tests : test-def-use ( quot -- ) build-tree + analyze-recursive normalize propagate cleanup @@ -27,7 +29,14 @@ IN: compiler.tree.def-use.tests : too-deep ( a b -- c ) dup [ drop ] [ 2dup too-deep too-deep drop ] if ; inline recursive -[ ] [ [ too-deep ] build-tree normalize compute-def-use check-nodes ] unit-test +[ ] [ + [ too-deep ] + build-tree + analyze-recursive + normalize + compute-def-use + check-nodes +] unit-test ! compute-def-use checks for SSA violations, so we use that to ! ensure we generate some common patterns correctly. diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor index f51046c6cb..7ece8a5a80 100644 --- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor +++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -1,13 +1,14 @@ IN: compiler.tree.escape-analysis.tests USING: compiler.tree.escape-analysis compiler.tree.escape-analysis.allocations compiler.tree.builder -compiler.tree.normalization math.functions -compiler.tree.propagation compiler.tree.cleanup -compiler.tree.combinators compiler.tree sequences math math.private -kernel tools.test accessors slots.private quotations.private -prettyprint classes.tuple.private classes classes.tuple -compiler.intrinsics namespaces compiler.tree.propagation.info -stack-checker.errors kernel.private ; +compiler.tree.recursive compiler.tree.normalization +math.functions compiler.tree.propagation compiler.tree.cleanup +compiler.tree.combinators compiler.tree sequences math +math.private kernel tools.test accessors slots.private +quotations.private prettyprint classes.tuple.private classes +classes.tuple compiler.intrinsics namespaces +compiler.tree.propagation.info stack-checker.errors +kernel.private ; \ escape-analysis must-infer @@ -28,6 +29,7 @@ M: node count-unboxed-allocations* drop ; : count-unboxed-allocations ( quot -- sizes ) build-tree + analyze-recursive normalize propagate cleanup diff --git a/basis/compiler/tree/finalization/finalization.factor b/basis/compiler/tree/finalization/finalization.factor index dafe032ab6..ba7e4ff652 100644 --- a/basis/compiler/tree/finalization/finalization.factor +++ b/basis/compiler/tree/finalization/finalization.factor @@ -7,6 +7,7 @@ byte-arrays alien.accessors compiler.intrinsics compiler.tree compiler.tree.builder +compiler.tree.recursive compiler.tree.normalization compiler.tree.propagation compiler.tree.propagation.info @@ -39,6 +40,7 @@ M: #shuffle finalize* : splice-quot ( quot -- nodes ) [ build-tree + analyze-recursive normalize propagate cleanup diff --git a/basis/compiler/tree/normalization/introductions/introductions.factor b/basis/compiler/tree/normalization/introductions/introductions.factor new file mode 100644 index 0000000000..9e96dc0472 --- /dev/null +++ b/basis/compiler/tree/normalization/introductions/introductions.factor @@ -0,0 +1,36 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces sequences accessors math kernel +compiler.tree ; +IN: compiler.tree.normalization.introductions + +SYMBOL: introductions + +GENERIC: count-introductions* ( node -- ) + +: count-introductions ( nodes -- n ) + #! Note: we use each, not each-node, since the #branch + #! method recurses into children directly and we don't + #! recurse into #recursive at all. + [ + 0 introductions set + [ count-introductions* ] each + introductions get + ] with-scope ; + +: introductions+ ( n -- ) introductions [ + ] change ; + +M: #introduce count-introductions* + out-d>> length introductions+ ; + +M: #branch count-introductions* + children>> + [ count-introductions ] map supremum + introductions+ ; + +M: #recursive count-introductions* + [ label>> ] [ child>> count-introductions ] bi + >>introductions + drop ; + +M: node count-introductions* drop ; diff --git a/basis/compiler/tree/normalization/normalization-tests.factor b/basis/compiler/tree/normalization/normalization-tests.factor index 1b4f728adc..c4a97fcc92 100644 --- a/basis/compiler/tree/normalization/normalization-tests.factor +++ b/basis/compiler/tree/normalization/normalization-tests.factor @@ -1,5 +1,8 @@ IN: compiler.tree.normalization.tests -USING: compiler.tree.builder compiler.tree.normalization +USING: compiler.tree.builder compiler.tree.recursive +compiler.tree.normalization +compiler.tree.normalization.introductions +compiler.tree.normalization.renaming compiler.tree compiler.tree.checker sequences accessors tools.test kernel math ; @@ -22,27 +25,30 @@ sequences accessors tools.test kernel math ; [ 0 2 ] [ [ foo ] build-tree [ recursive-inputs ] - [ normalize recursive-inputs ] bi + [ analyze-recursive normalize recursive-inputs ] bi ] unit-test -[ ] [ [ [ 1 ] [ 2 ] if + * ] build-tree normalize check-nodes ] unit-test +: test-normalization ( quot -- ) + build-tree analyze-recursive normalize check-nodes ; + +[ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test DEFER: bbb : aaa ( x -- ) dup [ dup >r bbb r> aaa ] [ drop ] if ; inline recursive : bbb ( x -- ) >r drop 0 r> aaa ; inline recursive -[ ] [ [ bbb ] build-tree normalize check-nodes ] unit-test +[ ] [ [ bbb ] test-normalization ] unit-test : ccc ( -- ) ccc drop 1 ; inline recursive -[ ] [ [ ccc ] build-tree normalize check-nodes ] unit-test +[ ] [ [ ccc ] test-normalization ] unit-test DEFER: eee : ddd ( -- ) eee ; inline recursive : eee ( -- ) swap ddd ; inline recursive -[ ] [ [ eee ] build-tree normalize check-nodes ] unit-test +[ ] [ [ eee ] test-normalization ] unit-test : call-recursive-5 ( -- ) call-recursive-5 ; inline recursive -[ ] [ [ call-recursive-5 swap ] build-tree normalize check-nodes ] unit-test +[ ] [ [ call-recursive-5 swap ] test-normalization ] unit-test diff --git a/basis/compiler/tree/normalization/normalization.factor b/basis/compiler/tree/normalization/normalization.factor index b826a1590b..bebe2e91b6 100644 --- a/basis/compiler/tree/normalization/normalization.factor +++ b/basis/compiler/tree/normalization/normalization.factor @@ -6,7 +6,9 @@ stack-checker.backend stack-checker.branches stack-checker.inlining compiler.tree -compiler.tree.combinators ; +compiler.tree.combinators +compiler.tree.normalization.introductions +compiler.tree.normalization.renaming ; IN: compiler.tree.normalization ! A transform pass done before optimization can begin to @@ -16,9 +18,6 @@ IN: compiler.tree.normalization ! replaced with a single one, at the beginning of a program. ! This simplifies subsequent analysis. ! -! - We collect #return-recursive and #call-recursive nodes and -! store them in the #recursive's label slot. -! ! - We normalize #call-recursive as follows. The stack checker ! says that the inputs of a #call-recursive are the entire stack ! at the time of the call. This is a conservative estimate; we @@ -28,93 +27,6 @@ IN: compiler.tree.normalization ! #call-recursive into a #copy of the unchanged values and a ! #call-recursive with trimmed inputs and outputs. -! Collect introductions -SYMBOL: introductions - -GENERIC: count-introductions* ( node -- ) - -: count-introductions ( nodes -- n ) - #! Note: we use each, not each-node, since the #branch - #! method recurses into children directly and we don't - #! recurse into #recursive at all. - [ - 0 introductions set - [ count-introductions* ] each - introductions get - ] with-scope ; - -: introductions+ ( n -- ) introductions [ + ] change ; - -M: #introduce count-introductions* - out-d>> length introductions+ ; - -M: #branch count-introductions* - children>> - [ count-introductions ] map supremum - introductions+ ; - -M: #recursive count-introductions* - [ label>> ] [ child>> count-introductions ] bi - >>introductions - drop ; - -M: node count-introductions* drop ; - -! Collect label info -GENERIC: collect-label-info ( node -- ) - -M: #return-recursive collect-label-info - dup label>> (>>return) ; - -M: #call-recursive collect-label-info - dup label>> calls>> push ; - -M: #recursive collect-label-info - label>> V{ } clone >>calls drop ; - -M: node collect-label-info drop ; - -! Rename -SYMBOL: rename-map - -: rename-value ( value -- value' ) - [ rename-map get at ] keep or ; - -: rename-values ( values -- values' ) - rename-map get '[ [ _ at ] keep or ] map ; - -GENERIC: rename-node-values* ( node -- node ) - -M: #introduce rename-node-values* ; - -M: #shuffle rename-node-values* - [ rename-values ] change-in-d - [ [ rename-value ] assoc-map ] change-mapping ; - -M: #push rename-node-values* ; - -M: #r> rename-node-values* - [ rename-values ] change-in-r ; - -M: #terminate rename-node-values* - [ rename-values ] change-in-d - [ rename-values ] change-in-r ; - -M: #phi rename-node-values* - [ [ rename-values ] map ] change-phi-in-d ; - -M: #declare rename-node-values* - [ [ [ rename-value ] dip ] assoc-map ] change-declaration ; - -M: #alien-callback rename-node-values* ; - -M: node rename-node-values* - [ rename-values ] change-in-d ; - -: rename-node-values ( nodes -- nodes' ) - dup [ rename-node-values* drop ] each-node ; - -! Normalize GENERIC: normalize* ( node -- node' ) SYMBOL: introduction-stack @@ -125,10 +37,6 @@ SYMBOL: introduction-stack : pop-introductions ( n -- values ) introduction-stack [ swap cut* swap ] change ; -: add-renamings ( old new -- ) - [ rename-values ] dip - rename-map get '[ _ set-at ] 2each ; - M: #introduce normalize* out-d>> [ length pop-introductions ] keep add-renamings f ; @@ -201,9 +109,8 @@ M: #call-recursive normalize* M: node normalize* ; : normalize ( nodes -- nodes' ) - H{ } clone rename-map set - dup [ collect-label-info ] each-node dup count-introductions make-values + H{ } clone rename-map set [ (normalize) ] [ nip ] 2bi [ #introduce prefix ] unless-empty rename-node-values ; diff --git a/basis/compiler/tree/normalization/renaming/renaming.factor b/basis/compiler/tree/normalization/renaming/renaming.factor new file mode 100644 index 0000000000..3050df2611 --- /dev/null +++ b/basis/compiler/tree/normalization/renaming/renaming.factor @@ -0,0 +1,48 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces assocs kernel accessors sequences fry +compiler.tree compiler.tree.combinators ; +IN: compiler.tree.normalization.renaming + +SYMBOL: rename-map + +: rename-value ( value -- value' ) + [ rename-map get at ] keep or ; + +: rename-values ( values -- values' ) + rename-map get '[ [ _ at ] keep or ] map ; + +: add-renamings ( old new -- ) + [ rename-values ] dip + rename-map get '[ _ set-at ] 2each ; + +GENERIC: rename-node-values* ( node -- node ) + +M: #introduce rename-node-values* ; + +M: #shuffle rename-node-values* + [ rename-values ] change-in-d + [ [ rename-value ] assoc-map ] change-mapping ; + +M: #push rename-node-values* ; + +M: #r> rename-node-values* + [ rename-values ] change-in-r ; + +M: #terminate rename-node-values* + [ rename-values ] change-in-d + [ rename-values ] change-in-r ; + +M: #phi rename-node-values* + [ [ rename-values ] map ] change-phi-in-d ; + +M: #declare rename-node-values* + [ [ [ rename-value ] dip ] assoc-map ] change-declaration ; + +M: #alien-callback rename-node-values* ; + +M: node rename-node-values* + [ rename-values ] change-in-d ; + +: rename-node-values ( nodes -- nodes' ) + dup [ rename-node-values* drop ] each-node ; diff --git a/basis/compiler/tree/optimizer/optimizer.factor b/basis/compiler/tree/optimizer/optimizer.factor index aafc7f137b..573ba5d2c9 100644 --- a/basis/compiler/tree/optimizer/optimizer.factor +++ b/basis/compiler/tree/optimizer/optimizer.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces +compiler.tree.recursive compiler.tree.normalization compiler.tree.propagation compiler.tree.cleanup @@ -9,7 +10,6 @@ compiler.tree.tuple-unboxing compiler.tree.def-use compiler.tree.dead-code compiler.tree.strength-reduction -compiler.tree.loop.detection compiler.tree.finalization compiler.tree.checker ; IN: compiler.tree.optimizer @@ -17,10 +17,10 @@ IN: compiler.tree.optimizer SYMBOL: check-optimizer? : optimize-tree ( nodes -- nodes' ) + analyze-recursive normalize propagate cleanup - detect-loops escape-analysis unbox-tuples compute-def-use diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 4f93769b7f..4c0b4107a4 100644 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/basis/compiler/tree/propagation/inlining/inlining.factor @@ -6,6 +6,7 @@ classes.algebra classes.union sets quotations assocs combinators words namespaces compiler.tree compiler.tree.builder +compiler.tree.recursive compiler.tree.normalization compiler.tree.propagation.info compiler.tree.propagation.nodes ; @@ -18,7 +19,7 @@ M: word splicing-nodes [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ; M: quotation splicing-nodes - build-sub-tree normalize ; + build-sub-tree normalize analyze-recursive ; : propagate-body ( #call -- ) body>> (propagate) ; diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index f04460f32a..a115ee53c2 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -1,5 +1,5 @@ USING: kernel compiler.tree.builder compiler.tree -compiler.tree.propagation +compiler.tree.propagation compiler.tree.recursive compiler.tree.normalization tools.test math math.order accessors sequences arrays kernel.private vectors alien.accessors alien.c-types sequences.private @@ -14,6 +14,7 @@ IN: compiler.tree.propagation.tests : final-info ( quot -- seq ) build-tree + analyze-recursive normalize propagate compute-def-use diff --git a/basis/compiler/tree/propagation/recursive/recursive.factor b/basis/compiler/tree/propagation/recursive/recursive.factor index 649eaa763e..53dce813a3 100644 --- a/basis/compiler/tree/propagation/recursive/recursive.factor +++ b/basis/compiler/tree/propagation/recursive/recursive.factor @@ -70,7 +70,8 @@ M: #recursive propagate-around ( #recursive -- ) [ generalize-return-interval ] map ; : return-infos ( node -- infos ) - label>> return>> node-input-infos generalize-return ; + label>> [ return>> node-input-infos ] [ loop?>> ] bi + [ generalize-return ] unless ; M: #call-recursive propagate-before ( #call-recursive -- ) [ ] [ return-infos ] [ node-output-infos ] tri diff --git a/basis/compiler/tree/loop/detection/detection-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor similarity index 75% rename from basis/compiler/tree/loop/detection/detection-tests.factor rename to basis/compiler/tree/recursive/recursive-tests.factor index 5864dc368f..c66c182869 100644 --- a/basis/compiler/tree/loop/detection/detection-tests.factor +++ b/basis/compiler/tree/recursive/recursive-tests.factor @@ -1,5 +1,5 @@ -IN: compiler.tree.loop.detection.tests -USING: compiler.tree.loop.detection tools.test +IN: compiler.tree.recursive.tests +USING: compiler.tree.recursive tools.test kernel combinators.short-circuit math sequences accessors compiler.tree compiler.tree.builder @@ -10,7 +10,7 @@ compiler.tree.combinators ; [ { f t t t } ] [ t { f f t t } (tail-calls) ] unit-test [ { f f f t } ] [ t { f f t f } (tail-calls) ] unit-test -\ detect-loops must-infer +\ analyze-recursive must-infer : label-is-loop? ( nodes word -- ? ) [ @@ -38,22 +38,22 @@ compiler.tree.combinators ; dup [ 1+ loop-test-1 ] [ drop ] if ; inline recursive [ t ] [ - [ loop-test-1 ] build-tree detect-loops + [ loop-test-1 ] build-tree analyze-recursive \ loop-test-1 label-is-loop? ] unit-test [ t ] [ - [ loop-test-1 1 2 3 ] build-tree detect-loops + [ loop-test-1 1 2 3 ] build-tree analyze-recursive \ loop-test-1 label-is-loop? ] unit-test [ t ] [ - [ [ loop-test-1 ] each ] build-tree detect-loops + [ [ loop-test-1 ] each ] build-tree analyze-recursive \ loop-test-1 label-is-loop? ] unit-test [ t ] [ - [ [ loop-test-1 ] each ] build-tree detect-loops + [ [ loop-test-1 ] each ] build-tree analyze-recursive \ (each-integer) label-is-loop? ] unit-test @@ -61,7 +61,7 @@ compiler.tree.combinators ; dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive [ t ] [ - [ loop-test-2 ] build-tree detect-loops + [ loop-test-2 ] build-tree analyze-recursive \ loop-test-2 label-is-not-loop? ] unit-test @@ -69,7 +69,7 @@ compiler.tree.combinators ; dup [ [ loop-test-3 ] each ] [ drop ] if ; inline recursive [ t ] [ - [ loop-test-3 ] build-tree detect-loops + [ loop-test-3 ] build-tree analyze-recursive \ loop-test-3 label-is-not-loop? ] unit-test @@ -81,7 +81,7 @@ compiler.tree.combinators ; ] if ; inline recursive [ f ] [ - [ [ [ ] map ] map ] build-tree detect-loops + [ [ [ ] map ] map ] build-tree analyze-recursive [ dup #recursive? [ label>> loop?>> not ] [ drop f ] if ] contains-node? @@ -98,22 +98,22 @@ DEFER: a blah [ b ] [ a ] if ; inline recursive [ t ] [ - [ a ] build-tree detect-loops + [ a ] build-tree analyze-recursive \ a label-is-loop? ] unit-test [ t ] [ - [ a ] build-tree detect-loops + [ a ] build-tree analyze-recursive \ b label-is-loop? ] unit-test [ t ] [ - [ b ] build-tree detect-loops + [ b ] build-tree analyze-recursive \ a label-is-loop? ] unit-test [ t ] [ - [ a ] build-tree detect-loops + [ a ] build-tree analyze-recursive \ b label-is-loop? ] unit-test @@ -126,12 +126,12 @@ DEFER: a' blah [ b' ] [ a' ] if ; inline recursive [ f ] [ - [ a' ] build-tree detect-loops + [ a' ] build-tree analyze-recursive \ a' label-is-loop? ] unit-test [ f ] [ - [ b' ] build-tree detect-loops + [ b' ] build-tree analyze-recursive \ b' label-is-loop? ] unit-test @@ -140,11 +140,11 @@ DEFER: a' ! sound. [ t ] [ - [ b' ] build-tree detect-loops + [ b' ] build-tree analyze-recursive \ a' label-is-loop? ] unit-test [ f ] [ - [ a' ] build-tree detect-loops + [ a' ] build-tree analyze-recursive \ b' label-is-loop? ] unit-test diff --git a/basis/compiler/tree/loop/detection/detection.factor b/basis/compiler/tree/recursive/recursive.factor similarity index 80% rename from basis/compiler/tree/loop/detection/detection.factor rename to basis/compiler/tree/recursive/recursive.factor index 1f9e42530a..d1e4c7c70e 100644 --- a/basis/compiler/tree/loop/detection/detection.factor +++ b/basis/compiler/tree/recursive/recursive.factor @@ -1,14 +1,27 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences namespaces assocs accessors fry -compiler.tree deques search-deques ; -IN: compiler.tree.loop.detection +USING: kernel assocs namespaces accessors sequences deques +search-deques compiler.tree compiler.tree.combinators ; +IN: compiler.tree.recursive + +! Collect label info +GENERIC: collect-label-info ( node -- ) + +M: #return-recursive collect-label-info + dup label>> (>>return) ; + +M: #call-recursive collect-label-info + dup label>> calls>> push ; + +M: #recursive collect-label-info + label>> V{ } clone >>calls drop ; + +M: node collect-label-info drop ; ! A loop is a #recursive which only tail calls itself, and those ! calls are nested inside other loops only. We optimistically ! assume all #recursive nodes are loops, disqualifying them as ! we see evidence to the contrary. - : (tail-calls) ( tail? seq -- seq' ) reverse [ swap [ and ] keep ] map nip reverse ; @@ -84,5 +97,6 @@ M: node collect-loop-info* 2drop ; ] [ drop ] if ] slurp-deque ; -: detect-loops ( nodes -- nodes ) +: analyze-recursive ( nodes -- nodes ) + dup [ collect-label-info ] each-node dup collect-loop-info disqualify-loops ; diff --git a/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor b/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor index 858e40347f..81ba01f1e2 100644 --- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor +++ b/basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor @@ -1,16 +1,18 @@ IN: compiler.tree.tuple-unboxing.tests USING: tools.test compiler.tree.tuple-unboxing compiler.tree -compiler.tree.builder compiler.tree.normalization -compiler.tree.propagation compiler.tree.cleanup -compiler.tree.escape-analysis compiler.tree.tuple-unboxing -compiler.tree.checker compiler.tree.def-use kernel accessors -sequences math math.private sorting math.order binary-search -sequences.private slots.private ; +compiler.tree.builder compiler.tree.recursive +compiler.tree.normalization compiler.tree.propagation +compiler.tree.cleanup compiler.tree.escape-analysis +compiler.tree.tuple-unboxing compiler.tree.checker +compiler.tree.def-use kernel accessors sequences math +math.private sorting math.order binary-search sequences.private +slots.private ; \ unbox-tuples must-infer : test-unboxing ( quot -- ) build-tree + analyze-recursive normalize propagate cleanup