Only annotate certain nodes ith value info

basis/compiler/tree/escape-analysis/escape-analysis.factor

@@ -3,7 +3,6 @@
 USING: kernel namespaces search-dequeues assocs fry sequences
 disjoint-sets
 compiler.tree
-compiler.tree.def-use
 compiler.tree.escape-analysis.allocations
 compiler.tree.escape-analysis.recursive
 compiler.tree.escape-analysis.branches

basis/compiler/tree/propagation/branches/branches.factor

@@ -4,7 +4,6 @@ USING: fry kernel sequences assocs accessors namespaces
 math.intervals arrays classes.algebra combinators columns
 stack-checker.branches
 compiler.tree
-compiler.tree.def-use
 compiler.tree.combinators
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
@@ -72,9 +71,6 @@ SYMBOL: infer-children-data
 : annotate-phi-inputs ( #phi -- )
     dup phi-in-d>> compute-phi-input-infos >>phi-info-d drop ;
 
-: annotate-phi-outputs ( #phi -- )
-    dup out-d>> extract-value-info >>info drop ;
-
 : merge-value-infos ( infos outputs -- )
     [ [ value-infos-union ] map ] dip set-value-infos ;
 
@@ -83,8 +79,7 @@ SYMBOL: condition-value
 M: #phi propagate-before ( #phi -- )
     [ annotate-phi-inputs ]
     [ [ phi-info-d>> <flipped> ] [ out-d>> ] bi merge-value-infos ]
-    [ annotate-phi-outputs ]
+    bi ;
-    tri ;
 
 : branch-phi-constraints ( output values booleans -- )
      {

basis/compiler/tree/propagation/nodes/nodes.factor

@@ -2,7 +2,6 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences accessors kernel assocs sequences
 compiler.tree
-compiler.tree.def-use
 compiler.tree.propagation.copy
 compiler.tree.propagation.info ;
 IN: compiler.tree.propagation.nodes
@@ -14,6 +13,8 @@ GENERIC: propagate-before ( node -- )
 
 GENERIC: propagate-after ( node -- )
 
+GENERIC: annotate-node ( node -- )
+
 GENERIC: propagate-around ( node -- )
 
 : (propagate) ( node -- )
@@ -22,15 +23,14 @@ GENERIC: propagate-around ( node -- )
 : extract-value-info ( values -- assoc )
     [ dup value-info ] H{ } map>assoc ;
 
-: annotate-node ( node -- )
+: (annotate-node) ( node values -- )
-    dup
+    extract-value-info >>info drop ; inline
-    [ node-defs-values ] [ node-uses-values ] bi append
-    extract-value-info
-    >>info drop ;
 
 M: node propagate-before drop ;
 
 M: node propagate-after drop ;
 
+M: node annotate-node drop ;
+
 M: node propagate-around
     [ propagate-before ] [ annotate-node ] [ propagate-after ] tri ;

basis/compiler/tree/propagation/propagation.factor

@@ -2,7 +2,6 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences namespaces hashtables
 compiler.tree
-compiler.tree.def-use
 compiler.tree.propagation.copy
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes

basis/compiler/tree/propagation/recursive/recursive.factor

@@ -72,6 +72,15 @@ M: #recursive propagate-around ( #recursive -- )
 : return-infos ( node -- infos )
     label>> return>> node-input-infos generalize-return ;
 
-M: #call-recursive propagate-before ( #call-label -- )
+M: #call-recursive propagate-before ( #call-recursive -- )
     [ ] [ return-infos ] [ node-output-infos ] tri
     [ check-fixed-point ] [ drop swap out-d>> set-value-infos ] 3bi ;
+
+M: #call-recursive annotate-node
+    dup [ in-d>> ] [ out-d>> ] bi append (annotate-node) ;
+
+M: #enter-recursive annotate-node
+    dup out-d>> (annotate-node) ;
+
+M: #return-recursive annotate-node
+    dup in-d>> (annotate-node) ;

basis/compiler/tree/propagation/simple/simple.factor

@@ -6,7 +6,6 @@ classes.tuple.private continuations arrays byte-arrays strings
 math math.partial-dispatch math.private slots generic
 generic.standard generic.math
 compiler.tree
-compiler.tree.def-use
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
 compiler.tree.propagation.slots
@@ -109,6 +108,9 @@ M: #call propagate-before
         2bi
     ] if ;
 
+M: #call annotate-node
+    dup [ in-d>> ] [ out-d>> ] bi append (annotate-node) ;
+
 : propagate-input-classes ( node input-classes -- )
     class-infos swap in-d>> refine-value-infos ;
 
@@ -121,3 +123,6 @@ M: #alien-invoke propagate-before
 
 M: #alien-indirect propagate-before
     out-d>> [ object-info swap set-value-info ] each ;
+
+M: #return annotate-node
+    dup in-d>> (annotate-node) ;

basis/compiler/tree/tree.factor

@@ -8,7 +8,7 @@ IN: compiler.tree
 
 ! High-level tree SSA form.
 
-TUPLE: node < identity-tuple info ;
+TUPLE: node < identity-tuple ;
 
 M: node hashcode* drop node hashcode* ;
 
@@ -17,7 +17,7 @@ TUPLE: #introduce < node out-d ;
 : #introduce ( out-d -- node )
     \ #introduce new swap >>out-d ;
 
-TUPLE: #call < node word in-d out-d body method ;
+TUPLE: #call < node word in-d out-d body method info ;
 
 : #call ( inputs outputs word -- node )
     \ #call new
@@ -25,7 +25,7 @@ TUPLE: #call < node word in-d out-d body method ;
         swap >>out-d
         swap >>in-d ;
 
-TUPLE: #call-recursive < node label in-d out-d ;
+TUPLE: #call-recursive < node label in-d out-d info ;
 
 : #call-recursive ( inputs outputs label -- node )
     \ #call-recursive new
@@ -105,7 +105,7 @@ TUPLE: #declare < node declaration ;
     \ #declare new
         swap >>declaration ;
 
-TUPLE: #return < node in-d ;
+TUPLE: #return < node in-d info ;
 
 : #return ( stack -- node )
     \ #return new
@@ -119,7 +119,7 @@ TUPLE: #recursive < node in-d word label loop? child ;
         swap >>in-d
         swap >>label ;
 
-TUPLE: #enter-recursive < node in-d out-d label ;
+TUPLE: #enter-recursive < node in-d out-d label info ;
 
 : #enter-recursive ( label inputs outputs -- node )
     \ #enter-recursive new
@@ -127,7 +127,7 @@ TUPLE: #enter-recursive < node in-d out-d label ;
         swap >>in-d
         swap >>label ;
 
-TUPLE: #return-recursive < #renaming in-d out-d label ;
+TUPLE: #return-recursive < #renaming in-d out-d label info ;
 
 : #return-recursive ( label inputs outputs -- node )
     \ #return-recursive new