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] 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
+    ] ;