Change high-level IR to not use 'successor' links; add normalization pass

unfinished/compiler/tree/branch-fusion/branch-fusion.factor

@@ -0,0 +1,5 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.tree.branch-fusion
+
+: fuse-branches ( nodes -- nodes' ) ;

unfinished/compiler/tree/builder/builder.factor

@@ -7,11 +7,11 @@ stack-checker.state stack-checker.visitor stack-checker.errors
 stack-checker.backend compiler.tree ;
 IN: compiler.tree.builder
 
-: with-tree-builder ( quot -- dataflow )
+: with-tree-builder ( quot -- nodes )
-    [ node-list new stack-visitor set ] prepose
+    [ V{ } clone stack-visitor set ] prepose
-    with-infer first>> ; inline
+    with-infer ; inline
 
-GENERIC# build-tree-with 1 ( quot stack -- dataflow )
+GENERIC# build-tree-with 1 ( quot stack -- nodes )
 
 M: callable build-tree-with
     #! Not safe to call from inference transforms.
@@ -20,7 +20,7 @@ M: callable build-tree-with
         f infer-quot
     ] with-tree-builder nip ;
 
-: build-tree ( quot -- dataflow ) f build-tree-with ;
+: build-tree ( quot -- nodes ) f build-tree-with ;
 
 : (make-specializer) ( class picker -- quot )
     swap "predicate" word-prop append ;
@@ -65,7 +65,7 @@ M: callable build-tree-with
         [ drop ]
     } cond ;
 
-: build-tree-from-word ( word -- effect dataflow )
+: build-tree-from-word ( word -- effect nodes )
     [
         [
             dup +cannot-infer+ word-prop [ cannot-infer-effect ] when

unfinished/compiler/tree/cleanup/cleanup.factor

@@ -0,0 +1,5 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.tree.cleanup
+
+: cleanup ( nodes -- nodes' ) ;

unfinished/compiler/tree/combinators/combinators-tests.factor

@@ -1,17 +1,4 @@
 IN: compiler.tree.combinators.tests
-USING: compiler.tree.combinators compiler.tree.builder tools.test
+USING: compiler.tree.combinators tools.test kernel ;
-kernel ;
-
-[ ] [ [ 1 ] build-tree [ ] transform-nodes drop ] unit-test
-[ ] [ [ 1 2 3 ] build-tree [ ] transform-nodes drop ] unit-test
-
-{ 1 0 } [ [ iterate-next ] iterate-nodes ] must-infer-as
-
-{ 1 0 }
-[
-    [ [ iterate-next ] iterate-nodes ] with-node-iterator
-] must-infer-as
 
 { 1 0 } [ [ drop ] each-node ] must-infer-as
-
-{ 1 0 } [ [ ] map-children ] must-infer-as

unfinished/compiler/tree/combinators/combinators.factor

@@ -1,64 +1,17 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry arrays generic assocs kernel math namespaces parser
+USING: fry kernel accessors sequences compiler.tree ;
-sequences words vectors math.intervals effects classes
-accessors combinators compiler.tree ;
 IN: compiler.tree.combinators
 
-SYMBOL: node-stack
+: each-node ( nodes quot -- )
-
+    dup dup '[
-: >node ( node -- ) node-stack get push ;
+        , [
-: node> ( -- node ) node-stack get pop ;
+            dup #branch? [
-: node@ ( -- node ) node-stack get peek ;
+                children>> [ , each-node ] each
-
+            ] [
-: iterate-next ( -- node ) node@ successor>> ;
+                dup #recursive? [
-
+                    child>> , each-node
-: iterate-nodes ( node quot -- )
+                ] [ drop ] if
-    over [
+            ] if
-        [ swap >node call node> drop ] keep iterate-nodes
+        ] bi
-    ] [
+    ] each ; inline
-        2drop
-    ] if ; inline
-
-: (each-node) ( quot -- next )
-    node@ [ swap call ] 2keep
-    children>> [
-        first>> [
-            [ (each-node) ] keep swap
-        ] iterate-nodes
-    ] each drop
-    iterate-next ; inline
-
-: with-node-iterator ( quot -- )
-    >r V{ } clone node-stack r> with-variable ; inline
-
-: each-node ( node quot -- )
-    [
-        swap [
-            [ (each-node) ] keep swap
-        ] iterate-nodes drop
-    ] with-node-iterator ; inline
-
-: map-children ( node quot -- )
-    [ children>> ] dip '[ , change-first drop ] each ; inline
-
-: (transform-nodes) ( prev node quot -- )
-    dup >r call dup [
-        >>successor
-        successor>> dup successor>>
-        r> (transform-nodes)
-    ] [
-        r> 2drop f >>successor drop
-    ] if ; inline
-
-: transform-nodes ( node quot -- new-node )
-    over [
-        [ call dup dup successor>> ] keep (transform-nodes)
-    ] [ drop ] if ; inline
-
-: tail-call? ( -- ? )
-    #! We don't consider calls which do non-local exits to be
-    #! tail calls, because this gives better error traces.
-    node-stack get [
-        successor>> [ #tail? ] [ #terminate? not ] bi and
-    ] all? ;

unfinished/compiler/tree/dataflow-analysis/backward/backward.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: compiler.tree.dfa.backward
+IN: compiler.tree.dataflow-analysis.backward
 USING: accessors sequences assocs kernel compiler.tree
-compiler.tree.dfa ;
+compiler.tree.dataflow-analysis ;
 
 GENERIC: backward ( value node -- )
 

unfinished/compiler/tree/dataflow-analysis/dataflow-analysis.factor

@@ -3,7 +3,7 @@
 USING: fry accessors namespaces assocs dequeues search-dequeues
 kernel sequences words sets stack-checker.inlining compiler.tree
 compiler.tree.def-use compiler.tree.combinators ;
-IN: compiler.tree.dfa
+IN: compiler.tree.dataflow-analysis
 
 ! Dataflow analysis
 SYMBOL: work-list

unfinished/compiler/tree/dead-code/dead-code.factor

@@ -3,8 +3,8 @@
 USING: fry accessors namespaces assocs dequeues search-dequeues
 kernel sequences words sets stack-checker.inlining
 compiler.tree
-compiler.tree.dfa
+compiler.tree.dataflow-analysis
-compiler.tree.dfa.backward
+compiler.tree.dataflow-analysis.backward
 compiler.tree.combinators ;
 IN: compiler.tree.dead-code
 

unfinished/compiler/tree/def-use/def-use.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs sequences kernel generic assocs classes
+USING: arrays namespaces assocs sequences kernel generic assocs
-vectors accessors combinators sets stack-checker.state
+classes vectors accessors combinators sets stack-checker.state
 compiler.tree compiler.tree.combinators ;
 IN: compiler.tree.def-use
 
@@ -9,60 +9,60 @@ SYMBOL: def-use
 
 TUPLE: definition value node uses ;
 
-: <definition> ( value -- definition )
+: <definition> ( node value -- definition )
     definition new
         swap >>value
+        swap >>node
         V{ } clone >>uses ;
 
 : def-of ( value -- definition )
-    def-use get [ <definition> ] cache ;
+    def-use get at* [ "No def" throw ] unless ;
 
 : def-value ( node value -- )
-    def-of [ [ "Multiple defs" throw ] when ] change-node drop ;
+    def-use get 2dup key? [
+        "Multiple defs" throw
+    ] [
+        [ [ <definition> ] keep ] dip set-at
+    ] if ;
 
 : used-by ( value -- nodes ) def-of uses>> ;
 
 : use-value ( node value -- ) used-by push ;
 
-: defined-by ( value -- node ) def-use get at node>> ;
+: defined-by ( value -- node ) def-of node>> ;
 
 GENERIC: node-uses-values ( node -- values )
 
-M: #declare node-uses-values declaration>> keys ;
+M: #introduce node-uses-values drop f ;
-
+M: #push node-uses-values drop f ;
-M: #phi node-uses-values
-    [ phi-in-d>> concat ] [ phi-in-r>> concat ] bi
-    append sift prune ;
-
 M: #r> node-uses-values in-r>> ;
-
+M: #phi node-uses-values
+    [ phi-in-d>> ] [ phi-in-r>> ] bi append concat sift prune ;
+M: #declare node-uses-values declaration>> keys ;
 M: node node-uses-values in-d>> ;
 
 GENERIC: node-defs-values ( node -- values )
 
-M: #introduce node-defs-values values>> ;
+M: #introduce node-defs-values value>> 1array ;
-
 M: #>r node-defs-values out-r>> ;
-
+M: #branch node-defs-values drop f ;
 M: #phi node-defs-values [ out-d>> ] [ out-r>> ] bi append ;
-
+M: #declare node-defs-values drop f ;
+M: #return node-defs-values drop f ;
+M: #recursive node-defs-values drop f ;
+M: #terminate node-defs-values drop f ;
 M: node node-defs-values out-d>> ;
 
 : node-def-use ( node -- )
     [ dup node-uses-values [ use-value ] with each ]
     [ dup node-defs-values [ def-value ] with each ] bi ;
 
-: check-def ( node -- )
-    [ "No def" throw ] unless ;
-
 : check-use ( uses -- )
     [ empty? [ "No use" throw ] when ]
     [ all-unique? [ "Uses not all unique" throw ] unless ] bi ;
 
 : check-def-use ( -- )
-    def-use get [
+    def-use get [ nip uses>> check-use ] assoc-each ;
-        nip [ node>> check-def ] [ uses>> check-use ] bi
-    ] assoc-each ;
 
 : compute-def-use ( node -- node )
     H{ } clone def-use set

unfinished/compiler/tree/loop-detection/loop-detection.factor

@@ -0,0 +1,5 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.tree.loop-detection
+
+: detect-loops ( nodes -- nodes' ) ;

unfinished/compiler/tree/normalization/normalization-tests.factor

@@ -0,0 +1,27 @@
+IN: compiler.tree.normalization.tests
+USING: compiler.tree.builder compiler.tree.normalization
+compiler.tree sequences accessors tools.test kernel ;
+
+\ collect-introductions must-infer
+\ fixup-enter-recursive must-infer
+\ eliminate-introductions must-infer
+\ normalize must-infer
+
+[ 3 ] [ [ 3drop 1 2 3 ] build-tree collect-introductions ] unit-test
+
+[ 4 ] [ [ 3drop 1 2 3 3drop drop ] build-tree collect-introductions ] unit-test
+
+[ 3 ] [ [ [ drop ] [ 2drop 3 ] if ] build-tree collect-introductions ] unit-test
+
+[ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree collect-introductions ] unit-test
+
+: foo ( -- ) swap ; inline recursive
+
+: recursive-inputs ( nodes -- n )
+    [ #recursive? ] find nip child>> first in-d>> length ;
+
+[ 0 2 ] [
+    [ foo ] build-tree
+    [ recursive-inputs ]
+    [ normalize recursive-inputs ] bi
+] unit-test

unfinished/compiler/tree/normalization/normalization.factor

@@ -0,0 +1,94 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces sequences math accessors kernel arrays
+stack-checker.backend compiler.tree compiler.tree.combinators ;
+IN: compiler.tree.normalization
+
+! A transform pass done before optimization can begin to
+! fix up some oddities in the tree output by the stack checker:
+!
+! - We rewrite the code is that #introduce nodes only appear
+! at the top level, and not inside #recursive. This enables more
+! accurate type inference for 'row polymorphic' combinators.
+!
+! - We collect #return-recursive and #call-recursive nodes and
+! store them in the #recursive's label slot.
+
+GENERIC: normalize* ( node -- )
+
+! Collect introductions
+SYMBOL: introductions
+
+GENERIC: collect-introductions* ( node -- )
+
+: collect-introductions ( nodes -- n )
+    [
+        0 introductions set
+        [ collect-introductions* ] each
+        introductions get
+    ] with-scope ;
+
+M: #introduce collect-introductions* drop introductions inc ;
+
+M: #branch collect-introductions*
+    children>>
+    [ collect-introductions ] map supremum
+    introductions [ + ] change ;
+
+M: node collect-introductions* drop ;
+
+! Eliminate introductions
+SYMBOL: introduction-stack
+
+: fixup-enter-recursive ( recursive -- )
+    [ child>> first ] [ in-d>> ] bi >>in-d
+    [ introduction-stack get prepend ] change-out-d
+    drop ;
+
+GENERIC: eliminate-introductions* ( node -- node' )
+
+: pop-introduction ( -- value )
+    introduction-stack [ unclip-last swap ] change ;
+
+M: #introduce eliminate-introductions*
+    pop-introduction swap value>> [ 1array ] bi@ #copy ;
+
+SYMBOL: remaining-introductions
+
+M: #branch eliminate-introductions*
+    dup children>> [
+        [
+            [ eliminate-introductions* ] change-each
+            introduction-stack get
+        ] with-scope
+    ] map
+    [ remaining-introductions set ]
+    [ [ length ] map infimum introduction-stack [ swap head ] change ]
+    bi ;
+
+M: #phi eliminate-introductions*
+    remaining-introductions get swap
+    [ flip [ over length tail append ] 2map flip ] change-phi-in-d ;
+
+M: node eliminate-introductions* ;
+
+: eliminate-introductions ( recursive n -- )
+    make-values introduction-stack set
+    [ fixup-enter-recursive ]
+    [ child>> [ eliminate-introductions* ] change-each ] bi ;
+
+M: #recursive normalize*
+    [
+        [ child>> collect-introductions ]
+        [ swap eliminate-introductions ]
+        bi
+    ] with-scope ;
+
+! Collect label info
+M: #return-recursive normalize* dup label>> (>>return) ;
+
+M: #call-recursive normalize* dup label>> calls>> push ;
+
+M: node normalize* drop ;
+
+: normalize ( node -- node ) dup [ normalize* ] each-node ;

unfinished/compiler/tree/optimizer/optimizer.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: compiler.tree.normalization compiler.tree.copy-equiv
+compiler.tree.propagation compiler.tree.cleanup
+compiler.tree.def-use compiler.tree.untupling
+compiler.tree.dead-code compiler.tree.strength-reduction
+compiler.tree.loop-detection compiler.tree.branch-fusion ;
+IN: compiler.tree.optimizer
+
+: optimize-tree ( nodes -- nodes' )
+    normalize
+    compute-copy-equiv
+    propagate
+    cleanup
+    compute-def-use
+    unbox-tuples
+    compute-def-use
+    remove-dead-code
+    strength-reduce
+    detect-loops
+    fuse-branches ;

unfinished/compiler/tree/propagation/branches/branches.factor

@@ -31,21 +31,23 @@ M: #dispatch live-children
     [ children>> ] [ in-d>> first value-info interval>> ] bi
     '[ , interval-contains? [ drop f ] unless ] map-index ;
 
-: infer-children ( node -- assocs )
+SYMBOL: infer-children-data
+
+: infer-children ( node -- )
     [ live-children ] [ child-constraints ] bi [
         [
             over [
                 value-infos [ clone ] change
                 constraints [ clone ] change
                 assume
-                first>> (propagate)
+                (propagate)
             ] [
                 2drop
                 value-infos off
                 constraints off
             ] if
         ] H{ } make-assoc
-    ] 2map ;
+    ] 2map infer-children-data set ;
 
 : (merge-value-infos) ( inputs results -- infos )
     '[ , [ [ value-info ] bind ] 2map value-infos-union ] map ;
@@ -53,7 +55,8 @@ M: #dispatch live-children
 : merge-value-infos ( results inputs outputs -- )
     [ swap (merge-value-infos) ] dip set-value-infos ;
 
-: propagate-branch-phi ( results #phi -- )
+M: #phi propagate-before ( #phi -- )
+    infer-children-data get swap
     [ [ phi-in-d>> ] [ out-d>> ] bi merge-value-infos ]
     [ [ phi-in-r>> ] [ out-r>> ] bi merge-value-infos ]
     2bi ;
@@ -67,10 +70,10 @@ M: #dispatch live-children
         ] [ 3drop ] if
     ] 2each ;
 
-: merge-children ( results node -- )
+! : merge-children
-    [ successor>> propagate-branch-phi ]
+!     [ successor>> propagate-branch-phi ]
-    [ [ in-d>> first ] [ successor>> ] bi 2drop ] ! branch-phi-constraints ]
+!     [ [ in-d>> first ] [ successor>> ] bi 2drop ] ! branch-phi-constraints ]
-    bi ;
+!     bi ;
 
 M: #branch propagate-around
-    [ infer-children ] [ merge-children ] [ annotate-node ] tri ;
+    [ infer-children ] [ annotate-node ] bi ;

unfinished/compiler/tree/propagation/inlining/inlining.factor

@@ -0,0 +1,3 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.tree.propagation.inlining

unfinished/compiler/tree/propagation/nodes/nodes.factor

@@ -14,9 +14,4 @@ GENERIC: propagate-after ( node -- )
 
 GENERIC: propagate-around ( node -- )
 
-: (propagate) ( node -- )
+: (propagate) ( node -- ) [ [ propagate-around ] each ] when* ;
-    [
-        USING: classes prettyprint ; dup class .
-        [ propagate-around ] [ successor>> ] bi
-        (propagate)
-    ] when* ;

unfinished/compiler/tree/propagation/propagation-tests.factor

@@ -1,6 +1,6 @@
 USING: kernel compiler.tree.builder compiler.tree
 compiler.tree.propagation compiler.tree.copy-equiv
-compiler.tree.def-use tools.test math math.order
+compiler.tree.normalization tools.test math math.order
 accessors sequences arrays kernel.private vectors
 alien.accessors alien.c-types sequences.private
 byte-arrays classes.algebra classes.tuple.private
@@ -13,10 +13,10 @@ IN: compiler.tree.propagation.tests
 
 : final-info ( quot -- seq )
     build-tree
-    compute-def-use
+    normalize
     compute-copy-equiv
     propagate
-    last-node node-input-infos ;
+    peek node-input-infos ;
 
 : final-classes ( quot -- seq )
     final-info [ class>> ] map ;

unfinished/compiler/tree/propagation/recursive/recursive.factor

@@ -59,7 +59,7 @@ M: #recursive propagate-around ( #recursive -- )
     iter-counter inc
     iter-counter get 10 > [ "Oops" throw ] when
     dup label>> t >>fixed-point drop
-    [ node-child first>> [ propagate-recursive-phi ] [ (propagate) ] bi ]
+    [ child>> [ first propagate-recursive-phi ] [ (propagate) ] bi ]
     [ dup label>> fixed-point>> [ drop ] [ propagate-around ] if ]
     bi ;
 

unfinished/compiler/tree/propagation/simple/simple.factor

@@ -13,7 +13,7 @@ compiler.tree.propagation.constraints ;
 IN: compiler.tree.propagation.simple
 
 M: #introduce propagate-before
-    object <class-info> swap values>> [ set-value-info ] with each ;
+    value>> object <class-info> swap set-value-info ;
 
 M: #push propagate-before
     [ literal>> value>> <literal-info> ] [ out-d>> first ] bi

unfinished/compiler/tree/strength-reduction/strength-reduction.factor

@@ -0,0 +1,5 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: compiler.tree.strength-reduction
+
+: strength-reduce ( nodes -- nodes' ) ;

unfinished/compiler/tree/tree.factor

@@ -6,41 +6,17 @@ accessors combinators stack-checker.state stack-checker.visitor ;
 IN: compiler.tree
 
 ! High-level tree SSA form.
-!
+
-! Invariants:
+TUPLE: node < identity-tuple info ;
-! 1) Each value has exactly one definition. A "definition" means
-! the value appears in the out-d or out-r slot of a node, or the
-! values slot of an #introduce node.
-! 2) Each value appears only once in the inputs of a node, where
-! the inputs are the concatenation of in-d and in-r, or in the
-! case of a #phi node, the sequence of sequences in the phi-in-r
-! and phi-in-d slots.
-! 3) A value is never used in the same node where it is defined.
-TUPLE: node < identity-tuple
-in-d out-d in-r out-r info
-successor children ;
 
 M: node hashcode* drop node hashcode* ;
 
-: node-child ( node -- child ) children>> first ;
+TUPLE: #introduce < node value ;
 
-: last-node ( node -- last )
+: #introduce ( value -- node )
-    dup successor>> [ last-node ] [ ] ?if ;
+    \ #introduce new swap >>value ;
 
-: penultimate-node ( node -- penultimate )
+TUPLE: #call < node word history in-d out-d ;
-    dup successor>> dup [
-        dup successor>>
-        [ nip penultimate-node ] [ drop ] if
-    ] [
-        2drop f
-    ] if ;
-
-TUPLE: #introduce < node values ;
-
-: #introduce ( values -- node )
-    \ #introduce new swap >>values ;
-
-TUPLE: #call < node word history ;
 
 : #call ( inputs outputs word -- node )
     \ #call new
@@ -48,7 +24,7 @@ TUPLE: #call < node word history ;
         swap >>out-d
         swap >>in-d ;
 
-TUPLE: #call-recursive < node label ;
+TUPLE: #call-recursive < node label in-d out-d ;
 
 : #call-recursive ( inputs outputs label -- node )
     \ #call-recursive new
@@ -56,14 +32,14 @@ TUPLE: #call-recursive < node label ;
         swap >>out-d
         swap >>in-d ;
 
-TUPLE: #push < node literal ;
+TUPLE: #push < node literal out-d ;
 
 : #push ( literal value -- node )
     \ #push new
         swap 1array >>out-d
         swap >>literal ;
 
-TUPLE: #shuffle < node mapping ;
+TUPLE: #shuffle < node mapping in-d out-d ;
 
 : #shuffle ( inputs outputs mapping -- node )
     \ #shuffle new
@@ -74,27 +50,27 @@ TUPLE: #shuffle < node mapping ;
 : #drop ( inputs -- node )
     { } { } #shuffle ;
 
-TUPLE: #>r < node ;
+TUPLE: #>r < node in-d out-r ;
 
 : #>r ( inputs outputs -- node )
     \ #>r new
         swap >>out-r
         swap >>in-d ;
 
-TUPLE: #r> < node ;
+TUPLE: #r> < node in-r out-d ;
 
 : #r> ( inputs outputs -- node )
     \ #r> new
         swap >>out-d
         swap >>in-r ;
 
-TUPLE: #terminate < node ;
+TUPLE: #terminate < node in-d ;
 
 : #terminate ( stack -- node )
     \ #terminate new
         swap >>in-d ;
 
-TUPLE: #branch < node ;
+TUPLE: #branch < node in-d children ;
 
 : new-branch ( value children class -- node )
     new
@@ -111,7 +87,7 @@ TUPLE: #dispatch < #branch ;
 : #dispatch ( n branches -- node )
     \ #dispatch new-branch ;
 
-TUPLE: #phi < node phi-in-d phi-in-r ;
+TUPLE: #phi < node phi-in-d phi-in-r out-d out-r ;
 
 : #phi ( d-phi-in d-phi-out r-phi-in r-phi-out -- node )
     \ #phi new
@@ -126,22 +102,22 @@ TUPLE: #declare < node declaration ;
     \ #declare new
         swap >>declaration ;
 
-TUPLE: #return < node ;
+TUPLE: #return < node in-d ;
 
 : #return ( stack -- node )
     \ #return new
         swap >>in-d ;
 
-TUPLE: #recursive < node word label loop? returns calls ;
+TUPLE: #recursive < node in-d word label loop? returns calls child ;
 
 : #recursive ( word label inputs child -- node )
     \ #recursive new
-        swap 1array >>children
+        swap >>child
         swap >>in-d
         swap >>label
         swap >>word ;
 
-TUPLE: #enter-recursive < node label ;
+TUPLE: #enter-recursive < node in-d out-d label ;
 
 : #enter-recursive ( label inputs outputs -- node )
     \ #enter-recursive new
@@ -149,7 +125,7 @@ TUPLE: #enter-recursive < node label ;
         swap >>in-d
         swap >>label ;
 
-TUPLE: #return-recursive < node label ;
+TUPLE: #return-recursive < node in-d out-d label ;
 
 : #return-recursive ( label inputs outputs -- node )
     \ #return-recursive new
@@ -157,44 +133,31 @@ TUPLE: #return-recursive < node label ;
         swap >>in-d
         swap >>label ;
 
-TUPLE: #copy < node ;
+TUPLE: #copy < node in-d out-d ;
 
 : #copy ( inputs outputs -- node )
     \ #copy new
         swap >>out-d
         swap >>in-d ;
 
-DEFER: #tail?
+: node, ( node -- ) stack-visitor get push ;
 
-PREDICATE: #tail-phi < #phi successor>> #tail? ;
+M: vector child-visitor V{ } clone ;
-
+M: vector #introduce, #introduce node, ;
-UNION: #tail POSTPONE: f #return #tail-phi #terminate ;
+M: vector #call, #call node, ;
-
+M: vector #push, #push node, ;
-TUPLE: node-list first last ;
+M: vector #shuffle, #shuffle node, ;
-
+M: vector #drop, #drop node, ;
-: node, ( node -- )
+M: vector #>r, #>r node, ;
-    stack-visitor get swap
+M: vector #r>, #r> node, ;
-    over last>>
+M: vector #return, #return node, ;
-    [ [ [ last>> ] dip >>successor drop ] [ >>last drop ] 2bi ]
+M: vector #enter-recursive, #enter-recursive node, ;
-    [ [ >>first ] [ >>last ] bi drop ]
+M: vector #return-recursive, #return-recursive node, ;
-    if ;
+M: vector #call-recursive, #call-recursive node, ;
-
+M: vector #terminate, #terminate node, ;
-M: node-list child-visitor node-list new ;
+M: vector #if, #if node, ;
-M: node-list #introduce, #introduce node, ;
+M: vector #dispatch, #dispatch node, ;
-M: node-list #call, #call node, ;
+M: vector #phi, #phi node, ;
-M: node-list #push, #push node, ;
+M: vector #declare, #declare node, ;
-M: node-list #shuffle, #shuffle node, ;
+M: vector #recursive, #recursive node, ;
-M: node-list #drop, #drop node, ;
+M: vector #copy, #copy node, ;
-M: node-list #>r, #>r node, ;
-M: node-list #r>, #r> node, ;
-M: node-list #return, #return node, ;
-M: node-list #enter-recursive, #enter-recursive node, ;
-M: node-list #return-recursive, #return-recursive [ node, ] [ dup label>> (>>return) ] bi ;
-M: node-list #call-recursive, #call-recursive [ node, ] [ dup label>> calls>> push ] bi ;
-M: node-list #terminate, #terminate node, ;
-M: node-list #if, #if node, ;
-M: node-list #dispatch, #dispatch node, ;
-M: node-list #phi, #phi node, ;
-M: node-list #declare, #declare node, ;
-M: node-list #recursive, #recursive node, ;
-M: node-list #copy, #copy node, ;

unfinished/compiler/tree/untupling/untupling.factor

@@ -3,7 +3,8 @@
 USING: accessors slots.private kernel namespaces disjoint-sets
 math sequences assocs classes.tuple.private combinators fry sets
 compiler.tree compiler.tree.combinators compiler.tree.copy-equiv
-compiler.tree.dfa compiler.tree.dfa.backward ;
+compiler.tree.dataflow-analysis
+compiler.tree.dataflow-analysis.backward ;
 IN: compiler.tree.untupling
 
 SYMBOL: escaping-values

unfinished/stack-checker/backend/backend.factor

@@ -41,7 +41,7 @@ SYMBOL: visited
 
 : pop-d  ( -- obj )
     meta-d get dup empty? [
-        drop <value> dup 1array #introduce, d-in inc
+        drop <value> dup #introduce, d-in inc
     ] [ pop ] if ;
 
 : peek-d ( -- obj ) pop-d dup push-d ;
@@ -52,8 +52,11 @@ SYMBOL: visited
 
 : ensure-d ( n -- values ) consume-d dup output-d ;
 
+: make-values ( n -- values )
+    [ <value> ] replicate ;
+
 : produce-d ( n -- values )
-    [ <value> ] replicate dup meta-d get push-all ;
+    make-values dup meta-d get push-all ;
 
 : push-r ( obj -- ) meta-r get push ;
 

unfinished/stack-checker/visitor/visitor.factor

@@ -9,7 +9,7 @@ HOOK: child-visitor stack-visitor ( -- visitor )
 
 : nest-visitor ( -- ) child-visitor stack-visitor set ;
 
-HOOK: #introduce, stack-visitor ( values -- )
+HOOK: #introduce, stack-visitor ( value -- )
 HOOK: #call, stack-visitor ( inputs outputs word -- )
 HOOK: #call-recursive, stack-visitor ( inputs outputs word -- )
 HOOK: #push, stack-visitor ( literal value -- )