More escape analysis work

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

@@ -8,11 +8,9 @@ IN: compiler.tree.dataflow-analysis
 ! Dataflow analysis
 SYMBOL: work-list
 
-: look-at-value ( values -- )
+: look-at-value ( values -- ) work-list get push-front ;
-    work-list get push-front ;
 
-: look-at-values ( values -- )
+: look-at-values ( values -- ) work-list get push-all-front ;
-    work-list get '[ , push-front ] each ;
 
 : look-at-inputs ( node -- ) in-d>> look-at-values ;
 

unfinished/compiler/tree/escape-analysis/allocations/allocations.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs namespaces sequences kernel math combinators sets
-stack-checker.state compiler.tree.copy-equiv ;
+fry stack-checker.state compiler.tree.copy-equiv
+compiler.tree.escape-analysis.graph ;
 IN: compiler.tree.escape-analysis.allocations
 
 SYMBOL: escaping
@@ -25,24 +26,33 @@ SYMBOL: allocations
 : record-slot-access ( out slot# in -- )
     over zero? [ 3drop ] [ allocation ?nth swap is-copy-of ] if ;
 
-! A map from values to sequences of values
+! We track available values
-SYMBOL: slot-merging
+SYMBOL: slot-graph
 
 : merge-slots ( values -- value )
     dup [ ] contains? [
         <value>
         [ introduce-value ]
-        [ slot-merging get set-at ]
+        [ slot-graph get add-edges ]
         [ ] tri
     ] [ drop f ] if ;
 
-! If an allocation's slot appears in this set, the allocation
+! A disqualified slot value is not available for unboxing. A
-! is disqualified from unboxing.
+! tuple may be unboxed if none of its slots have been
-SYMBOL: disqualified
+! disqualified.
 
 : disqualify ( slot-value -- )
-    [ disqualified get conjoin ]
+    slot-graph get mark-vertex ;
-    [ slot-merging get at [ disqualify ] each ] bi ;
+
+SYMBOL: escaping-allocations
+
+: compute-escaping-allocations ( -- )
+    #! Any allocations involving unavailable slots are
+    #! potentially escaping, and cannot be unboxed.
+    allocations get
+    slot-graph get marked-components
+    '[ [ , key? ] contains? nip ] assoc-filter
+    escaping-allocations set ;
 
 : escaping-allocation? ( value -- ? )
-    allocation [ [ disqualified get key? ] contains? ] [ t ] if* ;
+    escaping-allocations get key? ;

unfinished/compiler/tree/escape-analysis/escape-analysis-tests.factor

@@ -5,7 +5,7 @@ compiler.tree.normalization compiler.tree.copy-equiv
 compiler.tree.propagation compiler.tree.cleanup
 compiler.tree.combinators compiler.tree sequences math
 kernel tools.test accessors slots.private quotations.private
-prettyprint ;
+prettyprint classes.tuple.private ;
 
 \ escape-analysis must-infer
 
@@ -19,9 +19,9 @@ prettyprint ;
     0 swap [
         dup #call?
         [
-            out-d>> dup empty? [ drop ] [
+            dup word>> \ <tuple-boa> = [
-                first escaping-allocation? [ 1+ ] unless
+                out-d>> first escaping-allocation? [ 1+ ] unless
-            ] if
+            ] [ drop ] if
         ] [ drop ] if
     ] each-node ;
 

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

@@ -3,17 +3,16 @@
 USING: kernel namespaces search-dequeues
 compiler.tree
 compiler.tree.def-use
+compiler.tree.escape-analysis.graph
 compiler.tree.escape-analysis.allocations
 compiler.tree.escape-analysis.recursive
 compiler.tree.escape-analysis.branches
 compiler.tree.escape-analysis.nodes
-compiler.tree.escape-analysis.simple
+compiler.tree.escape-analysis.simple ;
-compiler.tree.escape-analysis.work-list ;
 IN: compiler.tree.escape-analysis
 
 : escape-analysis ( node -- node )
-    H{ } clone slot-merging set
     H{ } clone allocations set
-    H{ } clone disqualified set
+    <graph> slot-graph set
-    <hashed-dlist> work-list set
+    dup (escape-analysis)
-    dup (escape-analysis) ;
+    compute-escaping-allocations ;

unfinished/compiler/tree/escape-analysis/graph/graph-tests.factor

@@ -0,0 +1,19 @@
+IN: compiler.tree.escape-analysis.graph.tests
+USING: compiler.tree.escape-analysis.graph tools.test namespaces
+accessors ;
+
+<graph> "graph" set
+
+[ ] [ { 2 3 4 } 1 "graph" get add-edges ] unit-test
+[ ] [ { 5 6 } 2 "graph" get add-edges ] unit-test
+[ ] [ { 7 8 } 9 "graph" get add-edges ] unit-test
+[ ] [ { 6 10 } 4 "graph" get add-edges ] unit-test
+
+[ ] [ 3 "graph" get mark-vertex ] unit-test
+
+[ H{ { 1 1 } { 2 2 } { 3 3 } { 4 4 } { 5 5 } { 6 6 } { 10 10 } } ]
+[ "graph" get marked>> ] unit-test
+
+[ ] [ { 1 11 } 12 "graph" get add-edges ] unit-test
+
+[ t ] [ 11 "graph" get marked-vertex? ] unit-test

unfinished/compiler/tree/escape-analysis/graph/graph.factor

@@ -0,0 +1,38 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors assocs fry sequences sets
+dequeues search-dequeues namespaces ;
+IN: compiler.tree.escape-analysis.graph
+
+TUPLE: graph edges work-list ;
+
+: <graph> ( -- graph )
+    H{ } clone <hashed-dlist> graph boa ;
+
+: mark-vertex ( vertex graph -- ) work-list>> push-front ;
+
+: add-edge ( out in graph -- )
+    [ edges>> push-at ] [ swapd edges>> push-at ] 3bi ;
+
+: add-edges ( out-seq in graph -- )
+    '[ , , add-edge ] each ;
+
+<PRIVATE
+
+SYMBOL: marked
+
+: (mark-vertex) ( vertex graph -- )
+    over marked get key? [ 2drop ] [
+        [ drop marked get conjoin ]
+        [ [ edges>> at ] [ work-list>> ] bi push-all-front ]
+        2bi
+    ] if ;
+
+PRIVATE>
+
+: marked-components ( graph -- vertices )
+    #! All vertices in connected components of marked vertices.
+    H{ } clone marked [
+        [ work-list>> ] keep
+        '[ , (mark-vertex) ] slurp-dequeue
+    ] with-variable ;

unfinished/compiler/tree/escape-analysis/simple/simple.factor

@@ -6,7 +6,6 @@ combinators dequeues search-dequeues namespaces fry
 compiler.tree
 compiler.tree.propagation.info
 compiler.tree.escape-analysis.nodes
-compiler.tree.escape-analysis.work-list
 compiler.tree.escape-analysis.allocations ;
 IN: compiler.tree.escape-analysis.simple
 

unfinished/compiler/tree/escape-analysis/work-list/work-list.factor

@@ -1,9 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: dequeues namespaces sequences fry ;
-IN: compiler.tree.escape-analysis.work-list
-
-SYMBOL: work-list
-
-: add-escaping-values ( values -- )
-    work-list get '[ , push-front ] each ;