compiler.cfg.utilities: add each-phi combinator to iterate over all ##phi instructions in a basic block

basis/compiler/cfg/debugger/debugger.factor

@@ -53,9 +53,9 @@ M: ds-loc pprint* \ D pprint-loc ;
 M: rs-loc pprint* \ R pprint-loc ;
 
 : resolve-phis ( bb -- )
-    instructions>> [ ##phi? ] filter [
+    [
         [ [ [ get ] dip ] assoc-map ] change-inputs drop
-    ] each ;
+    ] each-phi ;
 
 : test-bb ( insns n -- )
     [ <basic-block> swap >>number swap >>instructions dup ] keep set

basis/compiler/cfg/liveness/ssa/ssa.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces deques accessors sets sequences assocs fry
 hashtables dlists compiler.cfg.def-use compiler.cfg.instructions
-compiler.cfg.rpo compiler.cfg.liveness ;
+compiler.cfg.rpo compiler.cfg.liveness compiler.cfg.utilities ;
 IN: compiler.cfg.liveness.ssa
 
 ! TODO: merge with compiler.cfg.liveness
@@ -22,11 +22,9 @@ SYMBOL: work-list
     [ live-out ] keep instructions>> transfer-liveness ;
 
 : compute-phi-live-in ( basic-block -- phi-live-in )
-    instructions>> [ ##phi? ] filter [ f ] [
+    H{ } clone [
-        H{ } clone [
+        '[ inputs>> [ swap _ conjoin-at ] assoc-each ] each-phi
-            '[ inputs>> [ swap _ conjoin-at ] assoc-each ] each
+    ] keep ;
-        ] keep
-    ] if-empty ;
 
 : update-live-in ( basic-block -- changed? )
     [ [ compute-live-in ] keep live-ins get maybe-set-at ]

basis/compiler/cfg/predecessors/predecessors.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors combinators fry sequences assocs compiler.cfg.rpo
-compiler.cfg.instructions ;
+compiler.cfg.instructions compiler.cfg.utilities ;
 IN: compiler.cfg.predecessors
 
 : update-predecessors ( bb -- )
@@ -14,9 +14,7 @@ IN: compiler.cfg.predecessors
     ] change-inputs drop ;
 
 : update-phis ( bb -- )
-    dup instructions>> [
+    dup [ update-phi ] with each-phi ;
-        dup ##phi? [ update-phi ] [ 2drop ] if
-    ] with each ;
 
 : compute-predecessors ( cfg -- cfg' )
     {

basis/compiler/cfg/ssa/destruction/destruction.factor

@@ -34,7 +34,7 @@ SYMBOL: seen
     ] [ src seen get conjoin ] if ;
 
 :: break-interferences ( -- )
-    V{ } clone seen set
+    H{ } clone seen set
     renaming-sets get [| dst assoc |
         assoc [| src bb |
             dst assoc src bb visit-renaming
@@ -49,9 +49,9 @@ SYMBOL: seen
 
 : destruct-ssa ( cfg -- cfg' )
     dup cfg-has-phis? [
-        init-coalescing
-        compute-ssa-live-sets
         dup split-critical-edges
+        compute-ssa-live-sets
+        init-coalescing
         dup compute-def-use
         dup compute-dominance
         dup compute-live-ranges

basis/compiler/cfg/utilities/utilities.factor

@@ -58,6 +58,10 @@ SYMBOL: visited
 : if-has-phis ( bb quot: ( bb -- ) -- )
     [ dup has-phis? ] dip [ drop ] if ; inline
 
+: each-phi ( bb quot: ( ##phi -- ) -- )
+    [ instructions>> ] dip
+    '[ dup ##phi? [ @ t ] [ drop f ] if ] all? drop ; inline
+
 : predecessor ( bb -- pred )
     predecessors>> first ; inline