From 9bde92220b58be2f437f80d357d4e9dabff1425d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sat, 1 Aug 2009 23:50:47 -0500
Subject: [PATCH 01/14] compiler.cfg.two-operand: if last instruction in a
 basic block is an overflowing arithmetic op of the form x = y op x, we now
 convert it correctly. This fixes compiler regression with benchmark.dawes
 after recent coalescing changes

---
 .../cfg/two-operand/two-operand-tests.factor        | 13 +++----------
 basis/compiler/cfg/two-operand/two-operand.factor   | 10 +++-------
 2 files changed, 6 insertions(+), 17 deletions(-)

diff --git a/basis/compiler/cfg/two-operand/two-operand-tests.factor b/basis/compiler/cfg/two-operand/two-operand-tests.factor
index 0d0c57e0f7..0717f1c536 100644
--- a/basis/compiler/cfg/two-operand/two-operand-tests.factor
+++ b/basis/compiler/cfg/two-operand/two-operand-tests.factor
@@ -27,19 +27,12 @@ compiler.cfg.registers cpu.architecture namespaces tools.test ;
 
 [
     V{
-        T{ ##copy f V int-regs 4 V int-regs 2 }
-        T{ ##sub f V int-regs 4 V int-regs 4 V int-regs 1 }
-        T{ ##copy f V int-regs 1 V int-regs 4 }
+        T{ ##copy f V int-regs 4 V int-regs 1 }
+        T{ ##copy f V int-regs 1 V int-regs 2 }
+        T{ ##sub f V int-regs 1 V int-regs 1 V int-regs 4 }
     }
 ] [
     {
         T{ ##sub f V int-regs 1 V int-regs 2 V int-regs 1 }
     } (convert-two-operand)
 ] unit-test
-
-! This should never come up after coalescing
-[
-    V{
-        T{ ##fixnum-add f V int-regs 2 V int-regs 4 V int-regs 2 }
-    } (convert-two-operand)
-] must-fail
diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor
index db3462bf0d..3508585552 100644
--- a/basis/compiler/cfg/two-operand/two-operand.factor
+++ b/basis/compiler/cfg/two-operand/two-operand.factor
@@ -65,15 +65,11 @@ GENERIC: convert-two-operand* ( insn -- )
 
 : case-2? ( insn -- ? ) [ dst>> ] [ src2>> ] bi = ; inline
 
-ERROR: bad-case-2 insn ;
-
 : case-2 ( insn -- )
-    ! This can't work with a ##fixnum-overflow since it branches
-    dup ##fixnum-overflow? [ bad-case-2 ] when
     dup dst>> reg-class>> next-vreg
-    [ swap src1>> emit-copy ]
-    [ [ >>src1 ] [ >>dst ] bi , ]
-    [ [ src2>> ] dip emit-copy ]
+    [ swap src2>> emit-copy ]
+    [ drop [ src2>> ] [ src1>> ] bi emit-copy ]
+    [ >>src2 dup dst>> >>src1 , ]
     2tri ; inline
 
 : case-3 ( insn -- )

From e1c7f7394a1da641b91105b04727cf14cfc9eb6c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 03:49:25 -0500
Subject: [PATCH 02/14] compiler.cfg: clean up unit tests using some new
 utilities

---
 .../branch-splitting-tests.factor             | 16 ++---
 basis/compiler/cfg/debugger/debugger.factor   | 26 ++++++--
 .../cfg/dominance/dominance-tests.factor      | 32 +++++-----
 .../cfg/gc-checks/gc-checks-tests.factor      |  2 +-
 .../cfg/linear-scan/linear-scan-tests.factor  | 64 +++++++++----------
 .../cfg/liveness/liveness-tests.factor        |  4 +-
 .../construction/construction-tests.factor    | 18 +++---
 .../ssa/construction/tdmsc/tdmsc-tests.factor | 36 +++++------
 .../destruction/forest/forest-tests.factor    | 12 ++--
 .../cfg/ssa/liveness/liveness-tests.factor    | 22 +++----
 .../uninitialized/uninitialized-tests.factor  | 10 +--
 .../value-numbering-tests.factor              | 15 ++---
 basis/compiler/tests/low-level-ir.factor      |  4 +-
 13 files changed, 133 insertions(+), 128 deletions(-)

diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor b/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor
index 89f26f7928..d73bd866a0 100644
--- a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor
+++ b/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
\ No newline at end of file
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 3c6ea1f0e4..15aff73143 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/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)
-    2 get 3 get V{ } 2sequence 1 get (>>successors)
-    4 get 1vector 2 get (>>successors)
-    4 get 1vector 3 get (>>successors) ;
\ No newline at end of file
+    0 1 edge
+    1 { 2 3 } edges
+    2 4 edge
+    3 4 edge ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor
index 07bcd7bc84..a3b9fc0223 100644
--- a/basis/compiler/cfg/dominance/dominance-tests.factor
+++ b/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
-1 get 3 get 1vector >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
+0 { 1 2 } edges
+1 3 edge
+2 4 edge
+3 4 edge
+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
-1 get 3 get 1vector >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 3 get 1vector >>successors drop
+0 { 1 2 } edges
+1 3 edge
+2 4 edge
+3 4 edge
+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
-1 get 5 get 1vector >>successors drop
-2 get 4 get 3 get V{ } 2sequence >>successors drop
-5 get 4 get 1vector >>successors drop
-4 get 5 get 3 get V{ } 2sequence >>successors drop
-3 get 4 get 1vector >>successors drop
+0 { 1 2 } edges
+1 5 edge
+2 { 4 3 } edges
+5 4 edge
+4 { 5 3 } edges
+3 4 edge
 
 [ ] [ test-dominance ] unit-test
 
diff --git a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
index 7b3e07faf8..b324214602 100644
--- a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
+++ b/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
 
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index df91109e78..2164cef429 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/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)
-2 get 3 get V{ } 2sequence 1 get (>>successors)
-3 get 1vector 2 get (>>successors)
+0 1 edge
+1 { 2 3 } edges
+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
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get V{ } 1sequence >>successors drop
-3 get 4 get V{ } 1sequence >>successors drop
-4 get 5 get 6 get V{ } 2sequence >>successors drop
+0 1 edge
+1 { 2 3 } edges
+2 4 edge
+3 4 edge
+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
-1 get 2 get 7 get V{ } 2sequence >>successors drop
-7 get 8 get 1vector >>successors drop
-8 get 9 get 1vector >>successors drop
-2 get 3 get 5 get V{ } 2sequence >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 9 get 1vector >>successors drop
-5 get 6 get 1vector >>successors drop
+0 1 edge
+1 { 2 7 } edges
+7 8 edge
+8 9 edge
+2 { 3 5 } edges
+3 4 edge
+4 9 edge
+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
-1 get 2 get 4 get V{ } 2sequence >>successors drop
-2 get 3 get 1vector >>successors drop
-3 get 5 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
+0 1 edge
+1 { 2 4 } edges
+2 3 edge
+3 5 edge
+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
-1 get 2 get 5 get V{ } 2sequence >>successors drop
-2 get 3 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 6 get 1vector >>successors drop
-5 get 6 get 1vector >>successors drop
+0 1 edge
+1 { 2 5 } edges
+2 3 edge
+3 4 edge
+4 6 edge
+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
-1 get 2 get 1vector >>successors drop
+0 1 edge
+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
 
diff --git a/basis/compiler/cfg/liveness/liveness-tests.factor b/basis/compiler/cfg/liveness/liveness-tests.factor
index eb497a9bae..0bb5f85fa5 100644
--- a/basis/compiler/cfg/liveness/liveness-tests.factor
+++ b/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
 
diff --git a/basis/compiler/cfg/ssa/construction/construction-tests.factor b/basis/compiler/cfg/ssa/construction/construction-tests.factor
index da0f320130..e7ba5bbaba 100644
--- a/basis/compiler/cfg/ssa/construction/construction-tests.factor
+++ b/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
-1 get 3 get 1vector >>successors drop
-2 get 3 get 1vector >>successors drop
+0 { 1 2 } edges
+1 3 edge
+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
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 6 get 1vector >>successors drop
-5 get 6 get 1vector >>successors drop
+0 { 1 5 } edges
+1 { 2 3 } edges
+2 4 edge
+3 4 edge
+4 6 edge
+5 6 edge
 
 [ ] [ test-ssa ] unit-test
 
diff --git a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor b/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor
index 7691d0e6ce..433dcfee64 100644
--- a/basis/compiler/cfg/ssa/construction/tdmsc/tdmsc-tests.factor
+++ b/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
-1 get 3 get 1vector >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
+0 { 1 2 } edges
+1 3 edge
+2 4 edge
+3 4 edge
+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
-1 get 2 get 3 get V{ } 2sequence >>successors drop
-2 get 4 get 1vector >>successors drop
-3 get 4 get 1vector >>successors drop
-4 get 6 get 1vector >>successors drop
-5 get 6 get 1vector >>successors drop
+0 { 1 5 } edges
+1 { 2 3 } edges
+2 4 edge
+3 4 edge
+4 6 edge
+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
-1 get 2 get 1vector >>successors drop
-2 get 3 get 6 get V{ } 2sequence >>successors drop
-3 get 4 get 1vector >>successors drop
-6 get 7 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-5 get 2 get 1vector >>successors drop
+0 1 edge
+1 2 edge
+2 { 3 6 } edges
+3 4 edge
+6 7 edge
+4 5 edge
+5 2 edge
 
 [ ] [ test-tdmsc ] unit-test
 
diff --git a/basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor b/basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor
index 64c04b79f2..af5d3f1091 100644
--- a/basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor
+++ b/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
-2 get 3 get 4 get V{ } 2sequence >>successors drop
-3 get 5 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
-1 get 6 get 1vector >>successors drop
-5 get 6 get 1vector >>successors drop
+0 { 1 2 } edges
+2 { 3 4 } edges
+3 5 edge
+4 5 edge
+1 6 edge
+5 6 edge
 
 : clean-up-forest ( forest -- forest' )
     [ [ vreg>> n>> ] compare ] sort
diff --git a/basis/compiler/cfg/ssa/liveness/liveness-tests.factor b/basis/compiler/cfg/ssa/liveness/liveness-tests.factor
index 57821f7491..02c49d01f4 100644
--- a/basis/compiler/cfg/ssa/liveness/liveness-tests.factor
+++ b/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
-9 get 6 get 10 get V{ } 2sequence >>successors drop
+5 6 edge
+9 { 6 10 } edges
 V{ } 7 test-bb
-6 get 5 get 7 get V{ } 2sequence >>successors drop
-10 get 8 get 1vector >>successors drop
-7 get 2 get 1vector >>successors drop
+6 { 5 7 } edges
+10 8 edge
+7 2 edge
 
 cfg new 1 get >>entry 0 set
 [ ] [ 0 get compute-predecessors drop ] unit-test
diff --git a/basis/compiler/cfg/stacks/uninitialized/uninitialized-tests.factor b/basis/compiler/cfg/stacks/uninitialized/uninitialized-tests.factor
index 6f3e35994a..39b2f7747c 100644
--- a/basis/compiler/cfg/stacks/uninitialized/uninitialized-tests.factor
+++ b/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
-1 get 2 get 1vector >>successors drop
+0 1 edge
+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
-1 get 3 get 1vector >>successors drop
-2 get 3 get 1vector >>successors drop
+0 { 1 2 } edges
+1 3 edge
+2 3 edge
 
 [ ] [ test-uninitialized ] unit-test
 
diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
index 087b73e2c0..519cea617a 100644
--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/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
-1 get 2 get 4 get V{ } 2sequence >>successors drop
-2 get 3 get 1vector >>successors drop
-4 get 5 get 1vector >>successors drop
+0 1 edge
+1 { 2 4 } edges
+2 3 edge
+4 5 edge
 
 [ ] [
     cfg new 0 get >>entry
diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor
index eb8c0fbf98..f1ebeded7b 100644
--- a/basis/compiler/tests/low-level-ir.factor
+++ b/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
-    1 get 2 get 1vector >>successors drop
+    0 1 edge
+    1 2 edge
     compile-test-cfg
     execute( -- result ) ;
 

From 21489ce85e3959eac3f3aa25cf45d82dd5984928 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 03:49:54 -0500
Subject: [PATCH 03/14] compiler tests: add test case for coalescing bug

---
 basis/compiler/tests/codegen.factor | 30 +++++++++++++++++++++++++++--
 1 file changed, 28 insertions(+), 2 deletions(-)

diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor
index f8f8788125..ffd7295501 100644
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@@ -2,7 +2,8 @@ USING: generalizations accessors arrays compiler kernel kernel.private
 math hashtables.private math.private namespaces sequences tools.test
 namespaces.private slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
-combinators vectors grouping make alien.c-types combinators.short-circuit ;
+combinators vectors grouping make alien.c-types combinators.short-circuit
+math.order ;
 QUALIFIED: namespaces.private
 IN: compiler.tests.codegen
 
@@ -366,4 +367,29 @@ cell 4 = [
     fixnum+fast 2 fixnum*fast 2 fixnum-fast 2 fixnum*fast 2 fixnum+fast ;
 
 [ 10 ] [ 1 coalescing-bug-2 ] unit-test
-[ 86 ] [ 11 coalescing-bug-2 ] unit-test
\ No newline at end of file
+[ 86 ] [ 11 coalescing-bug-2 ] unit-test
+
+! Regression in suffix-arrays code
+: coalescing-bug-3 ( from/f to/f seq -- slice )
+    [
+        [ drop 0 or ] [ length or ] bi-curry bi*
+        [ min ] keep
+    ] keep <slice> ;
+
+[ T{ slice f 0 5 "hello" } ] [ f f "hello" coalescing-bug-3 ] unit-test
+[ T{ slice f 1 5 "hello" } ] [ 1 f "hello" coalescing-bug-3 ] unit-test
+[ T{ slice f 0 3 "hello" } ] [ f 3 "hello" coalescing-bug-3 ] unit-test
+[ T{ slice f 1 3 "hello" } ] [ 1 3 "hello" coalescing-bug-3 ] unit-test
+[ T{ slice f 3 3 "hello" } ] [ 4 3 "hello" coalescing-bug-3 ] unit-test
+[ T{ slice f 5 5 "hello" } ] [ 6 f "hello" coalescing-bug-3 ] unit-test
+
+! Reduction
+: coalescing-bug-4 ( a b c -- a b c )
+     [ [ min ] keep ] dip vector? [ 1 ] [ 2 ] if ;
+
+ [ 2 3 2 ] [ 2 3 "" coalescing-bug-4 ] unit-test
+ [ 3 3 2 ] [ 4 3 "" coalescing-bug-4 ] unit-test
+ [ 3 3 2 ] [ 4 3 "" coalescing-bug-4 ] unit-test
+ [ 2 3 1 ] [ 2 3 V{ } coalescing-bug-4 ] unit-test
+ [ 3 3 1 ] [ 4 3 V{ } coalescing-bug-4 ] unit-test
+ [ 3 3 1 ] [ 4 3 V{ } coalescing-bug-4 ] unit-test
\ No newline at end of file

From 01f51a96cda6f3a90b8942ca125cb92a93fe7d4f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 06:16:58 -0500
Subject: [PATCH 04/14] compiler.cfg.utilities: add each-phi combinator to
 iterate over all ##phi instructions in a basic block

---
 basis/compiler/cfg/debugger/debugger.factor           |  4 ++--
 basis/compiler/cfg/liveness/ssa/ssa.factor            | 10 ++++------
 basis/compiler/cfg/predecessors/predecessors.factor   |  6 ++----
 basis/compiler/cfg/ssa/destruction/destruction.factor |  6 +++---
 basis/compiler/cfg/utilities/utilities.factor         |  4 ++++
 5 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 15aff73143..76c3414679 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/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
diff --git a/basis/compiler/cfg/liveness/ssa/ssa.factor b/basis/compiler/cfg/liveness/ssa/ssa.factor
index e67771595c..82af084f06 100644
--- a/basis/compiler/cfg/liveness/ssa/ssa.factor
+++ b/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 [
-            '[ inputs>> [ swap _ conjoin-at ] assoc-each ] each
-        ] keep
-    ] if-empty ;
+    H{ } clone [
+        '[ inputs>> [ swap _ conjoin-at ] assoc-each ] each-phi
+    ] keep ;
 
 : update-live-in ( basic-block -- changed? )
     [ [ compute-live-in ] keep live-ins get maybe-set-at ]
diff --git a/basis/compiler/cfg/predecessors/predecessors.factor b/basis/compiler/cfg/predecessors/predecessors.factor
index 73ae3ee242..c972197dd8 100644
--- a/basis/compiler/cfg/predecessors/predecessors.factor
+++ b/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 ##phi? [ update-phi ] [ 2drop ] if
-    ] with each ;
+    dup [ update-phi ] with each-phi ;
 
 : compute-predecessors ( cfg -- cfg' )
     {
diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index 194e7e6d8f..dd79927699 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/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
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index f01b10f6eb..0b68635d17 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/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
 

From c61b72912582ac02aa902078b9fa468803e27390 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 06:17:22 -0500
Subject: [PATCH 05/14] compiler.cfg.critical-edges: update ##phi nodes

---
 .../critical-edges-tests.factor               | 37 +++++++++++++++++++
 .../cfg/critical-edges/critical-edges.factor  | 12 +++++-
 2 files changed, 47 insertions(+), 2 deletions(-)
 create mode 100644 basis/compiler/cfg/critical-edges/critical-edges-tests.factor

diff --git a/basis/compiler/cfg/critical-edges/critical-edges-tests.factor b/basis/compiler/cfg/critical-edges/critical-edges-tests.factor
new file mode 100644
index 0000000000..88383e2e1e
--- /dev/null
+++ b/basis/compiler/cfg/critical-edges/critical-edges-tests.factor
@@ -0,0 +1,37 @@
+USING: accessors assocs compiler.cfg
+compiler.cfg.critical-edges compiler.cfg.debugger
+compiler.cfg.instructions compiler.cfg.predecessors
+compiler.cfg.registers cpu.architecture kernel namespaces
+sequences tools.test compiler.cfg.utilities ;
+IN: compiler.cfg.critical-edges.tests
+
+! Make sure we update phi nodes when splitting critical edges
+
+: test-critical-edges ( -- )
+    cfg new 0 get >>entry
+    compute-predecessors
+    split-critical-edges ;
+
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##peek f V int-regs 1 D 1 }
+    T{ ##branch }
+} 1 test-bb
+
+V{
+    T{ ##phi f V int-regs 2 H{ { 0 V int-regs 0 } { 1 V int-regs 1 } } }
+    T{ ##return }
+} 2 test-bb
+
+0 { 1 2 } edges
+1 2 edge
+
+[ ] [ test-critical-edges ] unit-test
+
+[ t ] [ 0 get successors>> second successors>> first 2 get eq? ] unit-test
+
+[ V int-regs 0 ] [ 2 get instructions>> first inputs>> 0 get successors>> second swap at ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/critical-edges/critical-edges.factor b/basis/compiler/cfg/critical-edges/critical-edges.factor
index 1000c24752..2a42df4bbf 100644
--- a/basis/compiler/cfg/critical-edges/critical-edges.factor
+++ b/basis/compiler/cfg/critical-edges/critical-edges.factor
@@ -1,14 +1,22 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math accessors sequences
+USING: kernel math accessors sequences locals assocs fry
 compiler.cfg compiler.cfg.rpo compiler.cfg.utilities ;
 IN: compiler.cfg.critical-edges
 
 : critical-edge? ( from to -- ? )
     [ successors>> length 1 > ] [ predecessors>> length 1 > ] bi* and ;
 
+: new-key ( new-key old-key assoc -- )
+    [ delete-at* ] keep '[ swap _ set-at ] [ 2drop ] if ;
+
+:: update-phis ( from to bb -- )
+    ! Any phi nodes in 'to' which reference 'from'
+    ! should now reference 'bb'.
+    to [ [ bb from ] dip inputs>> new-key ] each-phi ;
+
 : split-critical-edge ( from to -- )
-    f <simple-block> insert-basic-block ;
+    f <simple-block> [ insert-basic-block ] [ update-phis ] 3bi ; 
 
 : split-critical-edges ( cfg -- )
     dup [

From b5a978d4e5168cacabdff364d23c7439e0eaef50 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 06:17:44 -0500
Subject: [PATCH 06/14] compiler.cfg.ssa.destruction: add some unit tests

---
 .../ssa/destruction/destruction-tests.factor  | 119 ++++++++++++++++++
 1 file changed, 119 insertions(+)
 create mode 100644 basis/compiler/cfg/ssa/destruction/destruction-tests.factor

diff --git a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
new file mode 100644
index 0000000000..a70d007430
--- /dev/null
+++ b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
@@ -0,0 +1,119 @@
+USING: compiler.cfg.instructions compiler.cfg.registers cpu.architecture
+compiler.cfg.debugger arrays accessors kernel namespaces sequences assocs
+compiler.cfg.predecessors compiler.cfg.ssa.destruction tools.test
+compiler.cfg vectors ;
+IN: compiler.cfg.ssa.destruction.tests
+
+! This needs way more tests
+
+! Untested code path
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+} 0 test-bb
+
+V{
+    T{ ##peek f V int-regs 1 D 0 }
+} 1 test-bb
+
+V{
+    T{ ##replace f V int-regs 0 D 0 }
+} 2 test-bb
+
+V{
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##phi f V int-regs 2 H{ { 2 V int-regs 1 } { 3 V int-regs 0 } } }
+} 4 test-bb
+
+0 { 1 3 } edges
+1 2 edge
+2 4 edge
+3 4 edge
+
+: test-destruction ( -- )
+    cfg new 0 get >>entry compute-predecessors destruct-ssa drop ;
+
+[ ] [ test-destruction ] unit-test
+
+! "Virtual swap" problem
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-regs 1 D 1 }
+} 0 test-bb
+
+V{
+    T{ ##branch }
+} 1 test-bb
+
+V{
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##phi f V int-regs 2 H{ { 1 V int-regs 0 } { 2 V int-regs 1 } } }
+    T{ ##phi f V int-regs 3 H{ { 1 V int-regs 1 } { 2 V int-regs 0 } } }
+} 3 test-bb
+
+0 { 1 2 } edges
+1 3 edge
+2 3 edge
+
+[ ] [ test-destruction ] unit-test
+
+! How to test?
+
+! Reduction of suffix-arrays regression
+V{
+    T{ ##peek f V int-regs 48 D 0 }
+    T{ ##peek f V int-regs 47 D 0 }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##branch }
+} 1 test-bb
+
+V{
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##branch }
+} 3 test-bb
+
+V{
+    T{ ##phi f V int-regs 94 H{ { 1 V int-regs 48 } { 2 V int-regs 47 } } }
+    T{ ##branch }
+} 4 test-bb
+
+V{
+    T{ ##branch }
+} 5 test-bb
+
+V{
+    T{ ##branch }
+} 6 test-bb
+
+V{
+    T{ ##branch }
+} 7 test-bb
+
+V{
+    T{ ##phi f V int-regs 56 H{ { 3 V int-regs 48 } { 6 V int-regs 94 } { 7 V int-regs 94 } { 5 V int-regs 47 } } }
+    T{ ##branch }
+} 8 test-bb
+
+0 { 1 2 } edges
+1 { 3 4 } edges
+2 { 4 5 } edges
+4 { 6 7 } edges
+3 8 edge
+6 8 edge
+7 8 edge
+5 8 edge
+
+[ ] [ test-destruction ] unit-test
+
+[ f ] [ 0 get instructions>> first2 [ dst>> ] bi@ = ] unit-test
\ No newline at end of file

From 7ec288b01394b0d55f7d7f246f056c95571f144e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 08:11:04 -0500
Subject: [PATCH 07/14] compiler.cfg.debugger: fix load error

---
 basis/compiler/cfg/debugger/debugger.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 76c3414679..26bf0eca56 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -8,7 +8,7 @@ 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.instructions
-compiler.cfg.mr compiler.cfg ;
+compiler.cfg.utilities compiler.cfg.mr compiler.cfg ;
 IN: compiler.cfg.debugger
 
 GENERIC: test-cfg ( quot -- cfgs )

From 87e13db9467ef636aed9faba92083e6214f7e1e8 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 08:11:30 -0500
Subject: [PATCH 08/14] compiler.cfg.ssa.destruction.interference: fix a bug
 and add unit tests

---
 .../interference/interference-tests.factor    | 52 +++++++++++++++++++
 .../interference/interference.factor          | 13 +++--
 2 files changed, 60 insertions(+), 5 deletions(-)
 create mode 100644 basis/compiler/cfg/ssa/destruction/interference/interference-tests.factor

diff --git a/basis/compiler/cfg/ssa/destruction/interference/interference-tests.factor b/basis/compiler/cfg/ssa/destruction/interference/interference-tests.factor
new file mode 100644
index 0000000000..c76e2f0dba
--- /dev/null
+++ b/basis/compiler/cfg/ssa/destruction/interference/interference-tests.factor
@@ -0,0 +1,52 @@
+USING: accessors compiler.cfg compiler.cfg.debugger
+compiler.cfg.def-use compiler.cfg.dominance
+compiler.cfg.instructions compiler.cfg.liveness.ssa
+compiler.cfg.registers compiler.cfg.predecessors
+compiler.cfg.ssa.destruction.interference
+compiler.cfg.ssa.destruction.live-ranges cpu.architecture
+kernel namespaces tools.test ;
+IN: compiler.cfg.ssa.destruction.interference.tests
+
+: test-interference ( -- )
+    cfg new 0 get >>entry
+    compute-ssa-live-sets
+    compute-predecessors
+    dup compute-def-use
+    dup compute-dominance
+    compute-live-ranges ;
+
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##peek f V int-regs 2 D 0 }
+    T{ ##copy f V int-regs 1 V int-regs 0 }
+    T{ ##copy f V int-regs 3 V int-regs 2 }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##peek f V int-regs 4 D 0 }
+    T{ ##peek f V int-regs 5 D 0 }
+    T{ ##replace f V int-regs 3 D 0 }
+    T{ ##peek f V int-regs 6 D 0 }
+    T{ ##replace f V int-regs 5 D 0 }
+    T{ ##return }
+} 1 test-bb
+
+0 1 edge
+
+[ ] [ test-interference ] unit-test
+
+[ f ] [ V int-regs 0 V int-regs 1 interferes? ] unit-test
+[ f ] [ V int-regs 1 V int-regs 0 interferes? ] unit-test
+[ f ] [ V int-regs 2 V int-regs 3 interferes? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 2 interferes? ] unit-test
+[ t ] [ V int-regs 0 V int-regs 2 interferes? ] unit-test
+[ t ] [ V int-regs 2 V int-regs 0 interferes? ] unit-test
+[ f ] [ V int-regs 1 V int-regs 3 interferes? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 1 interferes? ] unit-test
+[ t ] [ V int-regs 3 V int-regs 4 interferes? ] unit-test
+[ t ] [ V int-regs 4 V int-regs 3 interferes? ] unit-test
+[ t ] [ V int-regs 3 V int-regs 5 interferes? ] unit-test
+[ t ] [ V int-regs 5 V int-regs 3 interferes? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 6 interferes? ] unit-test
+[ f ] [ V int-regs 6 V int-regs 3 interferes? ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/destruction/interference/interference.factor b/basis/compiler/cfg/ssa/destruction/interference/interference.factor
index 4bb55a00aa..92fce60205 100644
--- a/basis/compiler/cfg/ssa/destruction/interference/interference.factor
+++ b/basis/compiler/cfg/ssa/destruction/interference/interference.factor
@@ -7,19 +7,22 @@ IN: compiler.cfg.ssa.destruction.interference
 
 <PRIVATE
 
-: kill-after-def? ( vreg1 vreg2 bb -- ? )
+:: kill-after-def? ( vreg1 vreg2 bb -- ? )
     ! If first register is used after second one is defined, they interfere.
     ! If they are used in the same instruction, no interference. If the
     ! instruction is a def-is-use-insn, then there will be a use at +1
     ! (instructions are 2 apart) and so outputs will interfere with
     ! inputs.
-    [ kill-index ] [ def-index ] bi-curry bi* > ;
+    vreg1 bb kill-index
+    vreg2 bb def-index > ;
 
-: interferes-same-block? ( vreg1 vreg2 bb1 bb2 -- ? )
+:: interferes-same-block? ( vreg1 vreg2 bb1 bb2 -- ? )
     ! If both are defined in the same basic block, they interfere if their
     ! local live ranges intersect.
-    drop
-    { [ kill-after-def? ] [ swapd kill-after-def? ] } 3|| ;
+    vreg1 bb1 def-index
+    vreg2 bb1 def-index <
+    [ vreg1 vreg2 ] [ vreg2 vreg1 ] if
+    bb1 kill-after-def? ;
 
 : interferes-first-dominates? ( vreg1 vreg2 bb1 bb2 -- ? )
     ! If vreg1 dominates vreg2, then they interfere if vreg2's definition

From cff5976a0d0c1dfe95d4690efb2f6310b3cc92db Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 08:15:36 -0500
Subject: [PATCH 09/14] Move compiler.cfg.ssa.destruction.interference to
 compiler.cfg.ssa.interference

---
 basis/compiler/cfg/ssa/destruction/destruction.factor       | 2 +-
 .../ssa/destruction/process-blocks/process-blocks.factor    | 4 ++--
 .../interference/interference-tests.factor                  | 6 +++---
 .../ssa/{destruction => }/interference/interference.factor  | 4 ++--
 .../live-ranges/live-ranges.factor                          | 2 +-
 5 files changed, 9 insertions(+), 9 deletions(-)
 rename basis/compiler/cfg/ssa/{destruction => }/interference/interference-tests.factor (88%)
 rename basis/compiler/cfg/ssa/{destruction => }/interference/interference.factor (93%)
 rename basis/compiler/cfg/ssa/{destruction => interference}/live-ranges/live-ranges.factor (97%)

diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index dd79927699..d264ad1160 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction.factor
@@ -13,7 +13,7 @@ compiler.cfg.ssa.destruction.state
 compiler.cfg.ssa.destruction.forest
 compiler.cfg.ssa.destruction.copies
 compiler.cfg.ssa.destruction.renaming
-compiler.cfg.ssa.destruction.live-ranges
+compiler.cfg.ssa.interference.live-ranges
 compiler.cfg.ssa.destruction.process-blocks ;
 IN: compiler.cfg.ssa.destruction
 
diff --git a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
index 8eff20a11e..1bfcbe3b9a 100644
--- a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
+++ b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
@@ -6,9 +6,9 @@ compiler.cfg.def-use
 compiler.cfg.instructions
 compiler.cfg.liveness.ssa
 compiler.cfg.dominance
+compiler.cfg.ssa.interference
 compiler.cfg.ssa.destruction.state
-compiler.cfg.ssa.destruction.forest
-compiler.cfg.ssa.destruction.interference ;
+compiler.cfg.ssa.destruction.forest ;
 IN: compiler.cfg.ssa.destruction.process-blocks
 
 ! phi-union maps a vreg to the predecessor block
diff --git a/basis/compiler/cfg/ssa/destruction/interference/interference-tests.factor b/basis/compiler/cfg/ssa/interference/interference-tests.factor
similarity index 88%
rename from basis/compiler/cfg/ssa/destruction/interference/interference-tests.factor
rename to basis/compiler/cfg/ssa/interference/interference-tests.factor
index c76e2f0dba..a973106d23 100644
--- a/basis/compiler/cfg/ssa/destruction/interference/interference-tests.factor
+++ b/basis/compiler/cfg/ssa/interference/interference-tests.factor
@@ -2,10 +2,10 @@ USING: accessors compiler.cfg compiler.cfg.debugger
 compiler.cfg.def-use compiler.cfg.dominance
 compiler.cfg.instructions compiler.cfg.liveness.ssa
 compiler.cfg.registers compiler.cfg.predecessors
-compiler.cfg.ssa.destruction.interference
-compiler.cfg.ssa.destruction.live-ranges cpu.architecture
+compiler.cfg.ssa.interference
+compiler.cfg.ssa.interference.live-ranges cpu.architecture
 kernel namespaces tools.test ;
-IN: compiler.cfg.ssa.destruction.interference.tests
+IN: compiler.cfg.ssa.interference.tests
 
 : test-interference ( -- )
     cfg new 0 get >>entry
diff --git a/basis/compiler/cfg/ssa/destruction/interference/interference.factor b/basis/compiler/cfg/ssa/interference/interference.factor
similarity index 93%
rename from basis/compiler/cfg/ssa/destruction/interference/interference.factor
rename to basis/compiler/cfg/ssa/interference/interference.factor
index 92fce60205..c5f066e55b 100644
--- a/basis/compiler/cfg/ssa/destruction/interference/interference.factor
+++ b/basis/compiler/cfg/ssa/interference/interference.factor
@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators combinators.short-circuit
 kernel math namespaces sequences locals compiler.cfg.def-use
-compiler.cfg.dominance compiler.cfg.ssa.destruction.live-ranges ;
-IN: compiler.cfg.ssa.destruction.interference
+compiler.cfg.dominance compiler.cfg.ssa.interference.live-ranges ;
+IN: compiler.cfg.ssa.interference
 
 <PRIVATE
 
diff --git a/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor b/basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor
similarity index 97%
rename from basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor
rename to basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor
index 01aebd7e1c..151af8bea4 100644
--- a/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor
+++ b/basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor
@@ -3,7 +3,7 @@
 USING: accessors assocs fry kernel namespaces sequences math
 arrays compiler.cfg.def-use compiler.cfg.instructions
 compiler.cfg.liveness.ssa compiler.cfg.rpo ;
-IN: compiler.cfg.ssa.destruction.live-ranges
+IN: compiler.cfg.ssa.interference.live-ranges
 
 ! Live ranges for interference testing
 

From 8aa41672cac94f0db4e0b98cb9ec2bbd2e6ca1df Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 08:20:50 -0500
Subject: [PATCH 10/14] compiler.cfg.ssa.destruction.copies: factor out
 add-instructions combinator into compiler.cfg.utilities

---
 .../compiler/cfg/ssa/destruction/copies/copies.factor | 11 ++++-------
 basis/compiler/cfg/utilities/utilities.factor         |  7 +++++++
 2 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/basis/compiler/cfg/ssa/destruction/copies/copies.factor b/basis/compiler/cfg/ssa/destruction/copies/copies.factor
index 177793f1a1..74180fe41f 100644
--- a/basis/compiler/cfg/ssa/destruction/copies/copies.factor
+++ b/basis/compiler/cfg/ssa/destruction/copies/copies.factor
@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs hashtables fry kernel make namespaces sets
-sequences compiler.cfg.ssa.destruction.state compiler.cfg.parallel-copy ;
+USING: accessors assocs hashtables fry kernel make namespaces
+sets sequences compiler.cfg.ssa.destruction.state
+compiler.cfg.parallel-copy compiler.cfg.utilities ;
 IN: compiler.cfg.ssa.destruction.copies
 
 ERROR: bad-copy ;
@@ -20,9 +21,5 @@ ERROR: bad-copy ;
 
 : insert-copies ( -- )
     waiting get [
-        [ instructions>> building ] dip '[
-            building get pop
-            _ compute-copies parallel-copy
-            ,
-        ] with-variable
+        '[ _ compute-copies parallel-copy ] add-instructions
     ] assoc-each ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
index 0b68635d17..9246084325 100644
--- a/basis/compiler/cfg/utilities/utilities.factor
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -43,6 +43,13 @@ SYMBOL: visited
     to predecessors>> [ dup from eq? [ drop bb ] when ] change-each
     from successors>> [ dup to eq? [ drop bb ] when ] change-each ;
 
+: add-instructions ( bb quot -- )
+    [ instructions>> building ] dip '[
+        building get pop
+        @
+        ,
+    ] with-variable ; inline
+
 : <simple-block> ( insns -- bb )
     <basic-block>
     swap >vector

From c1c8424605774898507d05201a847f5d875e3357 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 09:16:21 -0500
Subject: [PATCH 11/14] Compiler speedups

---
 basis/bootstrap/compiler/compiler.factor              | 1 +
 basis/compiler/cfg/linear-scan/resolve/resolve.factor | 7 +++----
 basis/compiler/cfg/stacks/finalize/finalize.factor    | 8 ++++++--
 basis/compiler/cfg/two-operand/two-operand.factor     | 6 ++++--
 core/make/make.factor                                 | 2 +-
 5 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor
index 4394535b8d..d0f7147452 100755
--- a/basis/bootstrap/compiler/compiler.factor
+++ b/basis/bootstrap/compiler/compiler.factor
@@ -94,6 +94,7 @@ nl
 {
     memq? split harvest sift cut cut-slice start index clone
     set-at reverse push-all class number>string string>number
+    like clone-like
 } compile-unoptimized
 
 "." write flush
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index 932e3dc6d6..b1fe1572cd 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -26,10 +26,9 @@ SYMBOL: spill-temps
     2dup = [ 2drop ] [ vreg reg-class>> add-mapping ] if ;
 
 : compute-mappings ( bb to -- mappings )
-    [
-        dup live-in keys
-        [ resolve-value-data-flow ] with with each
-    ] { } make ;
+    dup live-in dup assoc-empty? [ 3drop f ] [
+        [ keys [ resolve-value-data-flow ] with with each ] { } make
+    ] if ;
 
 : memory->register ( from to -- )
     swap [ first2 ] [ first n>> ] bi* _reload ;
diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor
index 5c8c1343d0..094b3c5f1e 100644
--- a/basis/compiler/cfg/stacks/finalize/finalize.factor
+++ b/basis/compiler/cfg/stacks/finalize/finalize.factor
@@ -30,8 +30,12 @@ ERROR: bad-peek dst loc ;
     [ dup n>> 0 < [ 2drop ] [ ##replace ] if ] each-insertion ;
 
 : visit-edge ( from to -- )
-    2dup [ [ insert-peeks ] [ insert-replaces ] 2bi ] V{ } make
-    [ 2drop ] [ <simple-block> insert-basic-block ] if-empty ;
+    ! If both blocks are subroutine calls, don't bother
+    ! computing anything.
+    2dup [ kill-block? ] both? [ 2drop ] [
+        2dup [ [ insert-peeks ] [ insert-replaces ] 2bi ] V{ } make
+        [ 2drop ] [ <simple-block> insert-basic-block ] if-empty
+    ] if ;
 
 : visit-block ( bb -- )
     [ predecessors>> ] keep '[ _ visit-edge ] each ;
diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor
index 3508585552..7a8b160acd 100644
--- a/basis/compiler/cfg/two-operand/two-operand.factor
+++ b/basis/compiler/cfg/two-operand/two-operand.factor
@@ -93,8 +93,10 @@ M: ##not convert-two-operand*
 
 M: insn convert-two-operand* , ;
 
-: (convert-two-operand) ( cfg -- cfg' )
-    [ [ convert-two-operand* ] each ] V{ } make ;
+: (convert-two-operand) ( insns -- insns' )
+    dup first kill-vreg-insn? [
+        [ [ convert-two-operand* ] each ] V{ } make
+    ] unless ;
 
 : convert-two-operand ( cfg -- cfg' )
     two-operand? [ [ (convert-two-operand) ] local-optimization ] when ;
\ No newline at end of file
diff --git a/core/make/make.factor b/core/make/make.factor
index f8bdaa1dbb..8b6aa3a3d3 100644
--- a/core/make/make.factor
+++ b/core/make/make.factor
@@ -8,7 +8,7 @@ SYMBOL: building
 : make ( quot exemplar -- seq )
     [
         [
-            1024 swap new-resizable [
+            100 swap new-resizable [
                 building set call
             ] keep
         ] keep like

From 7392013d465c94a42151db27c514ab76dac66b92 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 2 Aug 2009 09:51:15 -0500
Subject: [PATCH 12/14] to-fixed-point combinator + docs

---
 core/combinators/combinators-docs.factor | 16 ++++++++++++++++
 core/combinators/combinators.factor      |  3 +++
 2 files changed, 19 insertions(+)

diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor
index 72602c25b9..8893db3929 100755
--- a/core/combinators/combinators-docs.factor
+++ b/core/combinators/combinators-docs.factor
@@ -354,6 +354,22 @@ HELP: spread
 
 { bi* tri* spread } related-words
 
+HELP: to-fixed-point
+{ $values { "object" object } { "quot" { $quotation "( object(n) -- object(n+1) )" } } { "object(n)" object } }
+{ $description "Applies the quotation repeatedly with " { $snippet "object" } " as the initial input until the output of the quotation equals the input." }
+{ $examples
+    { $example
+        "USING: combinators kernel math prettyprint sequences ;"
+        "IN: scratchpad"
+        ": flatten ( sequence -- sequence' )"
+        "    \"flatten\" over index"
+        "    [ [ 1 + swap nth ] [ nip dup 2 + ] [ drop ] 2tri replace-slice ] when* ;"
+        ""
+        "{ \"flatten\" { 1 { 2 3 } \"flatten\" { 4 5 } { 6 } } } [ flatten ] to-fixed-point ."
+        "{ 1 { 2 3 } 4 5 { 6 } }"
+    }
+} ;
+
 HELP: alist>quot
 { $values { "default" "a quotation" } { "assoc" "a sequence of quotation pairs" } { "quot" "a new quotation" } }
 { $description "Constructs a quotation which calls the first quotation in each pair of " { $snippet "assoc" } " until one of them outputs a true value, and then calls the second quotation in the corresponding pair. Quotations are called in reverse order, and if no quotation outputs a true value then " { $snippet "default" } " is called." }
diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index f293030f25..54037b899e 100755
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -180,3 +180,6 @@ M: hashtable hashcode*
         dup assoc-size 1 eq?
         [ assoc-hashcode ] [ nip assoc-size ] if
     ] recursive-hashcode ;
+
+: to-fixed-point ( object quot: ( object(n) -- object(n+1) ) -- object(n) )
+    [ keep over = ] keep [ to-fixed-point ] curry unless ; inline recursive

From 82c110694562af8694753ee52400403bef6be0da Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 10:26:52 -0500
Subject: [PATCH 13/14] compiler.cfg.ssa.destruction: new implementation:
 simpler and more correct

---
 basis/compiler/cfg/ssa/cssa/cssa.factor       |  21 +++
 .../cfg/ssa/destruction/copies/copies.factor  |  25 ----
 .../ssa/destruction/destruction-tests.factor  | 119 ---------------
 .../cfg/ssa/destruction/destruction.factor    | 132 +++++++++++------
 .../destruction/forest/forest-tests.factor    |  86 -----------
 .../cfg/ssa/destruction/forest/forest.factor  |  38 -----
 .../process-blocks/process-blocks.factor      | 138 ------------------
 .../ssa/destruction/renaming/renaming.factor  |  47 ------
 .../cfg/ssa/destruction/state/state.factor    |  18 ---
 .../interference/interference-tests.factor    |   2 +-
 .../cfg/ssa/interference/interference.factor  |  37 ++++-
 .../tree/propagation/copy/copy.factor         |  15 +-
 basis/compiler/utilities/utilities.factor     |  14 +-
 13 files changed, 160 insertions(+), 532 deletions(-)
 create mode 100644 basis/compiler/cfg/ssa/cssa/cssa.factor
 delete mode 100644 basis/compiler/cfg/ssa/destruction/copies/copies.factor
 delete mode 100644 basis/compiler/cfg/ssa/destruction/destruction-tests.factor
 delete mode 100644 basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor
 delete mode 100644 basis/compiler/cfg/ssa/destruction/forest/forest.factor
 delete mode 100644 basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
 delete mode 100644 basis/compiler/cfg/ssa/destruction/renaming/renaming.factor
 delete mode 100644 basis/compiler/cfg/ssa/destruction/state/state.factor

diff --git a/basis/compiler/cfg/ssa/cssa/cssa.factor b/basis/compiler/cfg/ssa/cssa/cssa.factor
new file mode 100644
index 0000000000..37fa790453
--- /dev/null
+++ b/basis/compiler/cfg/ssa/cssa/cssa.factor
@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs kernel locals
+compiler.cfg.rpo
+compiler.cfg.hats
+compiler.cfg.utilities
+compiler.cfg.instructions ;
+IN: compiler.cfg.ssa.cssa
+
+! Convert SSA to conventional SSA.
+
+:: insert-copy ( bb src -- bb dst )
+    i :> dst
+    bb [ dst src ##copy ] add-instructions
+    bb dst ;
+
+: convert-phi ( ##phi -- )
+    [ [ insert-copy ] assoc-map ] change-inputs drop ;
+
+: construct-cssa ( cfg -- )
+    [ [ convert-phi ] each-phi ] each-basic-block ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/destruction/copies/copies.factor b/basis/compiler/cfg/ssa/destruction/copies/copies.factor
deleted file mode 100644
index 74180fe41f..0000000000
--- a/basis/compiler/cfg/ssa/destruction/copies/copies.factor
+++ /dev/null
@@ -1,25 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs hashtables fry kernel make namespaces
-sets sequences compiler.cfg.ssa.destruction.state
-compiler.cfg.parallel-copy compiler.cfg.utilities ;
-IN: compiler.cfg.ssa.destruction.copies
-
-ERROR: bad-copy ;
-
-: compute-copies ( assoc -- assoc' )
-    dup assoc-size <hashtable> [
-        '[
-            prune [
-                2dup eq? [ 2drop ] [
-                    _ 2dup key?
-                    [ bad-copy ] [ set-at ] if
-                ] if
-            ] with each
-        ] assoc-each
-    ] keep ;
-
-: insert-copies ( -- )
-    waiting get [
-        '[ _ compute-copies parallel-copy ] add-instructions
-    ] assoc-each ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor b/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
deleted file mode 100644
index a70d007430..0000000000
--- a/basis/compiler/cfg/ssa/destruction/destruction-tests.factor
+++ /dev/null
@@ -1,119 +0,0 @@
-USING: compiler.cfg.instructions compiler.cfg.registers cpu.architecture
-compiler.cfg.debugger arrays accessors kernel namespaces sequences assocs
-compiler.cfg.predecessors compiler.cfg.ssa.destruction tools.test
-compiler.cfg vectors ;
-IN: compiler.cfg.ssa.destruction.tests
-
-! This needs way more tests
-
-! Untested code path
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-} 0 test-bb
-
-V{
-    T{ ##peek f V int-regs 1 D 0 }
-} 1 test-bb
-
-V{
-    T{ ##replace f V int-regs 0 D 0 }
-} 2 test-bb
-
-V{
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##phi f V int-regs 2 H{ { 2 V int-regs 1 } { 3 V int-regs 0 } } }
-} 4 test-bb
-
-0 { 1 3 } edges
-1 2 edge
-2 4 edge
-3 4 edge
-
-: test-destruction ( -- )
-    cfg new 0 get >>entry compute-predecessors destruct-ssa drop ;
-
-[ ] [ test-destruction ] unit-test
-
-! "Virtual swap" problem
-V{
-    T{ ##peek f V int-regs 0 D 0 }
-    T{ ##peek f V int-regs 1 D 1 }
-} 0 test-bb
-
-V{
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##phi f V int-regs 2 H{ { 1 V int-regs 0 } { 2 V int-regs 1 } } }
-    T{ ##phi f V int-regs 3 H{ { 1 V int-regs 1 } { 2 V int-regs 0 } } }
-} 3 test-bb
-
-0 { 1 2 } edges
-1 3 edge
-2 3 edge
-
-[ ] [ test-destruction ] unit-test
-
-! How to test?
-
-! Reduction of suffix-arrays regression
-V{
-    T{ ##peek f V int-regs 48 D 0 }
-    T{ ##peek f V int-regs 47 D 0 }
-    T{ ##branch }
-} 0 test-bb
-
-V{
-    T{ ##branch }
-} 1 test-bb
-
-V{
-    T{ ##branch }
-} 2 test-bb
-
-V{
-    T{ ##branch }
-} 3 test-bb
-
-V{
-    T{ ##phi f V int-regs 94 H{ { 1 V int-regs 48 } { 2 V int-regs 47 } } }
-    T{ ##branch }
-} 4 test-bb
-
-V{
-    T{ ##branch }
-} 5 test-bb
-
-V{
-    T{ ##branch }
-} 6 test-bb
-
-V{
-    T{ ##branch }
-} 7 test-bb
-
-V{
-    T{ ##phi f V int-regs 56 H{ { 3 V int-regs 48 } { 6 V int-regs 94 } { 7 V int-regs 94 } { 5 V int-regs 47 } } }
-    T{ ##branch }
-} 8 test-bb
-
-0 { 1 2 } edges
-1 { 3 4 } edges
-2 { 4 5 } edges
-4 { 6 7 } edges
-3 8 edge
-6 8 edge
-7 8 edge
-5 8 edge
-
-[ ] [ test-destruction ] unit-test
-
-[ f ] [ 0 get instructions>> first2 [ dst>> ] bi@ = ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index d264ad1160..653ab0ce28 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction.factor
@@ -1,63 +1,109 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs fry kernel locals math math.order
-sequences namespaces sets
+USING: accessors arrays assocs fry kernel namespaces
+sequences sequences.deep
+sets vectors
 compiler.cfg.rpo
 compiler.cfg.def-use
-compiler.cfg.utilities
+compiler.cfg.renaming
 compiler.cfg.dominance
 compiler.cfg.instructions
 compiler.cfg.liveness.ssa
-compiler.cfg.critical-edges
-compiler.cfg.ssa.destruction.state
-compiler.cfg.ssa.destruction.forest
-compiler.cfg.ssa.destruction.copies
-compiler.cfg.ssa.destruction.renaming
+compiler.cfg.ssa.cssa
+compiler.cfg.ssa.interference
 compiler.cfg.ssa.interference.live-ranges
-compiler.cfg.ssa.destruction.process-blocks ;
+compiler.utilities ;
 IN: compiler.cfg.ssa.destruction
 
-! Based on "Fast Copy Coalescing and Live-Range Identification"
-! http://www.cs.ucsd.edu/classes/sp02/cse231/kenpldi.pdf
+! Maps vregs to leaders.
+SYMBOL: leader-map
 
-! Dominance, liveness and def-use need to be computed
+: leader ( vreg -- vreg' ) leader-map get compress-path ;
 
-: process-blocks ( cfg -- )
-    [ [ process-block ] if-has-phis ] each-basic-block ;
+! Maps leaders to equivalence class elements.
+SYMBOL: class-element-map
 
-SYMBOL: seen
+: class-elements ( vreg -- elts ) class-element-map get at ;
 
-:: visit-renaming ( dst assoc src bb -- )
-    src seen get key? [
-        src dst bb add-waiting
-        src assoc delete-at
-    ] [ src seen get conjoin ] if ;
+! Sequence of vreg pairs
+SYMBOL: copies
 
-:: break-interferences ( -- )
-    H{ } clone seen set
-    renaming-sets get [| dst assoc |
-        assoc [| src bb |
-            dst assoc src bb visit-renaming
-        ] assoc-each
+: init-coalescing ( -- )
+    H{ } clone leader-map set
+    H{ } clone class-element-map set
+    V{ } clone copies set ;
+
+: classes-interfere? ( vreg1 vreg2 -- ? )
+    [ leader ] bi@ 2dup eq? [ 2drop f ] [
+        [ class-elements flatten ] bi@
+        '[
+            _ [
+                interferes?
+            ] with any?
+        ] any?
+    ] if ;
+
+: update-leaders ( vreg1 vreg2 -- )
+    swap leader-map get set-at ;
+
+: merge-classes ( vreg1 vreg2 -- )
+    [ [ class-elements ] bi@ push ]
+    [ drop class-element-map get delete-at ] 2bi ;
+
+: eliminate-copy ( vreg1 vreg2 -- )
+    [ leader ] bi@
+    2dup eq? [ 2drop ] [
+        [ update-leaders ] [ merge-classes ] 2bi
+    ] if ;
+
+: introduce-vreg ( vreg -- )
+    [ leader-map get conjoin ]
+    [ [ 1vector ] keep class-element-map get set-at ] bi ;
+
+GENERIC: prepare-insn ( insn -- )
+
+M: ##copy prepare-insn
+    [ dst>> ] [ src>> ] bi 2array copies get push ;
+
+M: ##phi prepare-insn
+    [ dst>> ] [ inputs>> values ] bi
+    [ eliminate-copy ] with each ;
+
+M: insn prepare-insn drop ;
+
+: prepare-block ( bb -- )
+    instructions>> [ prepare-insn ] each ;
+
+: prepare-coalescing ( cfg -- )
+    init-coalescing
+    defs get keys [ introduce-vreg ] each
+    [ prepare-block ] each-basic-block ;
+
+: process-copies ( -- )
+    copies get [
+        2dup classes-interfere?
+        [ 2drop ] [ eliminate-copy ] if
     ] assoc-each ;
 
-: remove-phis-from-block ( bb -- )
-    instructions>> [ ##phi? not ] filter-here ;
+: useless-copy? ( ##copy -- ? )
+    dup ##copy? [ [ dst>> ] [ src>> ] bi eq? ] [ drop f ] if ;
 
-: remove-phis ( cfg -- )
-    [ [ remove-phis-from-block ] if-has-phis ] each-basic-block ;
+: perform-renaming ( cfg -- )
+    leader-map get keys [ dup leader ] H{ } map>assoc renamings set
+    [
+        instructions>> [
+            [ rename-insn-defs ]
+            [ rename-insn-uses ]
+            [ [ useless-copy? ] [ ##phi? ] bi or not ] tri
+        ] filter-here
+    ] each-basic-block ;
 
 : destruct-ssa ( cfg -- cfg' )
-    dup cfg-has-phis? [
-        dup split-critical-edges
-        compute-ssa-live-sets
-        init-coalescing
-        dup compute-def-use
-        dup compute-dominance
-        dup compute-live-ranges
-        dup process-blocks
-        break-interferences
-        dup perform-renaming
-        insert-copies
-        dup remove-phis
-    ] when ;
\ No newline at end of file
+    dup construct-cssa
+    compute-ssa-live-sets
+    dup compute-defs
+    dup compute-dominance
+    dup compute-live-ranges
+    dup prepare-coalescing
+    process-copies
+    dup perform-renaming ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor b/basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor
deleted file mode 100644
index af5d3f1091..0000000000
--- a/basis/compiler/cfg/ssa/destruction/forest/forest-tests.factor
+++ /dev/null
@@ -1,86 +0,0 @@
-USING: accessors compiler.cfg compiler.cfg.ssa.destruction.forest
-compiler.cfg.debugger compiler.cfg.dominance compiler.cfg.instructions
-compiler.cfg.predecessors compiler.cfg.registers compiler.cfg.def-use
-cpu.architecture kernel namespaces sequences tools.test vectors sorting
-math.order ;
-IN: compiler.cfg.ssa.destruction.forest.tests
-
-V{ T{ ##peek f V int-regs 0 D 0 } } clone 0 test-bb
-V{ T{ ##peek f V int-regs 1 D 0 } } clone 1 test-bb
-V{ T{ ##peek f V int-regs 2 D 0 } } clone 2 test-bb
-V{ T{ ##peek f V int-regs 3 D 0 } } clone 3 test-bb
-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 { 1 2 } edges
-2 { 3 4 } edges
-3 5 edge
-4 5 edge
-1 6 edge
-5 6 edge
-
-: clean-up-forest ( forest -- forest' )
-    [ [ vreg>> n>> ] compare ] sort
-    [
-        [ clean-up-forest ] change-children
-        [ number>> ] change-bb
-    ] V{ } map-as ;
-
-: test-dom-forest ( vregs -- forest )
-    cfg new 0 get >>entry
-    compute-predecessors
-    dup compute-dominance
-    compute-def-use
-    compute-dom-forest
-    clean-up-forest ;
-
-[ V{ } ] [ { } test-dom-forest ] unit-test
-
-[ V{ T{ dom-forest-node f V int-regs 0 0 V{ } } } ]
-[ { V int-regs 0 } test-dom-forest ]
-unit-test
-
-[
-    V{
-        T{ dom-forest-node
-           f
-           V int-regs 0
-           0
-           V{ T{ dom-forest-node f V int-regs 1 1 V{ } } }
-        }
-    }
-]
-[ { V int-regs 0 V int-regs 1 } test-dom-forest ]
-unit-test
-
-[
-    V{
-        T{ dom-forest-node
-           f
-           V int-regs 1
-           1
-           V{ }
-        }
-        T{ dom-forest-node
-           f
-           V int-regs 2
-           2
-           V{
-               T{ dom-forest-node f V int-regs 3 3 V{ } }
-               T{ dom-forest-node f V int-regs 4 4 V{ } }
-               T{ dom-forest-node f V int-regs 5 5 V{ } }
-           }
-        }
-        T{ dom-forest-node
-           f
-           V int-regs 6
-           6
-           V{ }
-        }
-    }
-]
-[
-    { V int-regs 1 V int-regs 6 V int-regs 2 V int-regs 3 V int-regs 4 V int-regs 5 }
-    test-dom-forest
-] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/destruction/forest/forest.factor b/basis/compiler/cfg/ssa/destruction/forest/forest.factor
deleted file mode 100644
index a196be13cb..0000000000
--- a/basis/compiler/cfg/ssa/destruction/forest/forest.factor
+++ /dev/null
@@ -1,38 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs fry kernel math math.order
-namespaces sequences sorting vectors compiler.cfg.def-use
-compiler.cfg.dominance compiler.cfg.registers ;
-IN: compiler.cfg.ssa.destruction.forest
-
-TUPLE: dom-forest-node vreg bb children ;
-
-<PRIVATE
-
-: sort-vregs-by-bb ( vregs -- alist )
-    defs get
-    '[ dup _ at ] { } map>assoc
-    [ [ second pre-of ] compare ] sort ;
-
-: <dom-forest-node> ( vreg bb parent -- node )
-    [ V{ } clone dom-forest-node boa dup ] dip children>> push ;
-
-: <virtual-root> ( -- node )
-    f f V{ } clone dom-forest-node boa ;
-
-: find-parent ( pre stack -- parent )
-    2dup last vreg>> def-of maxpre-of > [
-        dup pop* find-parent
-    ] [ nip last ] if ;
-
-: (compute-dom-forest) ( vreg bb stack -- )
-    [ dup pre-of ] dip [ find-parent <dom-forest-node> ] keep push ;
-
-PRIVATE>
-
-: compute-dom-forest ( vregs -- forest )
-    <virtual-root> [
-        1vector
-        [ sort-vregs-by-bb ] dip
-        '[ _ (compute-dom-forest) ] assoc-each
-    ] keep children>> ;
diff --git a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
deleted file mode 100644
index 1bfcbe3b9a..0000000000
--- a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor
+++ /dev/null
@@ -1,138 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs fry kernel locals math math.order arrays
-namespaces sequences sorting sets combinators combinators.short-circuit make
-compiler.cfg.def-use
-compiler.cfg.instructions
-compiler.cfg.liveness.ssa
-compiler.cfg.dominance
-compiler.cfg.ssa.interference
-compiler.cfg.ssa.destruction.state
-compiler.cfg.ssa.destruction.forest ;
-IN: compiler.cfg.ssa.destruction.process-blocks
-
-! phi-union maps a vreg to the predecessor block
-! that carries it to the phi node's block
-
-! unioned-blocks is a set of bb's which defined
-! the source vregs above
-SYMBOLS: phi-union unioned-blocks ;
-
-: operand-live-into-phi-node's-block? ( src dst -- ? )
-    def-of live-in? ;
-
-: phi-node-is-live-out-of-operand's-block? ( src dst -- ? )
-    swap def-of live-out? ;
-
-: operand-is-phi-node-and-live-into-operand's-block? ( src dst -- ? )
-    drop { [ insn-of ##phi? ] [ dup def-of live-in? ] } 1&& ;
-
-: operand-being-renamed? ( src dst -- ? )
-    drop processed-names get key? ;
-
-: two-operands-in-same-block? ( src dst -- ? )
-    drop def-of unioned-blocks get key? ;
-
-: trivial-interference? ( src dst -- ? )
-    {
-        [ operand-live-into-phi-node's-block? ]
-        [ phi-node-is-live-out-of-operand's-block? ]
-        [ operand-is-phi-node-and-live-into-operand's-block? ]
-        [ operand-being-renamed? ]
-        [ two-operands-in-same-block? ]
-    } 2|| ;
-
-: don't-coalesce ( bb src dst -- )
-    2nip processed-name ;
-
-:: trivial-interference ( bb src dst -- )
-    dst src bb add-waiting
-    src used-by-another get push ;
-
-:: add-to-renaming-set ( bb src dst -- )
-    bb src phi-union get set-at
-    src def-of unioned-blocks get conjoin ;
-
-: process-phi-operand ( bb src dst -- )
-    {
-        { [ 2dup eq? ] [ don't-coalesce ] }
-        { [ 2dup trivial-interference? ] [ trivial-interference ] }
-        [ add-to-renaming-set ]
-    } cond ;
-
-: node-is-live-in-of-child? ( node child -- ? )
-    [ vreg>> ] [ bb>> ] bi* live-in? ;
-
-: node-is-live-out-of-child? ( node child -- ? )
-    [ vreg>> ] [ bb>> ] bi* live-out? ;
-
-:: insert-copy ( bb src dst -- )
-    bb src dst trivial-interference
-    src phi-union get delete-at ;
-
-:: insert-copy-for-parent ( bb src dst node -- )
-    src node vreg>> eq? [ bb src dst insert-copy ] when ;
-
-: insert-copies-for-parent ( ##phi node child -- )
-    drop
-    [ [ inputs>> ] [ dst>> ] bi ] dip
-    '[ _ _ insert-copy-for-parent ] assoc-each ;
-
-: defined-in-same-block? ( node child -- ? ) [ bb>> ] bi@ eq? ;
-
-: add-interference ( ##phi node child -- )
-    [ vreg>> ] bi@ 2array , drop ;
-
-: process-df-child ( ##phi node child -- )
-    {
-        { [ 2dup node-is-live-out-of-child? ] [ insert-copies-for-parent ] }
-        { [ 2dup node-is-live-in-of-child? ] [ add-interference ] }
-        { [ 2dup defined-in-same-block? ] [ add-interference ] }
-        [ 3drop ]
-    } cond ;
-
-: process-df-node ( ##phi node -- )
-    dup children>>
-    [ [ process-df-child ] with with each ]
-    [ nip [ process-df-node ] with each ]
-    3bi ;
-
-: process-phi-union ( ##phi dom-forest -- )
-    [ process-df-node ] with each ;
-
-: add-local-interferences ( ##phi -- )
-    [ phi-union get ] dip dst>> '[ drop _ 2array , ] assoc-each ;
-
-: compute-local-interferences ( ##phi -- pairs )
-    [
-        [ phi-union get keys compute-dom-forest process-phi-union ]
-        [ add-local-interferences ]
-        bi
-    ] { } make ;
-
-:: insert-copies-for-interference ( ##phi src -- )
-    ##phi inputs>> [| bb src' |
-        src src' eq? [ bb src ##phi dst>> insert-copy ] when
-    ] assoc-each ;
-
-: process-local-interferences ( ##phi pairs -- )
-    [
-        first2 2dup interferes?
-        [ drop insert-copies-for-interference ] [ 3drop ] if
-    ] with each ;
-
-: add-renaming-set ( ##phi -- )
-    [ phi-union get ] dip dst>> renaming-sets get set-at
-    phi-union get [ drop processed-name ] assoc-each ;
-
-: process-phi ( ##phi -- )
-    H{ } clone phi-union set
-    H{ } clone unioned-blocks set
-    [ [ inputs>> ] [ dst>> ] bi '[ _ process-phi-operand ] assoc-each ]
-    [ dup compute-local-interferences process-local-interferences ]
-    [ add-renaming-set ]
-    tri ;
-
-: process-block ( bb -- )
-    instructions>>
-    [ dup ##phi? [ process-phi t ] [ drop f ] if ] all? drop ;
diff --git a/basis/compiler/cfg/ssa/destruction/renaming/renaming.factor b/basis/compiler/cfg/ssa/destruction/renaming/renaming.factor
deleted file mode 100644
index e5c547f96b..0000000000
--- a/basis/compiler/cfg/ssa/destruction/renaming/renaming.factor
+++ /dev/null
@@ -1,47 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs fry kernel namespaces sequences
-compiler.cfg.ssa.destruction.state compiler.cfg.renaming compiler.cfg.rpo
-disjoint-sets ;
-IN: compiler.cfg.ssa.destruction.renaming
-
-: build-disjoint-set ( assoc -- disjoint-set )
-    <disjoint-set> dup [
-        '[
-            [ _ add-atom ]
-            [ [ drop _ add-atom ] assoc-each ]
-            bi*
-        ] assoc-each
-    ] keep ;
-
-: update-congruence-class ( dst assoc disjoint-set -- )
-    [ keys swap ] dip equate-all-with ;
-        
-: build-congruence-classes ( -- disjoint-set )
-    renaming-sets get
-    dup build-disjoint-set
-    [ '[ _ update-congruence-class ] assoc-each ] keep ;
-
-: compute-renaming ( disjoint-set -- assoc )
-    [ parents>> ] keep
-    '[ drop dup _ representative ] assoc-map ;
-
-: rename-blocks ( cfg -- )
-    [
-        instructions>> [
-            [ rename-insn-defs ]
-            [ rename-insn-uses ] bi
-        ] each
-    ] each-basic-block ;
-
-: rename-copies ( -- )
-    waiting renamings get '[
-        [
-            [ _ [ ?at drop ] [ '[ _ ?at drop ] map ] bi-curry bi* ] assoc-map
-        ] assoc-map
-    ] change ;
-
-: perform-renaming ( cfg -- )
-    build-congruence-classes compute-renaming renamings set
-    rename-blocks
-    rename-copies ;
diff --git a/basis/compiler/cfg/ssa/destruction/state/state.factor b/basis/compiler/cfg/ssa/destruction/state/state.factor
deleted file mode 100644
index a10ac2c8de..0000000000
--- a/basis/compiler/cfg/ssa/destruction/state/state.factor
+++ /dev/null
@@ -1,18 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces sets kernel assocs ;
-IN: compiler.cfg.ssa.destruction.state
-
-SYMBOLS: processed-names waiting used-by-another renaming-sets ;
-
-: init-coalescing ( -- )
-    H{ } clone renaming-sets set
-    H{ } clone processed-names set
-    H{ } clone waiting set
-    V{ } clone used-by-another set ;
-
-: processed-name ( vreg -- ) processed-names get conjoin ;
-
-: waiting-for ( bb -- assoc ) waiting get [ drop H{ } clone ] cache ;
-
-: add-waiting ( dst src bb -- ) waiting-for push-at ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/interference/interference-tests.factor b/basis/compiler/cfg/ssa/interference/interference-tests.factor
index a973106d23..6d296b885e 100644
--- a/basis/compiler/cfg/ssa/interference/interference-tests.factor
+++ b/basis/compiler/cfg/ssa/interference/interference-tests.factor
@@ -11,7 +11,7 @@ IN: compiler.cfg.ssa.interference.tests
     cfg new 0 get >>entry
     compute-ssa-live-sets
     compute-predecessors
-    dup compute-def-use
+    dup compute-defs
     dup compute-dominance
     compute-live-ranges ;
 
diff --git a/basis/compiler/cfg/ssa/interference/interference.factor b/basis/compiler/cfg/ssa/interference/interference.factor
index c5f066e55b..1bf388750f 100644
--- a/basis/compiler/cfg/ssa/interference/interference.factor
+++ b/basis/compiler/cfg/ssa/interference/interference.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators combinators.short-circuit
-kernel math namespaces sequences locals compiler.cfg.def-use
-compiler.cfg.dominance compiler.cfg.ssa.interference.live-ranges ;
+USING: accessors assocs combinators combinators.short-circuit fry
+kernel math math.order sorting namespaces sequences locals
+compiler.cfg.def-use compiler.cfg.dominance
+compiler.cfg.ssa.interference.live-ranges ;
 IN: compiler.cfg.ssa.interference
 
 <PRIVATE
@@ -45,3 +46,33 @@ PRIVATE>
         { [ 2dup swap dominates? ] [ interferes-second-dominates? ] }
         [ 2drop 2drop f ]
     } cond ;
+
+! Debug this stuff later
+
+: quadratic-test? ( seq1 seq2 -- ? ) [ length ] bi@ + 10 < ;
+
+: quadratic-test ( seq1 seq2 -- ? )
+    '[ _ [ interferes? ] with any? ] any? ;
+
+: sort-vregs-by-bb ( vregs -- alist )
+    defs get
+    '[ dup _ at ] { } map>assoc
+    [ [ second pre-of ] compare ] sort ;
+
+: ?last ( seq -- elt/f ) [ f ] [ last ] if-empty ; inline
+
+: find-parent ( dom current -- parent )
+    over empty? [ 2drop f ] [
+        over last over dominates? [ drop last ] [
+            [ pop* ] dip find-parent
+        ] if
+    ] if ;
+
+:: linear-test ( seq1 seq2 -- ? )
+    V{ } clone :> dom
+    seq1 seq2 append sort-vregs-by-bb [| pair |
+        pair first :> current
+        dom current find-parent
+        dup [ current interferes? ] when
+        [ t ] [ current dom push f ] if
+    ] any? ;
diff --git a/basis/compiler/tree/propagation/copy/copy.factor b/basis/compiler/tree/propagation/copy/copy.factor
index c989aaf672..e5595daeed 100644
--- a/basis/compiler/tree/propagation/copy/copy.factor
+++ b/basis/compiler/tree/propagation/copy/copy.factor
@@ -5,7 +5,8 @@ combinators sets locals columns grouping
 stack-checker.branches
 compiler.tree
 compiler.tree.def-use
-compiler.tree.combinators ;
+compiler.tree.combinators
+compiler.utilities ;
 IN: compiler.tree.propagation.copy
 
 ! Two values are copy-equivalent if they are always identical
@@ -15,18 +16,6 @@ IN: compiler.tree.propagation.copy
 ! Mapping from values to their canonical leader
 SYMBOL: copies
 
-:: compress-path ( source assoc -- destination )
-    [let | destination [ source assoc at ] |
-        source destination = [ source ] [
-            [let | destination' [ destination assoc compress-path ] |
-                destination' destination = [
-                    destination' source assoc set-at
-                ] unless
-                destination'
-            ]
-        ] if
-    ] ;
-
 : resolve-copy ( copy -- val ) copies get compress-path ;
 
 : is-copy-of ( val copy -- ) copies get set-at ;
diff --git a/basis/compiler/utilities/utilities.factor b/basis/compiler/utilities/utilities.factor
index c21be39adb..c6b7b2adc5 100644
--- a/basis/compiler/utilities/utilities.factor
+++ b/basis/compiler/utilities/utilities.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences sequences.private arrays vectors fry
-math math.order namespaces assocs ;
+math math.order namespaces assocs locals ;
 IN: compiler.utilities
 
 : flattener ( seq quot -- seq vector quot' )
@@ -30,3 +30,15 @@ yield-hook [ [ ] ] initialize
     [ ] [ [ [ second ] bi@ > ] most ] map-reduce ;
 
 : penultimate ( seq -- elt ) [ length 2 - ] keep nth ;
+
+:: compress-path ( source assoc -- destination )
+    [let | destination [ source assoc at ] |
+        source destination = [ source ] [
+            [let | destination' [ destination assoc compress-path ] |
+                destination' destination = [
+                    destination' source assoc set-at
+                ] unless
+                destination'
+            ]
+        ] if
+    ] ;

From ba55633b196c833572f9b8332102bd285fdaef1d Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Sun, 2 Aug 2009 10:35:02 -0500
Subject: [PATCH 14/14] compiler.cfg.ssa.interference: cleanup

---
 .../cfg/ssa/destruction/destruction.factor    |  7 +----
 .../interference/interference-tests.factor    | 28 +++++++++----------
 .../cfg/ssa/interference/interference.factor  | 16 ++++++++---
 3 files changed, 27 insertions(+), 24 deletions(-)

diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index 653ab0ce28..c768914070 100644
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction.factor
@@ -35,12 +35,7 @@ SYMBOL: copies
 
 : classes-interfere? ( vreg1 vreg2 -- ? )
     [ leader ] bi@ 2dup eq? [ 2drop f ] [
-        [ class-elements flatten ] bi@
-        '[
-            _ [
-                interferes?
-            ] with any?
-        ] any?
+        [ class-elements flatten ] bi@ sets-interfere?
     ] if ;
 
 : update-leaders ( vreg1 vreg2 -- )
diff --git a/basis/compiler/cfg/ssa/interference/interference-tests.factor b/basis/compiler/cfg/ssa/interference/interference-tests.factor
index 6d296b885e..f8876755d9 100644
--- a/basis/compiler/cfg/ssa/interference/interference-tests.factor
+++ b/basis/compiler/cfg/ssa/interference/interference-tests.factor
@@ -36,17 +36,17 @@ V{
 
 [ ] [ test-interference ] unit-test
 
-[ f ] [ V int-regs 0 V int-regs 1 interferes? ] unit-test
-[ f ] [ V int-regs 1 V int-regs 0 interferes? ] unit-test
-[ f ] [ V int-regs 2 V int-regs 3 interferes? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 2 interferes? ] unit-test
-[ t ] [ V int-regs 0 V int-regs 2 interferes? ] unit-test
-[ t ] [ V int-regs 2 V int-regs 0 interferes? ] unit-test
-[ f ] [ V int-regs 1 V int-regs 3 interferes? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 1 interferes? ] unit-test
-[ t ] [ V int-regs 3 V int-regs 4 interferes? ] unit-test
-[ t ] [ V int-regs 4 V int-regs 3 interferes? ] unit-test
-[ t ] [ V int-regs 3 V int-regs 5 interferes? ] unit-test
-[ t ] [ V int-regs 5 V int-regs 3 interferes? ] unit-test
-[ f ] [ V int-regs 3 V int-regs 6 interferes? ] unit-test
-[ f ] [ V int-regs 6 V int-regs 3 interferes? ] unit-test
\ No newline at end of file
+[ f ] [ V int-regs 0 V int-regs 1 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 1 V int-regs 0 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 2 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 2 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 0 V int-regs 2 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 2 V int-regs 0 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 1 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 1 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 3 V int-regs 4 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 4 V int-regs 3 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 3 V int-regs 5 vregs-interfere? ] unit-test
+[ t ] [ V int-regs 5 V int-regs 3 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 3 V int-regs 6 vregs-interfere? ] unit-test
+[ f ] [ V int-regs 6 V int-regs 3 vregs-interfere? ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/interference/interference.factor b/basis/compiler/cfg/ssa/interference/interference.factor
index 1bf388750f..f8553ec9de 100644
--- a/basis/compiler/cfg/ssa/interference/interference.factor
+++ b/basis/compiler/cfg/ssa/interference/interference.factor
@@ -39,7 +39,7 @@ IN: compiler.cfg.ssa.interference
 
 PRIVATE>
 
-: interferes? ( vreg1 vreg2 -- ? )
+: vregs-interfere? ( vreg1 vreg2 -- ? )
     2dup [ def-of ] bi@ {
         { [ 2dup eq? ] [ interferes-same-block? ] }
         { [ 2dup dominates? ] [ interferes-first-dominates? ] }
@@ -48,11 +48,12 @@ PRIVATE>
     } cond ;
 
 ! Debug this stuff later
+<PRIVATE
 
 : quadratic-test? ( seq1 seq2 -- ? ) [ length ] bi@ + 10 < ;
 
 : quadratic-test ( seq1 seq2 -- ? )
-    '[ _ [ interferes? ] with any? ] any? ;
+    '[ _ [ vregs-interfere? ] with any? ] any? ;
 
 : sort-vregs-by-bb ( vregs -- alist )
     defs get
@@ -64,15 +65,22 @@ PRIVATE>
 : find-parent ( dom current -- parent )
     over empty? [ 2drop f ] [
         over last over dominates? [ drop last ] [
-            [ pop* ] dip find-parent
+            over pop* find-parent
         ] if
     ] if ;
 
 :: linear-test ( seq1 seq2 -- ? )
+    ! Instead of sorting, SSA destruction should keep equivalence
+    ! classes sorted by merging them on append
     V{ } clone :> dom
     seq1 seq2 append sort-vregs-by-bb [| pair |
         pair first :> current
         dom current find-parent
-        dup [ current interferes? ] when
+        dup [ current vregs-interfere? ] when
         [ t ] [ current dom push f ] if
     ] any? ;
+
+PRIVATE>
+
+: sets-interfere? ( seq1 seq2 -- ? )
+    quadratic-test ;
\ No newline at end of file