compiler.cfg: clean up unit tests using some new utilities

basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor

@@ -46,11 +46,11 @@ V{ T{ ##branch } } 4 test-bb
 
 V{ T{ ##branch } } 5 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
 
-1 get 3 get 4 get V{ } 2sequence >>successors drop
+1 { 3 4 } edges
 
-2 get 3 get 4 get V{ } 2sequence >>successors drop
+2 { 3 4 } edges
 
 [ ] [ test-branch-splitting ] unit-test
 
@@ -64,11 +64,11 @@ V{ T{ ##branch } } 3 test-bb
 
 V{ T{ ##branch } } 4 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
 
-1 get 3 get 4 get V{ } 2sequence >>successors drop
+1 { 3 4 } edges
 
-2 get 4 get 1vector >>successors drop
+2 4 edge
 
 [ ] [ test-branch-splitting ] unit-test
 
@@ -78,8 +78,8 @@ V{ T{ ##branch } } 1 test-bb
 
 V{ T{ ##branch } } 2 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
 
-1 get 2 get 1vector >>successors drop
+1 2 edge
 
 [ ] [ test-branch-splitting ] unit-test

basis/compiler/cfg/debugger/debugger.factor

@@ -1,13 +1,13 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel words sequences quotations namespaces io vectors
-classes.tuple accessors prettyprint prettyprint.config
+classes.tuple accessors prettyprint prettyprint.config assocs
 prettyprint.backend prettyprint.custom prettyprint.sections
 parser compiler.tree.builder compiler.tree.optimizer
 compiler.cfg.builder compiler.cfg.linearization
 compiler.cfg.registers compiler.cfg.stack-frame
 compiler.cfg.linear-scan compiler.cfg.two-operand
-compiler.cfg.optimizer
+compiler.cfg.optimizer compiler.cfg.instructions
 compiler.cfg.mr compiler.cfg ;
 IN: compiler.cfg.debugger
 
@@ -52,11 +52,23 @@ 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 ;
+
 : test-bb ( insns n -- )
-    [ <basic-block> swap >>number swap >>instructions ] keep set ;
+    [ <basic-block> swap >>number swap >>instructions dup ] keep set
+    resolve-phis ;
+
+: edge ( from to -- )
+    [ get ] bi@ 1vector >>successors drop ;
+
+: edges ( from tos -- )
+    [ get ] [ [ get ] V{ } map-as ] bi* >>successors drop ;
 
 : test-diamond ( -- )
-    1 get 1vector 0 get (>>successors)
+    0 1 edge
-    2 get 3 get V{ } 2sequence 1 get (>>successors)
+    1 { 2 3 } edges
-    4 get 1vector 2 get (>>successors)
+    2 4 edge
-    4 get 1vector 3 get (>>successors) ;
+    3 4 edge ;

basis/compiler/cfg/dominance/dominance-tests.factor

@@ -16,11 +16,11 @@ V{ } 3 test-bb
 V{ } 4 test-bb
 V{ } 5 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
-1 get 3 get 1vector >>successors drop
+1 3 edge
-2 get 4 get 1vector >>successors drop
+2 4 edge
-3 get 4 get 1vector >>successors drop
+3 4 edge
-4 get 5 get 1vector >>successors drop
+4 5 edge
 
 [ ] [ test-dominance ] unit-test
 
@@ -46,11 +46,11 @@ V{ } 2 test-bb
 V{ } 3 test-bb
 V{ } 4 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
-1 get 3 get 1vector >>successors drop
+1 3 edge
-2 get 4 get 1vector >>successors drop
+2 4 edge
-3 get 4 get 1vector >>successors drop
+3 4 edge
-4 get 3 get 1vector >>successors drop
+4 3 edge
 
 [ ] [ test-dominance ] unit-test
 
@@ -64,12 +64,12 @@ V{ } 3 test-bb
 V{ } 4 test-bb
 V{ } 5 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
-1 get 5 get 1vector >>successors drop
+1 5 edge
-2 get 4 get 3 get V{ } 2sequence >>successors drop
+2 { 4 3 } edges
-5 get 4 get 1vector >>successors drop
+5 4 edge
-4 get 5 get 3 get V{ } 2sequence >>successors drop
+4 { 5 3 } edges
-3 get 4 get 1vector >>successors drop
+3 4 edge
 
 [ ] [ test-dominance ] unit-test
 

basis/compiler/cfg/gc-checks/gc-checks-tests.factor

@@ -19,7 +19,7 @@ V{
     T{ ##box-float f V int-regs 0 V int-regs 1 }
 } 1 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
 
 [ ] [ test-gc-checks ] unit-test
 

basis/compiler/cfg/linear-scan/linear-scan-tests.factor

@@ -1549,9 +1549,9 @@ V{
     T{ ##return }
 } 3 test-bb
 
-1 get 1vector 0 get (>>successors)
+0 1 edge
-2 get 3 get V{ } 2sequence 1 get (>>successors)
+1 { 2 3 } edges
-3 get 1vector 2 get (>>successors)
+2 3 edge
 
 SYMBOL: linear-scan-result
 
@@ -1564,9 +1564,7 @@ SYMBOL: linear-scan-result
         flatten-cfg 1array mr.
     ] with-scope ;
 
-! This test has a critical edge -- do we care about these?
+[ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
-
-! [ { 1 2 } test-linear-scan-on-cfg ] unit-test
 
 ! Bug in inactive interval handling
 ! [ rot dup [ -rot ] when ]
@@ -1896,11 +1894,11 @@ V{
     T{ ##return }
 } 6 test-bb
 
-0 get 1 get V{ } 1sequence >>successors drop
+0 1 edge
-1 get 2 get 3 get V{ } 2sequence >>successors drop
+1 { 2 3 } edges
-2 get 4 get V{ } 1sequence >>successors drop
+2 4 edge
-3 get 4 get V{ } 1sequence >>successors drop
+3 4 edge
-4 get 5 get 6 get V{ } 2sequence >>successors drop
+4 { 5 6 } edges
 
 [ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test
 
@@ -1956,14 +1954,14 @@ V{
     T{ ##return }
 } 9 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
-1 get 2 get 7 get V{ } 2sequence >>successors drop
+1 { 2 7 } edges
-7 get 8 get 1vector >>successors drop
+7 8 edge
-8 get 9 get 1vector >>successors drop
+8 9 edge
-2 get 3 get 5 get V{ } 2sequence >>successors drop
+2 { 3 5 } edges
-3 get 4 get 1vector >>successors drop
+3 4 edge
-4 get 9 get 1vector >>successors drop
+4 9 edge
-5 get 6 get 1vector >>successors drop
+5 6 edge
 
 [ ] [ { 1 2 3 4 } test-linear-scan-on-cfg ] unit-test
 
@@ -2139,11 +2137,11 @@ V{
     T{ ##return }
 } 5 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
-1 get 2 get 4 get V{ } 2sequence >>successors drop
+1 { 2 4 } edges
-2 get 3 get 1vector >>successors drop
+2 3 edge
-3 get 5 get 1vector >>successors drop
+3 5 edge
-4 get 5 get 1vector >>successors drop
+4 5 edge
 
 [ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
 
@@ -2286,12 +2284,12 @@ V{
     T{ ##return }
 } 6 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
-1 get 2 get 5 get V{ } 2sequence >>successors drop
+1 { 2 5 } edges
-2 get 3 get 1vector >>successors drop
+2 3 edge
-3 get 4 get 1vector >>successors drop
+3 4 edge
-4 get 6 get 1vector >>successors drop
+4 6 edge
-5 get 6 get 1vector >>successors drop
+5 6 edge
 
 [ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test
 
@@ -2419,8 +2417,8 @@ V{
     T{ ##return }
 } 2 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
-1 get 2 get 1vector >>successors drop
+1 2 edge
 
 [ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test
 
@@ -2444,7 +2442,7 @@ V{
     T{ ##return }
 } 2 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
 
 [ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test
 

basis/compiler/cfg/liveness/liveness-tests.factor

@@ -29,7 +29,7 @@ V{
     T{ ##return }
 } 3 test-bb
 
-1 get 2 get 3 get V{ } 2sequence >>successors drop
+1 { 2 3 } edges
 
 test-liveness
 
@@ -55,7 +55,7 @@ V{
     T{ ##return }
 } 2 test-bb
 
-1 get 2 get 1vector >>successors drop
+1 2 edge
 
 test-liveness
 

basis/compiler/cfg/ssa/construction/construction-tests.factor

@@ -34,9 +34,9 @@ V{
     T{ ##return }
 } 3 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
-1 get 3 get 1vector >>successors drop
+1 3 edge
-2 get 3 get 1vector >>successors drop
+2 3 edge
 
 : test-ssa ( -- )
     cfg new 0 get >>entry
@@ -93,12 +93,12 @@ V{ T{ ##replace f V int-regs 0 D 0 } } 4 test-bb
 V{ } 5 test-bb
 V{ } 6 test-bb
 
-0 get 1 get 5 get V{ } 2sequence >>successors drop
+0 { 1 5 } edges
-1 get 2 get 3 get V{ } 2sequence >>successors drop
+1 { 2 3 } edges
-2 get 4 get 1vector >>successors drop
+2 4 edge
-3 get 4 get 1vector >>successors drop
+3 4 edge
-4 get 6 get 1vector >>successors drop
+4 6 edge
-5 get 6 get 1vector >>successors drop
+5 6 edge
 
 [ ] [ test-ssa ] unit-test
 

basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor

@@ -17,11 +17,11 @@ V{ } 3 test-bb
 V{ } 4 test-bb
 V{ } 5 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
-1 get 3 get 1vector >>successors drop
+1 3 edge
-2 get 4 get 1vector >>successors drop
+2 4 edge
-3 get 4 get 1vector >>successors drop
+3 4 edge
-4 get 5 get 1vector >>successors drop
+4 5 edge
 
 [ ] [ test-tdmsc ] unit-test
 
@@ -38,12 +38,12 @@ V{ } 4 test-bb
 V{ } 5 test-bb
 V{ } 6 test-bb
 
-0 get 1 get 5 get V{ } 2sequence >>successors drop
+0 { 1 5 } edges
-1 get 2 get 3 get V{ } 2sequence >>successors drop
+1 { 2 3 } edges
-2 get 4 get 1vector >>successors drop
+2 4 edge
-3 get 4 get 1vector >>successors drop
+3 4 edge
-4 get 6 get 1vector >>successors drop
+4 6 edge
-5 get 6 get 1vector >>successors drop
+5 6 edge
 
 [ ] [ test-tdmsc ] unit-test
 
@@ -61,13 +61,13 @@ V{ } 5 test-bb
 V{ } 6 test-bb
 V{ } 7 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
-1 get 2 get 1vector >>successors drop
+1 2 edge
-2 get 3 get 6 get V{ } 2sequence >>successors drop
+2 { 3 6 } edges
-3 get 4 get 1vector >>successors drop
+3 4 edge
-6 get 7 get 1vector >>successors drop
+6 7 edge
-4 get 5 get 1vector >>successors drop
+4 5 edge
-5 get 2 get 1vector >>successors drop
+5 2 edge
 
 [ ] [ test-tdmsc ] unit-test
 

basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor

@@ -13,12 +13,12 @@ V{ T{ ##peek f V int-regs 4 D 0 } } clone 4 test-bb
 V{ T{ ##peek f V int-regs 5 D 0 } } clone 5 test-bb
 V{ T{ ##peek f V int-regs 6 D 0 } } clone 6 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
-2 get 3 get 4 get V{ } 2sequence >>successors drop
+2 { 3 4 } edges
-3 get 5 get 1vector >>successors drop
+3 5 edge
-4 get 5 get 1vector >>successors drop
+4 5 edge
-1 get 6 get 1vector >>successors drop
+1 6 edge
-5 get 6 get 1vector >>successors drop
+5 6 edge
 
 : clean-up-forest ( forest -- forest' )
     [ [ vreg>> n>> ] compare ] sort

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

@@ -31,7 +31,7 @@ V{
     T{ ##replace f V int-regs 3 D 0 }
 } 3 test-bb
 
-1 get 2 get 3 get V{ } 2sequence >>successors drop
+1 { 2 3 } edges
 
 cfg new 1 get >>entry 4 set
 
@@ -132,35 +132,35 @@ cfg new 1 get >>entry 5 set
 ! This is the CFG in Figure 3 from the paper
 V{ } 1 test-bb
 V{ } 2 test-bb
-1 get 2 get 1vector >>successors drop
+1 2 edge
 V{
     T{ ##peek f V int-regs 0 D 0 }
     T{ ##peek f V int-regs 1 D 0 }
     T{ ##peek f V int-regs 2 D 0 }
 } 3 test-bb
 V{ } 11 test-bb
-2 get 3 get 11 get V{ } 2sequence >>successors drop
+2 { 3 11 } edges
 V{
     T{ ##replace f V int-regs 0 D 0 }
 } 4 test-bb
 V{ } 8 test-bb
-3 get 8 get 4 get V{ } 2sequence >>successors drop
+3 { 8 4 } edges
 V{
     T{ ##replace f V int-regs 1 D 0 }
 } 9 test-bb
-8 get 9 get 1vector >>successors drop
+8 9 edge
 V{
     T{ ##replace f V int-regs 2 D 0 }
 } 5 test-bb
-4 get 5 get 1vector >>successors drop
+4 5 edge
 V{ } 10 test-bb
 V{ } 6 test-bb
-5 get 6 get 1vector >>successors drop
+5 6 edge
-9 get 6 get 10 get V{ } 2sequence >>successors drop
+9 { 6 10 } edges
 V{ } 7 test-bb
-6 get 5 get 7 get V{ } 2sequence >>successors drop
+6 { 5 7 } edges
-10 get 8 get 1vector >>successors drop
+10 8 edge
-7 get 2 get 1vector >>successors drop
+7 2 edge
 
 cfg new 1 get >>entry 0 set
 [ ] [ 0 get compute-predecessors drop ] unit-test

basis/compiler/cfg/stacks/uninitialized/uninitialized-tests.factor

@@ -25,8 +25,8 @@ V{
     T{ ##inc-d f 1 }
 } 2 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
-1 get 2 get 1vector >>successors drop
+1 2 edge
 
 [ ] [ test-uninitialized ] unit-test
 
@@ -52,9 +52,9 @@ V{
     T{ ##return }
 } 3 test-bb
 
-0 get 1 get 2 get V{ } 2sequence >>successors drop
+0 { 1 2 } edges
-1 get 3 get 1vector >>successors drop
+1 3 edge
-2 get 3 get 1vector >>successors drop
+2 3 edge
 
 [ ] [ test-uninitialized ] unit-test
 

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -1175,16 +1175,11 @@ V{
 } 3 test-bb
 
 V{
-    T{ ##phi f V int-regs 3 { } }
+    T{ ##phi f V int-regs 3 H{ { 2 V int-regs 1 } { 3 V int-regs 2 } } }
     T{ ##replace f V int-regs 3 D 0 }
     T{ ##return }
 } 4 test-bb
 
-4 get instructions>> first
-2 get V int-regs 1 2array
-3 get V int-regs 2 2array 2array
->>inputs drop
-
 test-diamond
 
 [ ] [
@@ -1296,10 +1291,10 @@ V{
     T{ ##return }
 } 5 test-bb
 
-0 get 1 get 1vector >>successors drop
+0 1 edge
-1 get 2 get 4 get V{ } 2sequence >>successors drop
+1 { 2 4 } edges
-2 get 3 get 1vector >>successors drop
+2 3 edge
-4 get 5 get 1vector >>successors drop
+4 5 edge
 
 [ ] [
     cfg new 0 get >>entry

basis/compiler/tests/low-level-ir.factor

@@ -27,8 +27,8 @@ IN: compiler.tests.low-level-ir
         T{ ##epilogue }
         T{ ##return }
     } [ clone ] map 2 test-bb
-    0 get 1 get 1vector >>successors drop
+    0 1 edge
-    1 get 2 get 1vector >>successors drop
+    1 2 edge
     compile-test-cfg
     execute( -- result ) ;