From 8e9badd4f54e7d40f9276d340fdb6fd9a7bcee89 Mon Sep 17 00:00:00 2001
From: Maximilian Lupke <simply.malu@googlemail.com>
Date: Mon, 20 Jul 2009 01:31:26 +0200
Subject: [PATCH 01/19] sequences.abbrev: Initial commit

---
 extra/sequences/abbrev/abbrev-tests.factor | 26 ++++++++++++++++++++++
 extra/sequences/abbrev/abbrev.factor       | 23 +++++++++++++++++++
 extra/sequences/abbrev/authors.txt         |  1 +
 3 files changed, 50 insertions(+)
 create mode 100644 extra/sequences/abbrev/abbrev-tests.factor
 create mode 100644 extra/sequences/abbrev/abbrev.factor
 create mode 100644 extra/sequences/abbrev/authors.txt

diff --git a/extra/sequences/abbrev/abbrev-tests.factor b/extra/sequences/abbrev/abbrev-tests.factor
new file mode 100644
index 0000000000..6e6739e09a
--- /dev/null
+++ b/extra/sequences/abbrev/abbrev-tests.factor
@@ -0,0 +1,26 @@
+USING: assocs sequences.abbrev tools.test ;
+IN: sequences.abbrev.tests
+
+[ { "help" "hello" } ] [
+    "he" { "apple" "hello" "help" } abbrev at
+] unit-test
+
+[ f ] [
+    "he" { "apple" "hello" "help" } unique-abbrev at
+] unit-test
+
+[ { "apple" } ] [
+    "a" { "apple" "hello" "help" } abbrev at
+] unit-test
+
+[ { "apple" } ] [
+    "a" { "apple" "hello" "help" } unique-abbrev at
+] unit-test
+
+[ f ] [
+    "a" { "hello" "help" } abbrev at
+] unit-test
+
+[ f ] [
+    "a" { "hello" "help" } unique-abbrev at
+] unit-test
diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor
new file mode 100644
index 0000000000..526737bd55
--- /dev/null
+++ b/extra/sequences/abbrev/abbrev.factor
@@ -0,0 +1,23 @@
+! Copyright (C) 2009 Maximilian Lupke.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays assocs fry kernel math.ranges sequences ;
+IN: sequences.abbrev
+
+<PRIVATE
+
+: prefixes ( seq -- prefixes )
+    dup length [1,b] [ dupd head ] map nip ;
+
+: (abbrev) ( seq -- assoc )
+    [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
+
+: assoc-merge ( assoc1 assoc2 -- assoc3 )
+    swap over '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ;
+
+PRIVATE>
+
+: abbrev ( seqs -- assoc )
+    [ (abbrev) ] map H{ } [ assoc-merge ] reduce ;
+
+: unique-abbrev ( seqs -- assoc )
+    abbrev [ nip length 1 = ] assoc-filter ;
diff --git a/extra/sequences/abbrev/authors.txt b/extra/sequences/abbrev/authors.txt
new file mode 100644
index 0000000000..758ea89529
--- /dev/null
+++ b/extra/sequences/abbrev/authors.txt
@@ -0,0 +1 @@
+Maximilian Lupke

From 52e09199e12be8c4a4e4f7c56a51099c84a2ceb8 Mon Sep 17 00:00:00 2001
From: Maximilian Lupke <simply.malu@googlemail.com>
Date: Mon, 20 Jul 2009 01:40:20 +0200
Subject: [PATCH 02/19] sequences.abbrev: small refactoring

---
 extra/sequences/abbrev/abbrev.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor
index 526737bd55..bab8bb94b2 100644
--- a/extra/sequences/abbrev/abbrev.factor
+++ b/extra/sequences/abbrev/abbrev.factor
@@ -6,7 +6,7 @@ IN: sequences.abbrev
 <PRIVATE
 
 : prefixes ( seq -- prefixes )
-    dup length [1,b] [ dupd head ] map nip ;
+    dup length [1,b] [ head ] with map ;
 
 : (abbrev) ( seq -- assoc )
     [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;

From e3ec2b6c8bbb018ebeeb58ffbe231281ebdc6ce1 Mon Sep 17 00:00:00 2001
From: Maximilian Lupke <simply.malu@googlemail.com>
Date: Mon, 20 Jul 2009 17:22:55 +0200
Subject: [PATCH 03/19] sequences.abbrev: more small refactoring

---
 extra/sequences/abbrev/abbrev.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor
index bab8bb94b2..d5bba8951e 100644
--- a/extra/sequences/abbrev/abbrev.factor
+++ b/extra/sequences/abbrev/abbrev.factor
@@ -12,7 +12,7 @@ IN: sequences.abbrev
     [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
 
 : assoc-merge ( assoc1 assoc2 -- assoc3 )
-    swap over '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ;
+    tuck '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ;
 
 PRIVATE>
 

From ea7cbd2b5afab52059973509c426d595d167a5c3 Mon Sep 17 00:00:00 2001
From: Maximilian Lupke <simply.malu@googlemail.com>
Date: Mon, 20 Jul 2009 20:18:13 +0200
Subject: [PATCH 04/19] sequences.abbrev: keep insertion order

---
 extra/sequences/abbrev/abbrev-tests.factor | 2 +-
 extra/sequences/abbrev/abbrev.factor       | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/sequences/abbrev/abbrev-tests.factor b/extra/sequences/abbrev/abbrev-tests.factor
index 6e6739e09a..39e445b495 100644
--- a/extra/sequences/abbrev/abbrev-tests.factor
+++ b/extra/sequences/abbrev/abbrev-tests.factor
@@ -1,7 +1,7 @@
 USING: assocs sequences.abbrev tools.test ;
 IN: sequences.abbrev.tests
 
-[ { "help" "hello" } ] [
+[ { "hello" "help" } ] [
     "he" { "apple" "hello" "help" } abbrev at
 ] unit-test
 
diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor
index d5bba8951e..6770a48a3a 100644
--- a/extra/sequences/abbrev/abbrev.factor
+++ b/extra/sequences/abbrev/abbrev.factor
@@ -12,7 +12,7 @@ IN: sequences.abbrev
     [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
 
 : assoc-merge ( assoc1 assoc2 -- assoc3 )
-    tuck '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ;
+    tuck '[ over _ at dup [ append ] [ drop ] if ] assoc-map assoc-union ;
 
 PRIVATE>
 

From 08814c33085f4901683c853abcf5913f4cf949a1 Mon Sep 17 00:00:00 2001
From: Maximilian Lupke <simply.malu@googlemail.com>
Date: Tue, 21 Jul 2009 00:37:45 +0200
Subject: [PATCH 05/19] sequences.abbrev: add docs - not much, but a start

---
 extra/sequences/abbrev/abbrev-docs.factor | 28 +++++++++++++++++++++++
 1 file changed, 28 insertions(+)
 create mode 100644 extra/sequences/abbrev/abbrev-docs.factor

diff --git a/extra/sequences/abbrev/abbrev-docs.factor b/extra/sequences/abbrev/abbrev-docs.factor
new file mode 100644
index 0000000000..ae351914de
--- /dev/null
+++ b/extra/sequences/abbrev/abbrev-docs.factor
@@ -0,0 +1,28 @@
+! Copyright (C) 2009 Maximilian Lupke.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs help.markup help.syntax sequences ;
+IN: sequences.abbrev
+
+HELP: abbrev
+{ $values
+    { "seqs" sequence }
+    { "assoc" assoc }
+}
+{ $description "Calculates an assoc of { prefix sequence } pairs with prefix being an prefix of each element of sequence for each element in " { $snippet "seqs" } "." } ;
+
+HELP: unique-abbrev
+{ $values
+    { "seqs" sequence }
+    { "assoc" assoc }
+}
+{ $description "Calculates an assoc of { prefix { sequence } } pairs with prefix being an unambiguous prefix of sequence in seqs." } ;
+
+ARTICLE: "sequences.abbrev" "Examples of abbrev usage"
+"It is probably easiest to just run examples to understand abbrev."
+{ $code
+    "{ \"hello\" \"help\" } abbrev"
+    "{ \"hello\" \"help\" } unique-abbrev"
+}
+;
+
+ABOUT: "sequences.abbrev"

From fd9a353fd6cce01933e81db1727cc5772159a6ca Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 21 Jul 2009 03:02:06 -0500
Subject: [PATCH 06/19] Move conjoin-at from compiler.cfg.liveness to sets

---
 basis/compiler/cfg/liveness/liveness.factor | 3 ---
 core/sets/sets-docs.factor                  | 5 +++++
 core/sets/sets.factor                       | 3 +++
 3 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor
index 8a46b32070..9dc320660c 100644
--- a/basis/compiler/cfg/liveness/liveness.factor
+++ b/basis/compiler/cfg/liveness/liveness.factor
@@ -43,9 +43,6 @@ SYMBOL: work-list
     [ nip kill-set ]
     2bi assoc-diff ;
 
-: conjoin-at ( value key assoc -- )
-    [ dupd ?set-at ] change-at ;
-
 : compute-phi-live-in ( basic-block -- phi-live-in )
     instructions>> [ ##phi? ] filter [ f ] [
         H{ } clone [
diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor
index 0fce78dd68..cec3d65d3c 100755
--- a/core/sets/sets-docs.factor
+++ b/core/sets/sets-docs.factor
@@ -23,6 +23,7 @@ $nl
 "Adding elements to sets:"
 { $subsection adjoin }
 { $subsection conjoin }
+{ $subsection conjoin-at }
 { $see-also member? memq? any? all? "assocs-sets" } ;
 
 ABOUT: "sets"
@@ -54,6 +55,10 @@ HELP: conjoin
 }
 { $side-effects "assoc" } ;
 
+HELP: conjoin-at
+{ $values { "value" object } { "key" object } { "assoc" assoc } }
+{ $description "Adds " { $snippet "value" } " to the set stored at " { $snippet "key" } " of " { $snippet "assoc" } "." } ;
+
 HELP: unique
 { $values { "seq" "a sequence" } { "assoc" assoc } }
 { $description "Outputs a new assoc where the keys and values are equal." }
diff --git a/core/sets/sets.factor b/core/sets/sets.factor
index 062b624e8f..c7b834297a 100755
--- a/core/sets/sets.factor
+++ b/core/sets/sets.factor
@@ -7,6 +7,9 @@ IN: sets
 
 : conjoin ( elt assoc -- ) dupd set-at ;
 
+: conjoin-at ( value key assoc -- )
+    [ dupd ?set-at ] change-at ;
+
 : (prune) ( elt hash vec -- )
     3dup drop key? [ 3drop ] [
         [ drop conjoin ] [ nip push ] 3bi

From 3136549f489cc573b53c461700e92a12b9190989 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 21 Jul 2009 03:02:45 -0500
Subject: [PATCH 07/19] compiler.cfg.dominance: fix idom computation, compute
 dominator tree, compute dominance frontiers, add some tests

---
 .../cfg/dominance/dominance-tests.factor      | 77 +++++++++++++++++++
 basis/compiler/cfg/dominance/dominance.factor | 76 +++++++++++++++---
 2 files changed, 141 insertions(+), 12 deletions(-)
 create mode 100644 basis/compiler/cfg/dominance/dominance-tests.factor

diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor
new file mode 100644
index 0000000000..e3e0d09cfc
--- /dev/null
+++ b/basis/compiler/cfg/dominance/dominance-tests.factor
@@ -0,0 +1,77 @@
+IN: compiler.cfg.dominance.tests
+USING: tools.test sequences vectors namespaces kernel accessors assocs sets
+math.ranges arrays compiler.cfg compiler.cfg.dominance compiler.cfg.debugger
+compiler.cfg.predecessors ;
+
+: test-dominance ( -- )
+    cfg new 0 get >>entry
+    compute-predecessors
+    compute-dominance
+    drop ;
+
+! Example with no back edges
+V{ } 0 test-bb
+V{ } 1 test-bb
+V{ } 2 test-bb
+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
+
+[ ] [ test-dominance ] unit-test
+
+[ t ] [ 0 get dom-parent 0 get eq? ] unit-test
+[ t ] [ 1 get dom-parent 0 get eq? ] unit-test
+[ t ] [ 2 get dom-parent 0 get eq? ] unit-test
+[ t ] [ 4 get dom-parent 0 get eq? ] unit-test
+[ t ] [ 3 get dom-parent 1 get eq? ] unit-test
+[ t ] [ 5 get dom-parent 4 get eq? ] unit-test
+
+[ t ] [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test
+
+[ t ] [ 4 get 1 get dom-frontier key? ] unit-test
+[ f ] [ 3 get 1 get dom-frontier key? ] unit-test
+[ t ] [ 4 get 2 get dom-frontier key? ] unit-test
+[ t ] [ 0 get dom-frontier assoc-empty? ] unit-test
+[ t ] [ 4 get dom-frontier assoc-empty? ] unit-test
+
+! Example from the paper
+V{ } 0 test-bb
+V{ } 1 test-bb
+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
+
+[ ] [ test-dominance ] unit-test
+
+[ t ] [ 0 4 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
+
+! The other example from the paper
+V{ } 0 test-bb
+V{ } 1 test-bb
+V{ } 2 test-bb
+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
+
+[ ] [ test-dominance ] unit-test
+
+[ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor
index 750a46ee6c..8b8d006560 100644
--- a/basis/compiler/cfg/dominance/dominance.factor
+++ b/basis/compiler/cfg/dominance/dominance.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators compiler.cfg.rpo
+USING: accessors assocs combinators sets math compiler.cfg.rpo
 compiler.cfg.stack-analysis fry kernel math.order namespaces
 sequences ;
 IN: compiler.cfg.dominance
@@ -11,31 +11,83 @@ IN: compiler.cfg.dominance
 ! Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy
 ! http://www.cs.rice.edu/~keith/EMBED/dom.pdf
 
-SYMBOL: idoms
-
-: idom ( bb -- bb' ) idoms get at ;
+! Also, a nice overview is given in these lecture notes:
+! http://llvm.cs.uiuc.edu/~vadve/CS526/public_html/Notes/4ssa.4up.pdf
 
 <PRIVATE
 
-: set-idom ( idom bb -- changed? ) idoms get maybe-set-at ;
+! Maps bb -> idom(bb)
+SYMBOL: dom-parents
+
+PRIVATE>
+
+: dom-parent ( bb -- bb' ) dom-parents get at ;
+
+<PRIVATE
+
+: set-idom ( idom bb -- changed? )
+    dom-parents get maybe-set-at ;
 
 : intersect ( finger1 finger2 -- bb )
     2dup [ number>> ] compare {
-        { +lt+ [ [ idom ] dip intersect ] }
-        { +gt+ [ idom intersect ] }
+        { +gt+ [ [ dom-parent ] dip intersect ] }
+        { +lt+ [ dom-parent intersect ] }
         [ 2drop ]
     } case ;
 
 : compute-idom ( bb -- idom )
-    predecessors>> [ idom ] map sift
+    predecessors>> [ dom-parent ] filter
     [ ] [ intersect ] map-reduce ;
 
 : iterate ( rpo -- changed? )
     [ [ compute-idom ] keep set-idom ] map [ ] any? ;
 
+: compute-dom-parents ( cfg -- )
+    H{ } clone dom-parents set
+    reverse-post-order
+    unclip dup set-idom drop '[ _ iterate ] loop ;
+
+! Maps bb -> {bb' | idom(bb') = bb}
+SYMBOL: dom-childrens
+
 PRIVATE>
 
-: compute-dominance ( cfg -- cfg )
-    H{ } clone idoms set
-    dup reverse-post-order
-    unclip dup set-idom drop '[ _ iterate ] loop ;
\ No newline at end of file
+: dom-children ( bb -- seq ) dom-childrens get at ;
+
+<PRIVATE
+
+: compute-dom-children ( -- )
+    dom-parents get H{ } clone
+    [ '[ 2dup eq? [ 2drop ] [ _ push-at ] if ] assoc-each ] keep
+    dom-childrens set ;
+
+! Maps bb -> DF(bb)
+SYMBOL: dom-frontiers
+
+PRIVATE>
+
+: dom-frontier ( bb -- set ) dom-frontiers get at ;
+
+<PRIVATE
+
+: compute-dom-frontier ( bb pred -- )
+    2dup [ dom-parent ] dip eq? [ 2drop ] [
+        [ dom-frontiers get conjoin-at ]
+        [ dom-parent compute-dom-frontier ] 2bi
+    ] if ;
+
+: compute-dom-frontiers ( cfg -- )
+    H{ } clone dom-frontiers set
+    [
+        dup predecessors>> dup length 2 >= [
+            [ compute-dom-frontier ] with each
+        ] [ 2drop ] if
+    ] each-basic-block ;
+
+PRIVATE>
+
+: compute-dominance ( cfg -- cfg' )
+    [ compute-dom-parents compute-dom-children ]
+    [ compute-dom-frontiers ]
+    [ ]
+    tri ;

From e7e5bee9a278e554a1f151586c715feaf6921819 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 21 Jul 2009 17:49:30 -0500
Subject: [PATCH 08/19] compiler.cfg.ssa: Cytron's SSA construction algorithm

---
 .../cfg/dominance/dominance-tests.factor      |   9 +-
 basis/compiler/cfg/dominance/dominance.factor |   7 +-
 basis/compiler/cfg/renaming/renaming.factor   |   8 +
 basis/compiler/cfg/ssa/ssa-tests.factor       |  79 ++++++++++
 basis/compiler/cfg/ssa/ssa.factor             | 146 ++++++++++++++++++
 5 files changed, 240 insertions(+), 9 deletions(-)
 create mode 100644 basis/compiler/cfg/ssa/ssa-tests.factor
 create mode 100644 basis/compiler/cfg/ssa/ssa.factor

diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor
index e3e0d09cfc..b87f668d88 100644
--- a/basis/compiler/cfg/dominance/dominance-tests.factor
+++ b/basis/compiler/cfg/dominance/dominance-tests.factor
@@ -34,11 +34,10 @@ V{ } 5 test-bb
 
 [ t ] [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test
 
-[ t ] [ 4 get 1 get dom-frontier key? ] unit-test
-[ f ] [ 3 get 1 get dom-frontier key? ] unit-test
-[ t ] [ 4 get 2 get dom-frontier key? ] unit-test
-[ t ] [ 0 get dom-frontier assoc-empty? ] unit-test
-[ t ] [ 4 get dom-frontier assoc-empty? ] unit-test
+[ { 4 } ] [ 1 get dom-frontier [ number>> ] map ] unit-test
+[ { 4 } ] [ 2 get dom-frontier [ number>> ] map ] unit-test
+[ f ] [ 0 get dom-frontier ] unit-test
+[ f ] [ 4 get dom-frontier ] unit-test
 
 ! Example from the paper
 V{ } 0 test-bb
diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor
index 8b8d006560..9c8fc79619 100644
--- a/basis/compiler/cfg/dominance/dominance.factor
+++ b/basis/compiler/cfg/dominance/dominance.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators sets math compiler.cfg.rpo
-compiler.cfg.stack-analysis fry kernel math.order namespaces
-sequences ;
+USING: accessors assocs combinators sets math fry kernel math.order
+namespaces sequences sorting compiler.cfg.rpo ;
 IN: compiler.cfg.dominance
 
 ! Reference:
@@ -66,7 +65,7 @@ SYMBOL: dom-frontiers
 
 PRIVATE>
 
-: dom-frontier ( bb -- set ) dom-frontiers get at ;
+: dom-frontier ( bb -- set ) dom-frontiers get at keys ;
 
 <PRIVATE
 
diff --git a/basis/compiler/cfg/renaming/renaming.factor b/basis/compiler/cfg/renaming/renaming.factor
index efc841e21f..8dbcadfe8b 100644
--- a/basis/compiler/cfg/renaming/renaming.factor
+++ b/basis/compiler/cfg/renaming/renaming.factor
@@ -14,6 +14,14 @@ M: ##flushable rename-insn-defs
     [ rename-value ] change-dst
     drop ;
 
+M: ##fixnum-overflow rename-insn-defs
+    [ rename-value ] change-dst
+    drop ;
+
+M: _fixnum-overflow rename-insn-defs
+    [ rename-value ] change-dst
+    drop ;
+
 M: insn rename-insn-defs drop ;
 
 GENERIC: rename-insn-uses ( insn -- )
diff --git a/basis/compiler/cfg/ssa/ssa-tests.factor b/basis/compiler/cfg/ssa/ssa-tests.factor
new file mode 100644
index 0000000000..c53d30af5d
--- /dev/null
+++ b/basis/compiler/cfg/ssa/ssa-tests.factor
@@ -0,0 +1,79 @@
+USING: accessors compiler.cfg compiler.cfg.debugger
+compiler.cfg.dominance compiler.cfg.instructions
+compiler.cfg.predecessors compiler.cfg.ssa assocs
+compiler.cfg.registers cpu.architecture kernel namespaces sequences
+tools.test vectors ;
+IN: compiler.cfg.ssa.tests
+
+! Reset counters so that results are deterministic w.r.t. hash order
+0 vreg-counter set-global
+0 basic-block set-global
+
+V{
+    T{ ##load-immediate f V int-regs 1 100 }
+    T{ ##add-imm f V int-regs 2 V int-regs 1 50 }
+    T{ ##add-imm f V int-regs 2 V int-regs 2 10 }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##load-immediate f V int-regs 3 3 }
+    T{ ##branch }
+} 1 test-bb
+
+V{
+    T{ ##load-immediate f V int-regs 3 4 }
+    T{ ##branch }
+} 2 test-bb
+
+V{
+    T{ ##replace f V int-regs 3 D 0 }
+    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
+
+: test-ssa ( -- )
+    cfg new 0 get >>entry
+    compute-predecessors
+    compute-dominance
+    construct-ssa
+    drop ;
+
+[ ] [ test-ssa ] unit-test
+
+[
+    V{
+        T{ ##load-immediate f V int-regs 1 100 }
+        T{ ##add-imm f V int-regs 2 V int-regs 1 50 }
+        T{ ##add-imm f V int-regs 3 V int-regs 2 10 }
+        T{ ##branch }
+    }
+] [ 0 get instructions>> ] unit-test
+
+[
+    V{
+        T{ ##load-immediate f V int-regs 4 3 }
+        T{ ##branch }
+    }
+] [ 1 get instructions>> ] unit-test
+
+[
+    V{
+        T{ ##load-immediate f V int-regs 5 4 }
+        T{ ##branch }
+    }
+] [ 2 get instructions>> ] unit-test
+
+[
+    V{
+        T{ ##phi f V int-regs 6 H{ { 1 V int-regs 4 } { 2 V int-regs 5 } } }
+        T{ ##replace f V int-regs 6 D 0 }
+        T{ ##return }
+    }
+] [
+    3 get instructions>>
+    [ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map
+] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/ssa.factor b/basis/compiler/cfg/ssa/ssa.factor
new file mode 100644
index 0000000000..e11701965b
--- /dev/null
+++ b/basis/compiler/cfg/ssa/ssa.factor
@@ -0,0 +1,146 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces kernel accessors sequences fry dlists
+deques assocs sets math combinators sorting
+compiler.cfg
+compiler.cfg.rpo
+compiler.cfg.def-use
+compiler.cfg.renaming
+compiler.cfg.registers
+compiler.cfg.dominance
+compiler.cfg.instructions ;
+IN: compiler.cfg.ssa
+
+! SSA construction. Predecessors and dominance must be computed first.
+
+! This is the classical algorithm based on dominance frontiers:
+! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.25.8240
+
+! Eventually might be worth trying something fancier:
+! http://portal.acm.org/citation.cfm?id=1065887.1065890
+
+<PRIVATE
+
+! Maps vreg to sequence of basic blocks
+SYMBOL: defs
+
+! Maps basic blocks to sequences of vregs
+SYMBOL: inserting-phi-nodes
+
+: compute-defs ( cfg -- )
+    H{ } clone dup defs set
+    '[
+        dup instructions>> [
+            defs-vregs [
+                _ push-at
+            ] with each
+        ] with each
+    ] each-basic-block ;
+
+SYMBOLS: has-already ever-on-work-list work-list ;
+
+: init-insert-phi-nodes ( bbs -- )
+    H{ } clone has-already set
+    [ unique ever-on-work-list set ]
+    [ <hashed-dlist> [ push-all-front ] keep work-list set ] bi ;
+
+: add-to-work-list ( bb -- )
+    dup ever-on-work-list get key? [ drop ] [
+        [ ever-on-work-list get conjoin ]
+        [ work-list get push-front ]
+        bi
+    ] if ;
+
+: insert-phi-node-later ( vreg bb -- )
+    [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
+    inserting-phi-nodes get push-at ;
+
+: compute-phi-node-in ( vreg bb -- )
+    dup has-already get key? [ 2drop ] [
+        [ insert-phi-node-later ]
+        [ has-already get conjoin ]
+        [ add-to-work-list ]
+        tri
+    ] if ;
+
+: compute-phi-nodes-for ( vreg bbs -- )
+    dup length 2 >= [
+        init-insert-phi-nodes
+        work-list get [
+            dom-frontier [
+                compute-phi-node-in
+            ] with each
+        ] with slurp-deque
+    ] [ 2drop ] if ;
+
+: compute-phi-nodes ( -- )
+    H{ } clone inserting-phi-nodes set
+    defs get [ compute-phi-nodes-for ] assoc-each ;
+
+: insert-phi-nodes-in ( phis bb -- )
+    [ append ] change-instructions drop ;
+
+: insert-phi-nodes ( -- )
+    inserting-phi-nodes get [ swap insert-phi-nodes-in ] assoc-each ;
+
+SYMBOLS: stacks originals ;
+
+: init-renaming ( -- )
+    H{ } clone stacks set
+    H{ } clone originals set ;
+
+: gen-name ( vreg -- vreg' )
+    [ reg-class>> next-vreg ] keep
+    [ stacks get push-at ]
+    [ swap originals get set-at ]
+    [ drop ]
+    2tri ;
+
+: top-name ( vreg -- vreg' )
+    stacks get at last ;
+
+GENERIC: rename-insn ( insn -- )
+
+M: insn rename-insn
+    [ dup uses-vregs [ dup top-name ] { } map>assoc renamings set rename-insn-uses ]
+    [ dup defs-vregs [ dup gen-name ] { } map>assoc renamings set rename-insn-defs ]
+    bi ;
+
+M: ##phi rename-insn
+    dup defs-vregs [ dup gen-name ] { } map>assoc renamings set rename-insn-defs ;
+
+: rename-insns ( bb -- )
+    instructions>> [ rename-insn ] each ;
+
+: rename-successor-phi ( phi bb -- )
+    swap inputs>> [ top-name ] change-at ;
+
+: rename-successor-phis ( succ bb -- )
+    [ inserting-phi-nodes get at ] dip
+    '[ _ rename-successor-phi ] each ;
+
+: rename-successors-phis ( bb -- )
+    [ successors>> ] keep '[ _ rename-successor-phis ] each ;
+
+: pop-stacks ( bb -- )
+    instructions>> [
+        defs-vregs originals get stacks get
+        '[ _ at _ at pop* ] each
+    ] each ;
+
+: rename-in-block ( bb -- )
+    {
+        [ rename-insns ]
+        [ rename-successors-phis ]
+        [ dom-children [ rename-in-block ] each ]
+        [ pop-stacks ]
+    } cleave ;
+
+: rename ( cfg -- )
+    init-renaming
+    entry>> rename-in-block ;
+
+PRIVATE>
+
+: construct-ssa ( cfg -- cfg' )
+    dup [ compute-defs compute-phi-nodes insert-phi-nodes ] [ rename ] bi ;
\ No newline at end of file

From ead57fc5dde4cc15770d74301f197be96e9777a0 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 21 Jul 2009 17:49:44 -0500
Subject: [PATCH 09/19] compiler.cfg.registers: minor optimization

---
 basis/compiler/cfg/registers/registers.factor | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor
index 71f313be5a..c5b3907153 100644
--- a/basis/compiler/cfg/registers/registers.factor
+++ b/basis/compiler/cfg/registers/registers.factor
@@ -1,11 +1,17 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors namespaces kernel arrays parser ;
+USING: accessors namespaces kernel arrays parser math math.order ;
 IN: compiler.cfg.registers
 
 ! Virtual registers, used by CFG and machine IRs
-TUPLE: vreg { reg-class read-only } { n read-only } ;
+TUPLE: vreg { reg-class read-only } { n fixnum read-only } ;
+
+M: vreg equal? over vreg? [ [ n>> ] bi@ eq? ] [ 2drop f ] if ;
+
+M: vreg hashcode* nip n>> ;
+
 SYMBOL: vreg-counter
+
 : next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ;
 
 ! Stack locations -- 'n' is an index starting from the top of the stack

From 1aa6c9a0d538812370d499b274f69cdeedbc4c26 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 21 Jul 2009 22:25:19 -0500
Subject: [PATCH 10/19] compiler.cfg: Fix unit tests

---
 .../cfg/dominance/dominance-tests.factor      |  4 ++--
 .../phi-elimination-tests.factor              | 23 +++++++------------
 .../value-numbering-tests.factor              | 11 ---------
 3 files changed, 10 insertions(+), 28 deletions(-)

diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor
index b87f668d88..210d5614c2 100644
--- a/basis/compiler/cfg/dominance/dominance-tests.factor
+++ b/basis/compiler/cfg/dominance/dominance-tests.factor
@@ -36,8 +36,8 @@ V{ } 5 test-bb
 
 [ { 4 } ] [ 1 get dom-frontier [ number>> ] map ] unit-test
 [ { 4 } ] [ 2 get dom-frontier [ number>> ] map ] unit-test
-[ f ] [ 0 get dom-frontier ] unit-test
-[ f ] [ 4 get dom-frontier ] unit-test
+[ { } ] [ 0 get dom-frontier ] unit-test
+[ { } ] [ 4 get dom-frontier ] unit-test
 
 ! Example from the paper
 V{ } 0 test-bb
diff --git a/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor b/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor
index 79d1797720..22afc0b32b 100644
--- a/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor
+++ b/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor
@@ -36,27 +36,20 @@ V{
 
 test-diamond
 
+3 vreg-counter set-global
+
 [ ] [ cfg new 0 get >>entry eliminate-phis drop ] unit-test
 
-[let | n! [ f ] |
-
-[ ] [ 2 get successors>> first instructions>> first dst>> n>> n! ] unit-test
-
-[ t ] [
-    T{ ##copy f V int-regs n V int-regs 1 }
-    2 get successors>> first instructions>> first =
+[ T{ ##copy f V int-regs 4 V int-regs 1 } ] [
+    2 get successors>> first instructions>> first
 ] unit-test
 
-[ t ] [
-    T{ ##copy f V int-regs n V int-regs 2 }
-    3 get successors>> first instructions>> first =
+[ T{ ##copy f V int-regs 4 V int-regs 2 } ] [
+    3 get successors>> first instructions>> first
 ] unit-test
 
-[ t ] [
-    T{ ##copy f V int-regs 3 V int-regs n }
-    4 get instructions>> first =
+[ T{ ##copy f V int-regs 3 V int-regs 4 } ] [
+    4 get instructions>> first
 ] unit-test
 
-]
-
 [ 3 ] [ 4 get instructions>> length ] 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 62ed4a7eb3..bd2bb692b7 100644
--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
@@ -1218,17 +1218,6 @@ test-diamond
 
 [ t ] [ 1 get successors>> first 3 get eq? ] unit-test
 
-[let | n! [ f ] |
-
-[ ] [ 2 get successors>> first instructions>> first src>> n>> n! ] unit-test
-
-[ t ] [
-    T{ ##copy f V int-regs n V int-regs 2 }
-    3 get successors>> first instructions>> first =
-] unit-test
-
-]
-
 [ 3 ] [ 4 get instructions>> length ] unit-test
 
 V{

From 42230b21a3b76fae48f6fdc0dda61d6f9fd661ec Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 02:06:14 -0500
Subject: [PATCH 11/19] Add assoc-refine, which takes the intersection of a
 sequence of assocs

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

diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor
index 75607b0258..3c5ac31d23 100644
--- a/core/assocs/assocs-tests.factor
+++ b/core/assocs/assocs-tests.factor
@@ -134,3 +134,19 @@ unit-test
 [ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test
 [ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test
 [ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test
+
+[ H{ { 1 2 } { 2 3 } } ] [
+    {
+        H{ { 1 3 } }
+        H{ { 2 3 } }
+        H{ { 1 2 } }
+    } assoc-combine
+] unit-test
+
+[ H{ { 1 7 } } ] [
+    {
+        H{ { 1 2 } { 2 4 } { 5 6 } }
+        H{ { 1 3 } { 2 5 } }
+        H{ { 1 7 } { 5 6 } }
+    } assoc-refine
+] unit-test
\ No newline at end of file
diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 62ab9f86ae..8b6809236c 100755
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -129,6 +129,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
 : assoc-combine ( seq -- union )
     H{ } clone [ dupd update ] reduce ;
 
+: assoc-refine ( seq -- assoc )
+    [ f ] [ [ ] [ assoc-intersect ] map-reduce ] if-empty ;
+
 : assoc-diff ( assoc1 assoc2 -- diff )
     [ nip key? not ] curry assoc-filter ;
 

From dce020ca711d5157910c61214042cba41d5682b4 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 02:06:24 -0500
Subject: [PATCH 12/19] functors: add MIXIN:, SINGLETON:

---
 basis/functors/functors.factor | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor
index 6ffc4d8112..5129515980 100644
--- a/basis/functors/functors.factor
+++ b/basis/functors/functors.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes.mixin classes.parser
-classes.tuple classes.tuple.parser combinators effects
-effects.parser fry generic generic.parser generic.standard
-interpolate io.streams.string kernel lexer locals.parser
-locals.rewrite.closures locals.types make namespaces parser
-quotations sequences vocabs.parser words words.symbol ;
+USING: accessors arrays classes.mixin classes.parser classes.singleton
+classes.tuple classes.tuple.parser combinators effects effects.parser
+fry generic generic.parser generic.standard interpolate
+io.streams.string kernel lexer locals.parser locals.rewrite.closures
+locals.types make namespaces parser quotations sequences vocabs.parser
+words words.symbol ;
 IN: functors
 
 ! This is a hack
@@ -71,6 +71,14 @@ SYNTAX: `TUPLE:
     } case
     \ define-tuple-class parsed ;
 
+SYNTAX: `SINGLETON:
+    scan-param parsed
+    \ define-singleton-class parsed ;
+
+SYNTAX: `MIXIN:
+    scan-param parsed
+    \ define-mixin-class parsed ;
+
 SYNTAX: `M:
     scan-param parsed
     scan-param parsed
@@ -134,6 +142,8 @@ DEFER: ;FUNCTOR delimiter
 : functor-words ( -- assoc )
     H{
         { "TUPLE:" POSTPONE: `TUPLE: }
+        { "SINGLETON:" POSTPONE: `SINGLETON: }
+        { "MIXIN:" POSTPONE: `MIXIN: }
         { "M:" POSTPONE: `M: }
         { "C:" POSTPONE: `C: }
         { ":" POSTPONE: `: }

From e6a323dfaae4b956b06d0afad1e5f9a84c33b3b9 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 02:06:35 -0500
Subject: [PATCH 13/19] compiler.cfg.dataflow-analysis: iterative dataflow
 analysis framework

---
 .../dataflow-analysis.factor                  | 140 ++++++++++++++++++
 1 file changed, 140 insertions(+)
 create mode 100644 basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor

diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
new file mode 100644
index 0000000000..975adfa6cb
--- /dev/null
+++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
@@ -0,0 +1,140 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs deques dlists kernel locals sequences lexer
+namespaces functors compiler.cfg.rpo compiler.cfg.utilities
+compiler.cfg ;
+IN: compiler.cfg.dataflow-analysis
+
+GENERIC: join-sets ( sets dfa -- set )
+GENERIC: transfer-set ( in-set bb dfa -- out-set )
+GENERIC: block-order ( cfg dfa -- bbs )
+GENERIC: successors ( bb dfa -- seq )
+GENERIC: predecessors ( bb dfa -- seq )
+
+<PRIVATE
+
+MIXIN: dataflow-analysis
+
+: <dfa-worklist> ( cfg dfa -- queue )
+    block-order <hashed-dlist> [ push-all-front ] keep ;
+
+GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
+
+M: kill-block compute-in-set 3drop f ;
+
+M:: basic-block compute-in-set ( bb out-sets dfa -- set )
+    bb dfa predecessors [ out-sets at ] map dfa join-sets ;
+
+:: update-in-set ( bb in-sets out-sets dfa -- ? )
+    bb out-sets dfa compute-in-set
+    bb in-sets maybe-set-at ; inline
+
+GENERIC# compute-out-set 2 ( bb out-sets dfa -- set )
+
+M: kill-block compute-out-set 3drop f ;
+
+M:: basic-block compute-out-set ( bb in-sets dfa -- set )
+    bb in-sets at bb dfa transfer-set ;
+
+:: update-out-set ( bb in-sets out-sets dfa -- ? )
+    bb in-sets dfa compute-out-set
+    bb out-sets maybe-set-at ; inline
+
+:: dfa-step ( bb in-sets out-sets dfa work-list -- )
+    bb in-sets out-sets dfa update-in-set [
+        bb in-sets out-sets dfa update-out-set [
+            bb dfa successors work-list push-all-front
+        ] when
+    ] when ; inline
+
+:: run-dataflow-analysis ( cfg dfa -- in-sets out-sets )
+    H{ } clone :> in-sets
+    H{ } clone :> out-sets
+    cfg dfa <dfa-worklist> :> work-list
+    work-list [ in-sets out-sets dfa work-list dfa-step ] slurp-deque
+    in-sets
+    out-sets ; inline
+
+M: dataflow-analysis join-sets drop assoc-refine ;
+
+FUNCTOR: define-analysis ( name -- )
+
+name-analysis DEFINES-CLASS ${name}-analysis
+name-ins DEFINES ${name}-ins
+name-outs DEFINES ${name}-outs
+name-in DEFINES ${name}-in
+name-out DEFINES ${name}-out
+
+WHERE
+
+SINGLETON: name-analysis
+
+SYMBOL: name-ins
+
+: name-in ( bb -- set ) name-ins get at ;
+
+SYMBOL: name-outs
+
+: name-out ( bb -- set ) name-outs get at ;
+
+;FUNCTOR
+
+! ! ! Forward dataflow analysis
+
+MIXIN: forward-analysis
+INSTANCE: forward-analysis dataflow-analysis
+
+M: forward-analysis block-order  drop reverse-post-order ;
+M: forward-analysis successors   drop successors>> ;
+M: forward-analysis predecessors drop predecessors>> ;
+
+FUNCTOR: define-forward-analysis ( name -- )
+
+name-analysis IS ${name}-analysis
+name-ins IS ${name}-ins
+name-outs IS ${name}-outs
+compute-name-sets DEFINES compute-${name}-sets
+
+WHERE
+
+INSTANCE: name-analysis forward-analysis
+
+: compute-name-sets ( cfg -- )
+    name-analysis run-dataflow-analysis
+    [ name-ins set ] [ name-outs set ] bi* ;
+
+;FUNCTOR
+
+! ! ! Backward dataflow analysis
+
+MIXIN: backward-analysis
+INSTANCE: backward-analysis dataflow-analysis
+
+M: backward-analysis block-order  drop post-order ;
+M: backward-analysis successors   drop predecessors>> ;
+M: backward-analysis predecessors drop successors>> ;
+
+FUNCTOR: define-backward-analysis ( name -- )
+
+name-analysis IS ${name}-analysis
+name-ins IS ${name}-ins
+name-outs IS ${name}-outs
+compute-name-sets DEFINES compute-${name}-sets
+
+WHERE
+
+INSTANCE: name-analysis backward-analysis
+
+: compute-name-sets ( cfg -- )
+    \ name-analysis run-dataflow-analysis
+    [ name-outs set ] [ name-ins set ] bi* ;
+
+;FUNCTOR
+
+PRIVATE>
+
+SYNTAX: FORWARD-ANALYSIS:
+    scan [ define-analysis ] [ define-forward-analysis ] bi ;
+
+SYNTAX: BACKWARD-ANALYSIS:
+    scan [ define-analysis ] [ define-backward-analysis ] bi ;

From 21a012e3d765730dacf1ccff8796a0d9153e487f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 03:08:28 -0500
Subject: [PATCH 14/19] compiler.cfg: Major restructuring -- do not compute
 liveness before local optimization, and instead change local optimizations to
 be more permissive of undefined values. Now, liveness is only computed once,
 after phi elimination and before register allocation. This means liveness
 analysis does not need to take phi nodes into account and can now use the new
 compiler.cfg.dataflow-analysis framework

---
 .../cfg/alias-analysis/alias-analysis.factor  |  13 +-
 basis/compiler/cfg/checker/checker.factor     |   6 +-
 .../dataflow-analysis.factor                  |   4 +-
 basis/compiler/cfg/debugger/debugger.factor   |   2 +-
 basis/compiler/cfg/def-use/def-use.factor     |  12 +-
 .../linear-scan/assignment/assignment.factor  |   9 +-
 .../cfg/linear-scan/linear-scan-tests.factor  |  11 +-
 .../cfg/linear-scan/linear-scan.factor        |  16 +-
 .../live-intervals/live-intervals.factor      |   7 +-
 .../cfg/linear-scan/liveness/liveness.factor  |  17 +++
 .../linear-scan/numbering/numbering.factor    |   9 +-
 .../cfg/linear-scan/resolve/resolve.factor    |   8 +-
 .../cfg/linearization/linearization.factor    |   1 -
 basis/compiler/cfg/liveness/authors.txt       |   1 -
 .../cfg/liveness/liveness-tests.factor        |  15 --
 basis/compiler/cfg/liveness/liveness.factor   |  79 ----------
 basis/compiler/cfg/local/authors.txt          |   1 -
 basis/compiler/cfg/local/local.factor         |  14 --
 basis/compiler/cfg/mr/mr.factor               |   3 +-
 basis/compiler/cfg/optimizer/optimizer.factor |   2 -
 basis/compiler/cfg/renaming/renaming.factor   |   2 +-
 basis/compiler/cfg/rpo/rpo.factor             |   7 +
 .../cfg/two-operand/two-operand.factor        |   3 +-
 .../expressions/expressions.factor            |  14 +-
 .../cfg/value-numbering/graph/graph.factor    |  13 +-
 .../value-numbering-tests.factor              | 140 +++++++++---------
 .../value-numbering/value-numbering.factor    |  20 +--
 .../cfg/write-barrier/write-barrier.factor    |   4 +-
 28 files changed, 170 insertions(+), 263 deletions(-)
 create mode 100644 basis/compiler/cfg/linear-scan/liveness/liveness.factor
 delete mode 100644 basis/compiler/cfg/liveness/authors.txt
 delete mode 100644 basis/compiler/cfg/liveness/liveness-tests.factor
 delete mode 100644 basis/compiler/cfg/liveness/liveness.factor
 delete mode 100644 basis/compiler/cfg/local/authors.txt
 delete mode 100644 basis/compiler/cfg/local/local.factor

diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
index d0bb792f72..78e271c1f6 100644
--- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
@@ -3,8 +3,7 @@
 USING: kernel math namespaces assocs hashtables sequences arrays
 accessors vectors combinators sets classes compiler.cfg
 compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.copy-prop compiler.cfg.rpo
-compiler.cfg.liveness compiler.cfg.local ;
+compiler.cfg.copy-prop compiler.cfg.rpo compiler.cfg.def-use ;
 IN: compiler.cfg.alias-analysis
 
 ! We try to eliminate redundant slot operations using some simple heuristics.
@@ -197,7 +196,10 @@ M: ##set-slot insn-object obj>> resolve ;
 M: ##set-slot-imm insn-object obj>> resolve ;
 M: ##alien-global insn-object drop \ ##alien-global ;
 
-: init-alias-analysis ( live-in -- )
+: inputs ( insns -- seq )
+    [ [ ##phi? not ] filter gen-set ] [ kill-set ] bi assoc-diff keys ;
+
+: init-alias-analysis ( insns -- insns' )
     H{ } clone histories set
     H{ } clone vregs>acs set
     H{ } clone acs>vregs set
@@ -208,7 +210,7 @@ M: ##alien-global insn-object drop \ ##alien-global ;
     0 ac-counter set
     next-ac heap-ac set
 
-    [ set-heap-ac ] each ;
+    dup inputs [ set-heap-ac ] each ;
 
 GENERIC: analyze-aliases* ( insn -- insn' )
 
@@ -280,9 +282,10 @@ M: insn eliminate-dead-stores* ;
     [ insn# set eliminate-dead-stores* ] map-index sift ;
 
 : alias-analysis-step ( insns -- insns' )
+    init-alias-analysis
     analyze-aliases
     compute-live-stores
     eliminate-dead-stores ;
 
 : alias-analysis ( cfg -- cfg' )
-    [ init-alias-analysis ] [ alias-analysis-step ] local-optimization ;
\ No newline at end of file
+    [ alias-analysis-step ] local-optimization ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor
index 49ea775600..2f8077be99 100644
--- a/basis/compiler/cfg/checker/checker.factor
+++ b/basis/compiler/cfg/checker/checker.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel compiler.cfg.instructions compiler.cfg.rpo
-compiler.cfg.def-use compiler.cfg.linearization compiler.cfg.liveness
+compiler.cfg.def-use compiler.cfg.linearization
 combinators.short-circuit accessors math sequences sets assocs ;
 IN: compiler.cfg.checker
 
@@ -54,8 +54,6 @@ ERROR: undefined-values uses defs ;
     2dup subset? [ 2drop ] [ undefined-values ] if ;
 
 : check-cfg ( cfg -- )
-    compute-liveness
-    [ entry>> live-in assoc-empty? [ bad-live-in ] unless ]
     [ [ check-basic-block ] each-basic-block ]
     [ flatten-cfg check-mr ]
-    tri ;
+    bi ;
diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
index 975adfa6cb..c38f43da8a 100644
--- a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
+++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
@@ -20,7 +20,7 @@ MIXIN: dataflow-analysis
 
 GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
 
-M: kill-block compute-in-set 3drop f ;
+! M: kill-block compute-in-set 3drop f ;
 
 M:: basic-block compute-in-set ( bb out-sets dfa -- set )
     bb dfa predecessors [ out-sets at ] map dfa join-sets ;
@@ -31,7 +31,7 @@ M:: basic-block compute-in-set ( bb out-sets dfa -- set )
 
 GENERIC# compute-out-set 2 ( bb out-sets dfa -- set )
 
-M: kill-block compute-out-set 3drop f ;
+! M: kill-block compute-out-set 3drop f ;
 
 M:: basic-block compute-out-set ( bb in-sets dfa -- set )
     bb in-sets at bb dfa transfer-set ;
diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index e355ee2ac1..18f1b3be76 100644
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -7,7 +7,7 @@ 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.liveness compiler.cfg.optimizer
+compiler.cfg.optimizer
 compiler.cfg.mr compiler.cfg ;
 IN: compiler.cfg.debugger
 
diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor
index c8a9d1861b..d7bfc56b32 100644
--- a/basis/compiler/cfg/def-use/def-use.factor
+++ b/basis/compiler/cfg/def-use/def-use.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel assocs compiler.cfg.instructions ;
+USING: accessors arrays kernel assocs sequences
+sets compiler.cfg.instructions ;
 IN: compiler.cfg.def-use
 
 GENERIC: defs-vregs ( insn -- seq )
@@ -62,3 +63,12 @@ UNION: vreg-insn
 _conditional-branch
 _compare-imm-branch
 _dispatch ;
+
+: map-unique ( seq quot -- assoc )
+    map concat unique ; inline
+
+: gen-set ( instructions -- seq )
+    [ uses-vregs ] map-unique ;
+
+: kill-set ( instructions -- seq )
+    [ defs-vregs ] map-unique ;
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 98deca9472..952feb5919 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -4,14 +4,15 @@ USING: accessors kernel math assocs namespaces sequences heaps
 fry make combinators sets locals
 cpu.architecture
 compiler.cfg
+compiler.cfg.rpo
 compiler.cfg.def-use
-compiler.cfg.liveness
 compiler.cfg.registers
 compiler.cfg.instructions
 compiler.cfg.linear-scan.mapping
 compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals ;
+compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.liveness ;
 IN: compiler.cfg.linear-scan.assignment
 
 ! This contains both active and inactive intervals; any interval
@@ -185,6 +186,6 @@ ERROR: bad-vreg vreg ;
         ] V{ } make
     ] change-instructions drop ;
 
-: assign-registers ( live-intervals rpo -- )
+: assign-registers ( live-intervals cfg -- )
     [ init-assignment ] dip
-    [ assign-registers-in-block ] each ;
+    [ assign-registers-in-block ] each-basic-block ;
diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index df521c1988..7362d185b4 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@@ -7,7 +7,6 @@ compiler.cfg
 compiler.cfg.optimizer
 compiler.cfg.instructions
 compiler.cfg.registers
-compiler.cfg.liveness
 compiler.cfg.predecessors
 compiler.cfg.rpo
 compiler.cfg.linearization
@@ -1507,9 +1506,7 @@ SYMBOL: linear-scan-result
     [
         cfg new 0 get >>entry
         compute-predecessors
-        compute-liveness
-        dup reverse-post-order
-        { { int-regs regs } } (linear-scan)
+        dup { { int-regs regs } } (linear-scan)
         cfg-changed
         flatten-cfg 1array mr.
     ] with-scope ;
@@ -2331,9 +2328,6 @@ test-diamond
 ! early in bootstrap on x86-32
 [ t ] [
     [
-        H{ } clone live-ins set
-        H{ } clone live-outs set
-        H{ } clone phi-live-ins set
         T{ basic-block
            { id 12345 }
            { instructions
@@ -2353,7 +2347,8 @@ test-diamond
                  T{ ##replace f V int-regs 5 D 0 }
              }
            }
-        } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan)
+        } cfg new over >>entry
+        { { int-regs V{ 0 1 2 3 } } } (linear-scan)
         instructions>> first
         live-values>> assoc-empty?
     ] with-scope
diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index c17aa23e83..186a773355 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan.factor
@@ -6,6 +6,7 @@ compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.instructions
 compiler.cfg.linear-scan.numbering
+compiler.cfg.linear-scan.liveness
 compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.allocation.state
@@ -28,17 +29,18 @@ IN: compiler.cfg.linear-scan
 ! by Omri Traub, Glenn Holloway, Michael D. Smith
 ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435
 
-:: (linear-scan) ( rpo machine-registers -- )
-    rpo number-instructions
-    rpo compute-live-intervals machine-registers allocate-registers
-    rpo assign-registers
-    rpo resolve-data-flow
-    rpo check-numbering ;
+:: (linear-scan) ( cfg machine-registers -- )
+    cfg compute-live-sets
+    cfg number-instructions
+    cfg compute-live-intervals machine-registers allocate-registers
+    cfg assign-registers
+    cfg resolve-data-flow
+    cfg check-numbering ;
 
 : linear-scan ( cfg -- cfg' )
     [
         init-mapping
-        dup reverse-post-order machine-registers (linear-scan)
+        dup machine-registers (linear-scan)
         spill-counts get >>spill-counts
         cfg-changed
     ] with-scope ;
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 68a780d42a..244f2bc069 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel assocs accessors sequences math math.order fry
 combinators binary-search compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ;
+compiler.cfg.def-use compiler.cfg.linear-scan.liveness compiler.cfg.rpo
+compiler.cfg ;
 IN: compiler.cfg.linear-scan.live-intervals
 
 TUPLE: live-range from to ;
@@ -144,10 +145,10 @@ ERROR: bad-live-interval live-interval ;
         } cleave
     ] each ;
 
-: compute-live-intervals ( rpo -- live-intervals )
+: compute-live-intervals ( cfg -- live-intervals )
     H{ } clone [
         live-intervals set
-        <reversed> [ compute-live-intervals-step ] each
+        post-order [ compute-live-intervals-step ] each
     ] keep values dup finish-live-intervals ;
 
 : relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
diff --git a/basis/compiler/cfg/linear-scan/liveness/liveness.factor b/basis/compiler/cfg/linear-scan/liveness/liveness.factor
new file mode 100644
index 0000000000..ac36fca9c7
--- /dev/null
+++ b/basis/compiler/cfg/linear-scan/liveness/liveness.factor
@@ -0,0 +1,17 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors assocs compiler.cfg.def-use
+compiler.cfg.dataflow-analysis ;
+IN: compiler.cfg.linear-scan.liveness
+
+! See http://en.wikipedia.org/wiki/Liveness_analysis
+
+BACKWARD-ANALYSIS: live
+
+M: live-analysis transfer-set
+    drop instructions>>
+    [ gen-set assoc-union ] keep
+    kill-set assoc-diff ;
+
+M: live-analysis join-sets
+    drop assoc-combine ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/numbering/numbering.factor b/basis/compiler/cfg/linear-scan/numbering/numbering.factor
index ac18b0cb2e..2976680857 100644
--- a/basis/compiler/cfg/linear-scan/numbering/numbering.factor
+++ b/basis/compiler/cfg/linear-scan/numbering/numbering.factor
@@ -1,6 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors math sequences grouping namespaces ;
+USING: kernel accessors math sequences grouping namespaces
+compiler.cfg.rpo ;
 IN: compiler.cfg.linear-scan.numbering
 
 : number-instructions ( rpo -- )
@@ -8,7 +9,7 @@ IN: compiler.cfg.linear-scan.numbering
         instructions>> [
             [ (>>insn#) ] [ drop 2 + ] 2bi
         ] each
-    ] each drop ;
+    ] each-basic-block drop ;
 
 SYMBOL: check-numbering?
 
@@ -18,5 +19,5 @@ ERROR: bad-numbering bb ;
     dup instructions>> [ insn#>> ] map sift [ <= ] monotonic?
     [ drop ] [ bad-numbering ] if ;
 
-: check-numbering ( rpo -- )
-    check-numbering? get [ [ check-block-numbering ] each ] [ drop ] if ;
\ No newline at end of file
+: check-numbering ( cfg -- )
+    check-numbering? get [ [ check-block-numbering ] each-basic-block ] [ drop ] if ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index f7ed994f18..5bab261ea8 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -3,10 +3,12 @@
 USING: accessors arrays assocs combinators
 combinators.short-circuit fry kernel locals
 make math sequences
+compiler.cfg.rpo
 compiler.cfg.utilities
 compiler.cfg.instructions
 compiler.cfg.linear-scan.assignment
-compiler.cfg.linear-scan.mapping compiler.cfg.liveness ;
+compiler.cfg.linear-scan.mapping
+compiler.cfg.linear-scan.liveness ;
 IN: compiler.cfg.linear-scan.resolve
 
 : add-mapping ( from to reg-class -- )
@@ -43,5 +45,5 @@ IN: compiler.cfg.linear-scan.resolve
 : resolve-block-data-flow ( bb -- )
     dup successors>> [ resolve-edge-data-flow ] with each ;
 
-: resolve-data-flow ( rpo -- )
-    [ resolve-block-data-flow ] each ;
+: resolve-data-flow ( cfg -- )
+    [ resolve-block-data-flow ] each-basic-block ;
diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 9faa1e9e38..c62d4b0208 100755
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -4,7 +4,6 @@ USING: kernel math accessors sequences namespaces make
 combinators assocs arrays locals cpu.architecture
 compiler.cfg
 compiler.cfg.rpo
-compiler.cfg.liveness
 compiler.cfg.comparisons
 compiler.cfg.stack-frame
 compiler.cfg.instructions ;
diff --git a/basis/compiler/cfg/liveness/authors.txt b/basis/compiler/cfg/liveness/authors.txt
deleted file mode 100644
index d4f5d6b3ae..0000000000
--- a/basis/compiler/cfg/liveness/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov
\ No newline at end of file
diff --git a/basis/compiler/cfg/liveness/liveness-tests.factor b/basis/compiler/cfg/liveness/liveness-tests.factor
deleted file mode 100644
index 271dc60d76..0000000000
--- a/basis/compiler/cfg/liveness/liveness-tests.factor
+++ /dev/null
@@ -1,15 +0,0 @@
-USING: compiler.cfg compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.liveness accessors tools.test cpu.architecture ;
-IN: compiler.cfg.liveness.tests
-
-[
-    H{
-        { "A" H{ { V int-regs 1 V int-regs 1 } { V int-regs 4 V int-regs 4 } } }
-        { "B" H{ { V int-regs 3 V int-regs 3 } { V int-regs 2 V int-regs 2 } } }
-    }
-] [
-    <basic-block> V{
-        T{ ##phi f V int-regs 0 { { "A" V int-regs 1 } { "B" V int-regs 2 } } }
-        T{ ##phi f V int-regs 1 { { "B" V int-regs 3 } { "A" V int-regs 4 } } }
-    } >>instructions compute-phi-live-in
-] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor
deleted file mode 100644
index 9dc320660c..0000000000
--- a/basis/compiler/cfg/liveness/liveness.factor
+++ /dev/null
@@ -1,79 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! 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 ;
-IN: compiler.cfg.liveness
-
-! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis
-
-! Assoc mapping basic blocks to sets of vregs
-SYMBOL: live-ins
-
-: live-in ( basic-block -- set ) live-ins get at ;
-
-! Assoc mapping basic blocks to sequences of sets of vregs; each sequence
-! is in conrrespondence with a predecessor
-SYMBOL: phi-live-ins
-
-: phi-live-in ( predecessor basic-block -- set ) phi-live-ins get at at ;
-
-! Assoc mapping basic blocks to sets of vregs
-SYMBOL: live-outs
-
-: live-out ( basic-block -- set ) live-outs get at ;
-
-SYMBOL: work-list
-
-: add-to-work-list ( basic-blocks -- )
-    work-list get '[ _ push-front ] each ;
-
-: map-unique ( seq quot -- assoc )
-    map concat unique ; inline
-
-: gen-set ( instructions -- seq )
-    [ ##phi? not ] filter [ uses-vregs ] map-unique ;
-
-: kill-set ( instructions -- seq )
-    [ [ defs-vregs ] [ temp-vregs ] bi append ] map-unique ;
-
-: compute-live-in ( basic-block -- live-in )
-    dup instructions>>
-    [ [ live-out ] [ gen-set ] bi* assoc-union ]
-    [ nip kill-set ]
-    2bi assoc-diff ;
-
-: 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 ;
-
-: update-live-in ( basic-block -- changed? )
-    [ [ compute-live-in ] keep live-ins get maybe-set-at ]
-    [ [ compute-phi-live-in ] keep phi-live-ins get maybe-set-at ]
-    bi and ; 
-
-: compute-live-out ( basic-block -- live-out )
-    [ successors>> [ live-in ] map ]
-    [ dup successors>> [ phi-live-in ] with map ] bi
-    append assoc-combine ;
-
-: update-live-out ( basic-block -- changed? )
-    [ compute-live-out ] keep
-    live-outs get maybe-set-at ;
-
-: liveness-step ( basic-block -- )
-    dup update-live-out [
-        dup update-live-in
-        [ predecessors>> add-to-work-list ] [ drop ] if
-    ] [ drop ] if ;
-
-: compute-liveness ( cfg -- cfg' )
-    <hashed-dlist> work-list set
-    H{ } clone live-ins set
-    H{ } clone phi-live-ins set
-    H{ } clone live-outs set
-    dup post-order add-to-work-list
-    work-list get [ liveness-step ] slurp-deque ;
diff --git a/basis/compiler/cfg/local/authors.txt b/basis/compiler/cfg/local/authors.txt
deleted file mode 100644
index d4f5d6b3ae..0000000000
--- a/basis/compiler/cfg/local/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Slava Pestov
\ No newline at end of file
diff --git a/basis/compiler/cfg/local/local.factor b/basis/compiler/cfg/local/local.factor
deleted file mode 100644
index 2f5f5b18e3..0000000000
--- a/basis/compiler/cfg/local/local.factor
+++ /dev/null
@@ -1,14 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: locals accessors kernel assocs namespaces
-compiler.cfg compiler.cfg.liveness compiler.cfg.rpo ;
-IN: compiler.cfg.local
-
-:: optimize-basic-block ( bb init-quot insn-quot -- )
-    bb basic-block set
-    bb live-in keys init-quot call
-    bb insn-quot change-instructions drop ; inline
-
-:: local-optimization ( cfg init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- cfg' )
-    cfg [ init-quot insn-quot optimize-basic-block ] each-basic-block
-    cfg ; inline
\ No newline at end of file
diff --git a/basis/compiler/cfg/mr/mr.factor b/basis/compiler/cfg/mr/mr.factor
index 9f6a62090c..cb198d5149 100644
--- a/basis/compiler/cfg/mr/mr.factor
+++ b/basis/compiler/cfg/mr/mr.factor
@@ -1,13 +1,12 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler.cfg.linearization compiler.cfg.two-operand
-compiler.cfg.liveness compiler.cfg.gc-checks compiler.cfg.linear-scan
+compiler.cfg.gc-checks compiler.cfg.linear-scan
 compiler.cfg.build-stack-frame compiler.cfg.rpo ;
 IN: compiler.cfg.mr
 
 : build-mr ( cfg -- mr )
     convert-two-operand
-    compute-liveness
     insert-gc-checks
     linear-scan
     flatten-cfg
diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index 1af0fcbc53..50148b73b2 100644
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/basis/compiler/cfg/optimizer/optimizer.factor
@@ -11,7 +11,6 @@ compiler.cfg.alias-analysis
 compiler.cfg.value-numbering
 compiler.cfg.dce
 compiler.cfg.write-barrier
-compiler.cfg.liveness
 compiler.cfg.rpo
 compiler.cfg.phi-elimination
 compiler.cfg.checker ;
@@ -35,7 +34,6 @@ SYMBOL: check-optimizer?
         join-blocks
         compute-predecessors
         stack-analysis
-        compute-liveness
         alias-analysis
         value-numbering
         compute-predecessors
diff --git a/basis/compiler/cfg/renaming/renaming.factor b/basis/compiler/cfg/renaming/renaming.factor
index 8dbcadfe8b..a2204fb36e 100644
--- a/basis/compiler/cfg/renaming/renaming.factor
+++ b/basis/compiler/cfg/renaming/renaming.factor
@@ -6,7 +6,7 @@ IN: compiler.cfg.renaming
 
 SYMBOL: renamings
 
-: rename-value ( vreg -- vreg' ) renamings get at ;
+: rename-value ( vreg -- vreg' ) renamings get ?at drop ;
 
 GENERIC: rename-insn-defs ( insn -- )
 
diff --git a/basis/compiler/cfg/rpo/rpo.factor b/basis/compiler/cfg/rpo/rpo.factor
index f6a40e17d0..1ddacdf8ab 100644
--- a/basis/compiler/cfg/rpo/rpo.factor
+++ b/basis/compiler/cfg/rpo/rpo.factor
@@ -33,3 +33,10 @@ SYMBOL: visited
 
 : each-basic-block ( cfg quot -- )
     [ reverse-post-order ] dip each ; inline
+
+: optimize-basic-block ( bb quot -- )
+    [ drop basic-block set ]
+    [ change-instructions drop ] 2bi ; inline
+
+: local-optimization ( cfg quot: ( insns -- insns' ) -- cfg' )
+    dupd '[ _ optimize-basic-block ] each-basic-block ; inline
\ No newline at end of file
diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor
index 87be509c6f..0a52aa7c1a 100644
--- a/basis/compiler/cfg/two-operand/two-operand.factor
+++ b/basis/compiler/cfg/two-operand/two-operand.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences make compiler.cfg.instructions
-compiler.cfg.local cpu.architecture ;
+compiler.cfg.rpo cpu.architecture ;
 IN: compiler.cfg.two-operand
 
 ! On x86, instructions take the form x = x op y
@@ -54,7 +54,6 @@ M: insn convert-two-operand* , ;
 
 : convert-two-operand ( cfg -- cfg' )
     two-operand? [
-        [ drop ]
         [ [ [ convert-two-operand* ] each ] V{ } make ]
         local-optimization
     ] when ;
diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
index 76ad3d892f..87fa959178 100644
--- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor
+++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor
@@ -6,7 +6,6 @@ compiler.cfg.value-numbering.graph ;
 IN: compiler.cfg.value-numbering.expressions
 
 ! Referentially-transparent expressions
-TUPLE: expr op ;
 TUPLE: unary-expr < expr in ;
 TUPLE: binary-expr < expr in1 in2 ;
 TUPLE: commutative-expr < binary-expr ;
@@ -37,17 +36,6 @@ M: reference-expr equal?
         } cond
     ] [ 2drop f ] if ;
 
-! Expressions whose values are inputs to the basic block. We
-! can eliminate a second computation having the same 'n' as
-! the first one; we can also eliminate input-exprs whose
-! result is not used.
-TUPLE: input-expr < expr n ;
-
-SYMBOL: input-expr-counter
-
-: next-input-expr ( class -- expr )
-    input-expr-counter [ dup 1 + ] change input-expr boa ;
-
 : constant>vn ( constant -- vn ) <constant> expr>vn ; inline
 
 GENERIC: >expr ( insn -- expr )
@@ -97,7 +85,7 @@ M: ##compare-imm >expr compare-imm>expr ;
 
 M: ##compare-float >expr compare>expr ;
 
-M: ##flushable >expr class next-input-expr ;
+M: ##flushable >expr drop next-input-expr ;
 
 : init-expressions ( -- )
     0 input-expr-counter set ;
diff --git a/basis/compiler/cfg/value-numbering/graph/graph.factor b/basis/compiler/cfg/value-numbering/graph/graph.factor
index 41e7201953..77b75bd3ac 100644
--- a/basis/compiler/cfg/value-numbering/graph/graph.factor
+++ b/basis/compiler/cfg/value-numbering/graph/graph.factor
@@ -10,13 +10,24 @@ SYMBOL: vn-counter
 ! biassoc mapping expressions to value numbers
 SYMBOL: exprs>vns
 
+TUPLE: expr op ;
+
 : expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ;
 
 : vn>expr ( vn -- expr ) exprs>vns get value-at ;
 
+! Expressions whose values are inputs to the basic block.
+TUPLE: input-expr < expr n ;
+
+SYMBOL: input-expr-counter
+
+: next-input-expr ( -- expr )
+    f input-expr-counter counter input-expr boa ;
+
 SYMBOL: vregs>vns
 
-: vreg>vn ( vreg -- vn ) vregs>vns get at ;
+: vreg>vn ( vreg -- vn )
+    vregs>vns get [ drop next-input-expr expr>vn ] cache ;
 
 : vn>vreg ( vn -- vreg ) vregs>vns get value-at ;
 
diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
index bd2bb692b7..9063947ae1 100644
--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
@@ -3,7 +3,7 @@ USING: compiler.cfg.value-numbering compiler.cfg.instructions
 compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons
 cpu.architecture tools.test kernel math combinators.short-circuit
 accessors sequences compiler.cfg.predecessors locals
-compiler.cfg.phi-elimination compiler.cfg.dce compiler.cfg.liveness
+compiler.cfg.phi-elimination compiler.cfg.dce
 compiler.cfg assocs vectors arrays layouts namespaces ;
 
 : trim-temps ( insns -- insns )
@@ -15,10 +15,6 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         } 1|| [ f >>temp ] when
     ] map ;
 
-: test-value-numbering ( insns -- insns )
-    { } init-value-numbering
-    value-numbering-step ;
-
 ! Folding constants together
 [
     {
@@ -33,7 +29,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-reference f V int-regs 1 -0.0 }
         T{ ##replace f V int-regs 0 D 0 }
         T{ ##replace f V int-regs 1 D 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -49,7 +45,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-reference f V int-regs 1 0.0 }
         T{ ##replace f V int-regs 0 D 0 }
         T{ ##replace f V int-regs 1 D 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -65,7 +61,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-reference f V int-regs 1 t }
         T{ ##replace f V int-regs 0 D 0 }
         T{ ##replace f V int-regs 1 D 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 ! Copy propagation
@@ -80,7 +76,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 45 D 1 }
         T{ ##copy f V int-regs 48 V int-regs 45 }
         T{ ##compare-imm-branch f V int-regs 48 7 cc/= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 ! Compare propagation
@@ -99,7 +95,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
         T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc/= }
         T{ ##replace f V int-regs 6 D 0 }
-    } test-value-numbering trim-temps
+    } value-numbering-step trim-temps
 ] unit-test
 
 [
@@ -117,7 +113,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
         T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc= }
         T{ ##replace f V int-regs 6 D 0 }
-    } test-value-numbering trim-temps
+    } value-numbering-step trim-temps
 ] unit-test
 
 [
@@ -139,7 +135,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< }
         T{ ##compare-imm f V int-regs 14 V int-regs 12 5 cc= }
         T{ ##replace f V int-regs 14 D 0 }
-    } test-value-numbering trim-temps
+    } value-numbering-step trim-temps
 ] unit-test
 
 [
@@ -155,7 +151,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 30 D -2 }
         T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= }
         T{ ##compare-imm-branch f V int-regs 33 5 cc/= }
-    } test-value-numbering trim-temps
+    } value-numbering-step trim-temps
 ] unit-test
 
 ! Immediate operand conversion
@@ -170,7 +166,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##add f V int-regs 2 V int-regs 0 V int-regs 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -184,7 +180,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##add f V int-regs 2 V int-regs 1 V int-regs 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -198,7 +194,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##sub f V int-regs 2 V int-regs 0 V int-regs 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -210,7 +206,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
     {
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##sub f V int-regs 1 V int-regs 0 V int-regs 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -224,7 +220,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##mul f V int-regs 2 V int-regs 0 V int-regs 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -238,7 +234,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##mul f V int-regs 2 V int-regs 1 V int-regs 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -250,7 +246,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
     {
         T{ ##peek f V int-regs 1 D 0 }
         T{ ##mul-imm f V int-regs 2 V int-regs 1 8 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -264,7 +260,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##and f V int-regs 2 V int-regs 0 V int-regs 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -278,7 +274,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##and f V int-regs 2 V int-regs 1 V int-regs 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -292,7 +288,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##or f V int-regs 2 V int-regs 0 V int-regs 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -306,7 +302,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##or f V int-regs 2 V int-regs 1 V int-regs 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -320,7 +316,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##xor f V int-regs 2 V int-regs 0 V int-regs 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -334,7 +330,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##xor f V int-regs 2 V int-regs 1 V int-regs 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -348,7 +344,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##compare f V int-regs 2 V int-regs 0 V int-regs 1 cc<= }
-    } test-value-numbering trim-temps
+    } value-numbering-step trim-temps
 ] unit-test
 
 [
@@ -362,7 +358,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##compare f V int-regs 2 V int-regs 1 V int-regs 0 cc<= }
-    } test-value-numbering trim-temps
+    } value-numbering-step trim-temps
 ] unit-test
 
 [
@@ -376,7 +372,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##compare-branch f V int-regs 0 V int-regs 1 cc<= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -390,7 +386,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 100 }
         T{ ##compare-branch f V int-regs 1 V int-regs 0 cc<= }
-    } test-value-numbering trim-temps
+    } value-numbering-step trim-temps
 ] unit-test
 
 ! Reassociation
@@ -409,7 +405,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##add f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##add f V int-regs 4 V int-regs 2 V int-regs 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -427,7 +423,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##add f V int-regs 2 V int-regs 1 V int-regs 0 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##add f V int-regs 4 V int-regs 3 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -445,7 +441,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##add f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##sub f V int-regs 4 V int-regs 2 V int-regs 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -463,7 +459,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##sub f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##sub f V int-regs 4 V int-regs 2 V int-regs 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -481,7 +477,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##mul f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##mul f V int-regs 4 V int-regs 2 V int-regs 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -499,7 +495,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##mul f V int-regs 2 V int-regs 1 V int-regs 0 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##mul f V int-regs 4 V int-regs 3 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -517,7 +513,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##and f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##and f V int-regs 4 V int-regs 2 V int-regs 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -535,7 +531,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##and f V int-regs 2 V int-regs 1 V int-regs 0 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##and f V int-regs 4 V int-regs 3 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -553,7 +549,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##or f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##or f V int-regs 4 V int-regs 2 V int-regs 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -571,7 +567,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##or f V int-regs 2 V int-regs 1 V int-regs 0 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##or f V int-regs 4 V int-regs 3 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -589,7 +585,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##xor f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##xor f V int-regs 4 V int-regs 2 V int-regs 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -607,7 +603,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##xor f V int-regs 2 V int-regs 1 V int-regs 0 }
         T{ ##load-immediate f V int-regs 3 50 }
         T{ ##xor f V int-regs 4 V int-regs 3 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 ! Simplification
@@ -626,7 +622,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 }
         T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
         T{ ##replace f V int-regs 3 D 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -644,7 +640,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 }
         T{ ##sub f V int-regs 3 V int-regs 0 V int-regs 2 }
         T{ ##replace f V int-regs 3 D 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -662,7 +658,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 }
         T{ ##or f V int-regs 3 V int-regs 0 V int-regs 2 }
         T{ ##replace f V int-regs 3 D 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -680,7 +676,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 }
         T{ ##xor f V int-regs 3 V int-regs 0 V int-regs 2 }
         T{ ##replace f V int-regs 3 D 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -696,7 +692,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##mul f V int-regs 2 V int-regs 0 V int-regs 1 }
         T{ ##replace f V int-regs 2 D 0 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 ! Constant folding
@@ -713,7 +709,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##load-immediate f V int-regs 2 3 }
         T{ ##add f V int-regs 3 V int-regs 1 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -729,7 +725,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##load-immediate f V int-regs 2 3 }
         T{ ##sub f V int-regs 3 V int-regs 1 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -745,7 +741,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-immediate f V int-regs 1 2 }
         T{ ##load-immediate f V int-regs 2 3 }
         T{ ##mul f V int-regs 3 V int-regs 1 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -761,7 +757,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-immediate f V int-regs 1 2 }
         T{ ##load-immediate f V int-regs 2 1 }
         T{ ##and f V int-regs 3 V int-regs 1 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -777,7 +773,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-immediate f V int-regs 1 2 }
         T{ ##load-immediate f V int-regs 2 1 }
         T{ ##or f V int-regs 3 V int-regs 1 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -793,7 +789,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##load-immediate f V int-regs 1 2 }
         T{ ##load-immediate f V int-regs 2 3 }
         T{ ##xor f V int-regs 3 V int-regs 1 V int-regs 2 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -807,7 +803,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ;
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##shl-imm f V int-regs 3 V int-regs 1 3 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 cell 8 = [
@@ -822,7 +818,7 @@ cell 8 = [
             T{ ##peek f V int-regs 0 D 0 }
             T{ ##load-immediate f V int-regs 1 -1 }
             T{ ##shr-imm f V int-regs 3 V int-regs 1 16 }
-        } test-value-numbering
+        } value-numbering-step
     ] unit-test
 ] when
 
@@ -837,7 +833,7 @@ cell 8 = [
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##load-immediate f V int-regs 1 -8 }
         T{ ##sar-imm f V int-regs 3 V int-regs 1 1 }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 cell 8 = [
@@ -854,7 +850,7 @@ cell 8 = [
             T{ ##load-immediate f V int-regs 1 65536 }
             T{ ##shl-imm f V int-regs 2 V int-regs 1 31 }
             T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
-        } test-value-numbering
+        } value-numbering-step
     ] unit-test
 
     [
@@ -868,7 +864,7 @@ cell 8 = [
             T{ ##peek f V int-regs 0 D 0 }
             T{ ##load-immediate f V int-regs 2 140737488355328 }
             T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
-        } test-value-numbering
+        } value-numbering-step
     ] unit-test
 
     [
@@ -884,7 +880,7 @@ cell 8 = [
             T{ ##load-immediate f V int-regs 2 2147483647 }
             T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 }
             T{ ##add f V int-regs 4 V int-regs 3 V int-regs 2 }
-        } test-value-numbering
+        } value-numbering-step
     ] unit-test
 ] when
 
@@ -900,7 +896,7 @@ cell 8 = [
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##load-immediate f V int-regs 2 2 }
         T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -914,7 +910,7 @@ cell 8 = [
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##load-immediate f V int-regs 2 2 }
         T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc/= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -928,7 +924,7 @@ cell 8 = [
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##load-immediate f V int-regs 2 2 }
         T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc< }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -942,7 +938,7 @@ cell 8 = [
         T{ ##load-immediate f V int-regs 1 1 }
         T{ ##load-immediate f V int-regs 2 2 }
         T{ ##compare f V int-regs 3 V int-regs 2 V int-regs 1 cc< }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -954,7 +950,7 @@ cell 8 = [
     {
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc< }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -966,7 +962,7 @@ cell 8 = [
     {
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc<= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -978,7 +974,7 @@ cell 8 = [
     {
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc> }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -990,7 +986,7 @@ cell 8 = [
     {
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc>= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -1002,7 +998,7 @@ cell 8 = [
     {
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc/= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 [
@@ -1014,12 +1010,12 @@ cell 8 = [
     {
         T{ ##peek f V int-regs 0 D 0 }
         T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc= }
-    } test-value-numbering
+    } value-numbering-step
 ] unit-test
 
 : test-branch-folding ( insns -- insns' n )
     <basic-block>
-    [ V{ 0 1 } clone >>successors basic-block set test-value-numbering ] keep
+    [ V{ 0 1 } clone >>successors basic-block set value-numbering-step ] keep
     successors>> first ;
 
 [
@@ -1208,7 +1204,6 @@ test-diamond
 
 [ ] [
     cfg new 0 get >>entry
-    compute-liveness
     value-numbering
     compute-predecessors
     eliminate-phis drop
@@ -1253,7 +1248,6 @@ test-diamond
 [ ] [
     cfg new 0 get >>entry
     compute-predecessors
-    compute-liveness
     value-numbering
     compute-predecessors
     eliminate-dead-code
@@ -1324,7 +1318,7 @@ V{
 
 [ ] [
     cfg new 0 get >>entry
-    compute-liveness value-numbering eliminate-dead-code drop
+    value-numbering eliminate-dead-code drop
 ] unit-test
 
 [ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test
diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor
index e49555e06e..0c9616b4e5 100644
--- a/basis/compiler/cfg/value-numbering/value-numbering.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering.factor
@@ -3,8 +3,7 @@
 USING: namespaces assocs biassocs classes kernel math accessors
 sorting sets sequences fry
 compiler.cfg
-compiler.cfg.local
-compiler.cfg.liveness
+compiler.cfg.rpo
 compiler.cfg.renaming
 compiler.cfg.value-numbering.graph
 compiler.cfg.value-numbering.expressions
@@ -13,15 +12,6 @@ compiler.cfg.value-numbering.rewrite ;
 IN: compiler.cfg.value-numbering
 
 ! Local value numbering. Predecessors must be recomputed after this
-
-: number-input-values ( live-in -- )
-    [ [ f next-input-expr simplify ] dip set-vn ] each ;
-
-: init-value-numbering ( live-in -- )
-    init-value-graph
-    init-expressions
-    number-input-values ;
-
 : vreg>vreg-mapping ( -- assoc )
     vregs>vns get [ keys ] keep
     '[ dup _ [ at ] [ value-at ] bi ] H{ } map>assoc ;
@@ -32,8 +22,10 @@ IN: compiler.cfg.value-numbering
     ] with-variable ;
 
 : value-numbering-step ( insns -- insns' )
-    [ rewrite ] map dup rename-uses ;
+    init-value-graph
+    init-expressions
+    [ rewrite ] map
+    dup rename-uses ;
 
 : value-numbering ( cfg -- cfg' )
-    [ init-value-numbering ] [ value-numbering-step ] local-optimization
-    cfg-changed ;
+    [ value-numbering-step ] local-optimization cfg-changed ;
diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor
index b260b0464e..bcec542501 100644
--- a/basis/compiler/cfg/write-barrier/write-barrier.factor
+++ b/basis/compiler/cfg/write-barrier/write-barrier.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors namespaces assocs sets sequences locals
 compiler.cfg compiler.cfg.instructions compiler.cfg.copy-prop
-compiler.cfg.liveness compiler.cfg.local ;
+compiler.cfg.rpo ;
 IN: compiler.cfg.write-barrier
 
 ! Eliminate redundant write barrier hits.
@@ -43,4 +43,4 @@ M: insn eliminate-write-barrier ;
     [ eliminate-write-barrier ] map sift ;
 
 : eliminate-write-barriers ( cfg -- cfg' )
-    [ drop ] [ write-barriers-step ] local-optimization ;
+    [ write-barriers-step ] local-optimization ;

From 89db2e745d08f2c51a0df07dafbcf8ea774b7eeb Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 06:07:28 -0500
Subject: [PATCH 15/19] Move liveness back to compiler.cfg.liveness, fix a
 corner-case where it didn't work on some forms of non-SSA code

---
 .../cfg/alias-analysis/alias-analysis.factor  |  7 +---
 .../linear-scan/assignment/assignment.factor  |  4 +-
 .../cfg/linear-scan/linear-scan.factor        |  2 +-
 .../live-intervals/live-intervals.factor      |  2 +-
 .../cfg/linear-scan/liveness/liveness.factor  | 17 ---------
 .../cfg/linear-scan/resolve/resolve.factor    |  4 +-
 .../cfg/liveness/liveness-tests.factor        | 38 +++++++++++++++++++
 basis/compiler/cfg/liveness/liveness.factor   | 26 +++++++++++++
 8 files changed, 72 insertions(+), 28 deletions(-)
 delete mode 100644 basis/compiler/cfg/linear-scan/liveness/liveness.factor
 create mode 100644 basis/compiler/cfg/liveness/liveness-tests.factor
 create mode 100644 basis/compiler/cfg/liveness/liveness.factor

diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
index 78e271c1f6..f6834c131d 100644
--- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
@@ -3,7 +3,7 @@
 USING: kernel math namespaces assocs hashtables sequences arrays
 accessors vectors combinators sets classes compiler.cfg
 compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.copy-prop compiler.cfg.rpo compiler.cfg.def-use ;
+compiler.cfg.copy-prop compiler.cfg.rpo compiler.cfg.liveness ;
 IN: compiler.cfg.alias-analysis
 
 ! We try to eliminate redundant slot operations using some simple heuristics.
@@ -196,9 +196,6 @@ M: ##set-slot insn-object obj>> resolve ;
 M: ##set-slot-imm insn-object obj>> resolve ;
 M: ##alien-global insn-object drop \ ##alien-global ;
 
-: inputs ( insns -- seq )
-    [ [ ##phi? not ] filter gen-set ] [ kill-set ] bi assoc-diff keys ;
-
 : init-alias-analysis ( insns -- insns' )
     H{ } clone histories set
     H{ } clone vregs>acs set
@@ -210,7 +207,7 @@ M: ##alien-global insn-object drop \ ##alien-global ;
     0 ac-counter set
     next-ac heap-ac set
 
-    dup inputs [ set-heap-ac ] each ;
+    dup local-live-in [ set-heap-ac ] each ;
 
 GENERIC: analyze-aliases* ( insn -- insn' )
 
diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
index 952feb5919..8e21e7e3fb 100644
--- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor
+++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor
@@ -6,13 +6,13 @@ cpu.architecture
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.def-use
+compiler.cfg.liveness
 compiler.cfg.registers
 compiler.cfg.instructions
 compiler.cfg.linear-scan.mapping
 compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals
-compiler.cfg.linear-scan.liveness ;
+compiler.cfg.linear-scan.live-intervals ;
 IN: compiler.cfg.linear-scan.assignment
 
 ! This contains both active and inactive intervals; any interval
diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index 186a773355..b081f2ca6e 100644
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan.factor
@@ -4,9 +4,9 @@ USING: kernel accessors namespaces make locals
 cpu.architecture
 compiler.cfg
 compiler.cfg.rpo
+compiler.cfg.liveness
 compiler.cfg.instructions
 compiler.cfg.linear-scan.numbering
-compiler.cfg.linear-scan.liveness
 compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.allocation.state
diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
index 244f2bc069..8813a4e94e 100644
--- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
+++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel assocs accessors sequences math math.order fry
 combinators binary-search compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.def-use compiler.cfg.linear-scan.liveness compiler.cfg.rpo
+compiler.cfg.def-use compiler.cfg.liveness compiler.cfg.rpo
 compiler.cfg ;
 IN: compiler.cfg.linear-scan.live-intervals
 
diff --git a/basis/compiler/cfg/linear-scan/liveness/liveness.factor b/basis/compiler/cfg/linear-scan/liveness/liveness.factor
deleted file mode 100644
index ac36fca9c7..0000000000
--- a/basis/compiler/cfg/linear-scan/liveness/liveness.factor
+++ /dev/null
@@ -1,17 +0,0 @@
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors assocs compiler.cfg.def-use
-compiler.cfg.dataflow-analysis ;
-IN: compiler.cfg.linear-scan.liveness
-
-! See http://en.wikipedia.org/wiki/Liveness_analysis
-
-BACKWARD-ANALYSIS: live
-
-M: live-analysis transfer-set
-    drop instructions>>
-    [ gen-set assoc-union ] keep
-    kill-set assoc-diff ;
-
-M: live-analysis join-sets
-    drop assoc-combine ;
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index 5bab261ea8..56beaa5379 100644
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -4,11 +4,11 @@ USING: accessors arrays assocs combinators
 combinators.short-circuit fry kernel locals
 make math sequences
 compiler.cfg.rpo
+compiler.cfg.liveness
 compiler.cfg.utilities
 compiler.cfg.instructions
 compiler.cfg.linear-scan.assignment
-compiler.cfg.linear-scan.mapping
-compiler.cfg.linear-scan.liveness ;
+compiler.cfg.linear-scan.mapping ;
 IN: compiler.cfg.linear-scan.resolve
 
 : add-mapping ( from to reg-class -- )
diff --git a/basis/compiler/cfg/liveness/liveness-tests.factor b/basis/compiler/cfg/liveness/liveness-tests.factor
new file mode 100644
index 0000000000..697a1f8a7b
--- /dev/null
+++ b/basis/compiler/cfg/liveness/liveness-tests.factor
@@ -0,0 +1,38 @@
+USING: compiler.cfg.liveness compiler.cfg.debugger
+compiler.cfg.instructions compiler.cfg.predecessors
+compiler.cfg.registers compiler.cfg cpu.architecture
+accessors namespaces sequences kernel tools.test ;
+IN: compiler.cfg.liveness.tests
+
+! Sanity check...
+
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##replace f V int-regs 0 D 0 }
+    T{ ##replace f V int-regs 1 D 1 }
+    T{ ##peek f V int-regs 1 D 1 }
+} 1 test-bb
+
+V{
+    T{ ##replace f V int-regs 2 D 0 }
+} 2 test-bb
+
+V{
+    T{ ##replace f V int-regs 3 D 0 }
+} 3 test-bb
+
+1 get 2 get 3 get V{ } 2sequence >>successors drop
+
+cfg new 1 get >>entry
+compute-predecessors
+compute-live-sets
+
+[
+    H{
+        { V int-regs 1 V int-regs 1 }
+        { V int-regs 2 V int-regs 2 }
+        { V int-regs 3 V int-regs 3 }
+    }
+]
+[ 1 get live-in ]
+unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor
new file mode 100644
index 0000000000..c1793842a2
--- /dev/null
+++ b/basis/compiler/cfg/liveness/liveness.factor
@@ -0,0 +1,26 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors assocs sequences sets
+compiler.cfg.def-use compiler.cfg.dataflow-analysis
+compiler.cfg.instructions ;
+IN: compiler.cfg.liveness
+
+! See http://en.wikipedia.org/wiki/Liveness_analysis
+! Do not run after SSA construction
+
+BACKWARD-ANALYSIS: live
+
+: transfer-liveness ( live-set instructions -- live-set' )
+    [ clone ] [ <reversed> ] bi* [
+        [ uses-vregs [ over conjoin ] each ]
+        [ defs-vregs [ over delete-at ] each ] bi
+    ] each ;
+
+: local-live-in ( instructions -- live-set )
+    [ ##phi? not ] filter [ H{ } ] dip transfer-liveness keys ;
+
+M: live-analysis transfer-set
+    drop instructions>> transfer-liveness ;
+
+M: live-analysis join-sets
+    drop assoc-combine ;
\ No newline at end of file

From d864214119f2ba18f862b094b4eedb2e29cb6a0c Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 06:07:51 -0500
Subject: [PATCH 16/19] compiler.cfg.dominance: add algorithm for computing
 iterated dominance frontiers

---
 .../cfg/dominance/dominance-tests.factor      | 22 +++++++++++++
 basis/compiler/cfg/dominance/dominance.factor | 31 ++++++++++++++++---
 2 files changed, 49 insertions(+), 4 deletions(-)

diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor
index 210d5614c2..d73871c25f 100644
--- a/basis/compiler/cfg/dominance/dominance-tests.factor
+++ b/basis/compiler/cfg/dominance/dominance-tests.factor
@@ -74,3 +74,25 @@ V{ } 5 test-bb
 [ ] [ test-dominance ] unit-test
 
 [ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test
+
+V{ } 0 test-bb
+V{ } 1 test-bb
+V{ } 2 test-bb
+V{ } 3 test-bb
+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
+
+[ ] [ test-dominance ] unit-test
+
+[ t ] [
+    2 get 3 get 2array iterated-dom-frontier
+    4 get 6 get 2array set=
+] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor
index 9c8fc79619..73d9f58eec 100644
--- a/basis/compiler/cfg/dominance/dominance.factor
+++ b/basis/compiler/cfg/dominance/dominance.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators sets math fry kernel math.order
-namespaces sequences sorting compiler.cfg.rpo ;
+dlists deques namespaces sequences sorting compiler.cfg.rpo ;
 IN: compiler.cfg.dominance
 
 ! Reference:
@@ -85,8 +85,31 @@ PRIVATE>
 
 PRIVATE>
 
-: compute-dominance ( cfg -- cfg' )
+: compute-dominance ( cfg -- )
     [ compute-dom-parents compute-dom-children ]
     [ compute-dom-frontiers ]
-    [ ]
-    tri ;
+    bi ;
+
+<PRIVATE
+
+SYMBOLS: work-list visited ;
+
+: add-to-work-list ( bb -- )
+    dom-frontier work-list get push-all-front ;
+
+: iterated-dom-frontier-step ( bb -- )
+    dup visited get key? [ drop ] [
+        [ visited get conjoin ]
+        [ add-to-work-list ] bi
+    ] if ;
+
+PRIVATE>
+
+: iterated-dom-frontier ( bbs -- bbs' )
+    [
+        <dlist> work-list set
+        H{ } clone visited set
+        [ add-to-work-list ] each
+        work-list get [ iterated-dom-frontier-step ] slurp-deque
+        visited get keys
+    ] with-scope ;
\ No newline at end of file

From 26a5d51d939ca21c10c1915d22a9ed1647df7314 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 06:08:04 -0500
Subject: [PATCH 17/19] compiler.cfg.ssa: now builds pruned SSA form

---
 basis/compiler/cfg/ssa/ssa-tests.factor | 44 +++++++++++++++---
 basis/compiler/cfg/ssa/ssa.factor       | 59 +++++++++----------------
 2 files changed, 61 insertions(+), 42 deletions(-)

diff --git a/basis/compiler/cfg/ssa/ssa-tests.factor b/basis/compiler/cfg/ssa/ssa-tests.factor
index c53d30af5d..6a3a014f78 100644
--- a/basis/compiler/cfg/ssa/ssa-tests.factor
+++ b/basis/compiler/cfg/ssa/ssa-tests.factor
@@ -5,9 +5,12 @@ compiler.cfg.registers cpu.architecture kernel namespaces sequences
 tools.test vectors ;
 IN: compiler.cfg.ssa.tests
 
-! Reset counters so that results are deterministic w.r.t. hash order
-0 vreg-counter set-global
-0 basic-block set-global
+: reset-counters ( -- )
+    ! Reset counters so that results are deterministic w.r.t. hash order
+    0 vreg-counter set-global
+    0 basic-block set-global ;
+
+reset-counters
 
 V{
     T{ ##load-immediate f V int-regs 1 100 }
@@ -38,7 +41,6 @@ V{
 : test-ssa ( -- )
     cfg new 0 get >>entry
     compute-predecessors
-    compute-dominance
     construct-ssa
     drop ;
 
@@ -67,6 +69,9 @@ V{
     }
 ] [ 2 get instructions>> ] unit-test
 
+: clean-up-phis ( insns -- insns' )
+    [ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map ;
+
 [
     V{
         T{ ##phi f V int-regs 6 H{ { 1 V int-regs 4 } { 2 V int-regs 5 } } }
@@ -75,5 +80,34 @@ V{
     }
 ] [
     3 get instructions>>
-    [ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map
+    clean-up-phis
+] unit-test
+
+reset-counters
+
+V{ } 0 test-bb
+V{ } 1 test-bb
+V{ T{ ##peek f V int-regs 0 D 0 } } 2 test-bb
+V{ T{ ##peek f V int-regs 0 D 0 } } 3 test-bb
+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
+
+[ ] [ test-ssa ] unit-test
+
+[
+    V{
+        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 }
+    }
+] [
+    4 get instructions>>
+    clean-up-phis
 ] unit-test
\ No newline at end of file
diff --git a/basis/compiler/cfg/ssa/ssa.factor b/basis/compiler/cfg/ssa/ssa.factor
index e11701965b..2e76ba35a1 100644
--- a/basis/compiler/cfg/ssa/ssa.factor
+++ b/basis/compiler/cfg/ssa/ssa.factor
@@ -1,19 +1,21 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces kernel accessors sequences fry dlists
-deques assocs sets math combinators sorting
+USING: namespaces kernel accessors sequences fry assocs
+sets math combinators
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.def-use
 compiler.cfg.renaming
+compiler.cfg.liveness
 compiler.cfg.registers
 compiler.cfg.dominance
 compiler.cfg.instructions ;
 IN: compiler.cfg.ssa
 
-! SSA construction. Predecessors and dominance must be computed first.
+! SSA construction. Predecessors must be computed first.
 
-! This is the classical algorithm based on dominance frontiers:
+! This is the classical algorithm based on dominance frontiers, except
+! we consult liveness information to build pruned SSA:
 ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.25.8240
 
 ! Eventually might be worth trying something fancier:
@@ -32,45 +34,22 @@ SYMBOL: inserting-phi-nodes
     '[
         dup instructions>> [
             defs-vregs [
-                _ push-at
+                _ conjoin-at
             ] with each
         ] with each
     ] each-basic-block ;
 
-SYMBOLS: has-already ever-on-work-list work-list ;
-
-: init-insert-phi-nodes ( bbs -- )
-    H{ } clone has-already set
-    [ unique ever-on-work-list set ]
-    [ <hashed-dlist> [ push-all-front ] keep work-list set ] bi ;
-
-: add-to-work-list ( bb -- )
-    dup ever-on-work-list get key? [ drop ] [
-        [ ever-on-work-list get conjoin ]
-        [ work-list get push-front ]
-        bi
-    ] if ;
-
 : insert-phi-node-later ( vreg bb -- )
-    [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
-    inserting-phi-nodes get push-at ;
-
-: compute-phi-node-in ( vreg bb -- )
-    dup has-already get key? [ 2drop ] [
-        [ insert-phi-node-later ]
-        [ has-already get conjoin ]
-        [ add-to-work-list ]
-        tri
-    ] if ;
+    2dup live-in key? [
+        [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep
+        inserting-phi-nodes get push-at
+    ] [ 2drop ] if ;
 
 : compute-phi-nodes-for ( vreg bbs -- )
-    dup length 2 >= [
-        init-insert-phi-nodes
-        work-list get [
-            dom-frontier [
-                compute-phi-node-in
-            ] with each
-        ] with slurp-deque
+    keys dup length 2 >= [
+        iterated-dom-frontier [
+            insert-phi-node-later
+        ] with each
     ] [ 2drop ] if ;
 
 : compute-phi-nodes ( -- )
@@ -143,4 +122,10 @@ M: ##phi rename-insn
 PRIVATE>
 
 : construct-ssa ( cfg -- cfg' )
-    dup [ compute-defs compute-phi-nodes insert-phi-nodes ] [ rename ] bi ;
\ No newline at end of file
+    {
+        [ ]
+        [ compute-live-sets ]
+        [ compute-dominance ]
+        [ compute-defs compute-phi-nodes insert-phi-nodes ]
+        [ rename ]
+    } cleave ;
\ No newline at end of file

From 995a96d7e492430c519c008c36297a3eb8c69757 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 06:19:31 -0500
Subject: [PATCH 18/19] compiler.cfg.dominance: fix unit tests

---
 basis/compiler/cfg/dominance/dominance-tests.factor | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor
index d73871c25f..e884e32d78 100644
--- a/basis/compiler/cfg/dominance/dominance-tests.factor
+++ b/basis/compiler/cfg/dominance/dominance-tests.factor
@@ -6,8 +6,7 @@ compiler.cfg.predecessors ;
 : test-dominance ( -- )
     cfg new 0 get >>entry
     compute-predecessors
-    compute-dominance
-    drop ;
+    compute-dominance ;
 
 ! Example with no back edges
 V{ } 0 test-bb

From dd2bbc51b378a4ea88e12608b5656515dd57cc19 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Wed, 22 Jul 2009 21:12:04 -0500
Subject: [PATCH 19/19] unix.types: define <time_t> alias; use it in
 calendar.unix to avoid clobbering data

---
 basis/calendar/unix/unix.factor         | 4 ++--
 basis/unix/types/freebsd/freebsd.factor | 4 +++-
 basis/unix/types/linux/linux.factor     | 4 +++-
 basis/unix/types/macosx/macosx.factor   | 4 +++-
 basis/unix/types/netbsd/netbsd.factor   | 4 +++-
 basis/unix/types/openbsd/openbsd.factor | 4 +++-
 6 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor
index 9848d0c164..aa4e8f7e9a 100644
--- a/basis/calendar/unix/unix.factor
+++ b/basis/calendar/unix/unix.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types alien.syntax arrays calendar
-kernel math unix unix.time namespaces system ;
+kernel math unix unix.time unix.types namespaces system ;
 IN: calendar.unix
 
 : timeval>seconds ( timeval -- seconds )
@@ -19,7 +19,7 @@ IN: calendar.unix
     timespec>seconds since-1970 ;
 
 : get-time ( -- alien )
-    f time <uint> localtime ;
+    f time <time_t> localtime ;
 
 : timezone-name ( -- string )
     get-time tm-zone ;
diff --git a/basis/unix/types/freebsd/freebsd.factor b/basis/unix/types/freebsd/freebsd.factor
index e012ebcbd6..215e344231 100644
--- a/basis/unix/types/freebsd/freebsd.factor
+++ b/basis/unix/types/freebsd/freebsd.factor
@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax alien.c-types ;
 
 IN: unix.types
 
@@ -22,3 +22,5 @@ TYPEDEF: __uint32_t     fflags_t
 TYPEDEF: long           ssize_t
 TYPEDEF: int            pid_t
 TYPEDEF: int            time_t
+
+ALIAS: <time_t> <int>
diff --git a/basis/unix/types/linux/linux.factor b/basis/unix/types/linux/linux.factor
index b0340c1778..a3dddfc93e 100644
--- a/basis/unix/types/linux/linux.factor
+++ b/basis/unix/types/linux/linux.factor
@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax alien.c-types ;
 IN: unix.types
 
 TYPEDEF: ulonglong __uquad_type
@@ -31,3 +31,5 @@ TYPEDEF: ulonglong __fsblkcnt64_t
 TYPEDEF: ulonglong __fsfilcnt64_t
 TYPEDEF: ulonglong ino64_t
 TYPEDEF: ulonglong off64_t
+
+ALIAS: <time_t> <long>
\ No newline at end of file
diff --git a/basis/unix/types/macosx/macosx.factor b/basis/unix/types/macosx/macosx.factor
index ac62776ed7..421efa60bc 100644
--- a/basis/unix/types/macosx/macosx.factor
+++ b/basis/unix/types/macosx/macosx.factor
@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax alien.c-types ;
 IN: unix.types
 
 ! Darwin 9.1.0
@@ -21,3 +21,5 @@ TYPEDEF: __int32_t  blksize_t
 TYPEDEF: long       ssize_t
 TYPEDEF: __int32_t  pid_t
 TYPEDEF: long       time_t
+
+ALIAS: <time_t> <long>
\ No newline at end of file
diff --git a/basis/unix/types/netbsd/netbsd.factor b/basis/unix/types/netbsd/netbsd.factor
index b5b0ffe661..7dacc97061 100644
--- a/basis/unix/types/netbsd/netbsd.factor
+++ b/basis/unix/types/netbsd/netbsd.factor
@@ -1,4 +1,4 @@
-USING: alien.syntax combinators layouts vocabs.loader ;
+USING: alien.syntax alien.c-types combinators layouts vocabs.loader ;
 IN: unix.types
 
 ! NetBSD 4.0
@@ -17,6 +17,8 @@ TYPEDEF: long           ssize_t
 TYPEDEF: int            pid_t
 TYPEDEF: int            time_t
 
+ALIAS: <time_t> <int>
+
 cell-bits {
     { 32 [ "unix.types.netbsd.32" require ] }
     { 64 [ "unix.types.netbsd.64" require ] }
diff --git a/basis/unix/types/openbsd/openbsd.factor b/basis/unix/types/openbsd/openbsd.factor
index 8938afa936..7c8fbd2b9d 100644
--- a/basis/unix/types/openbsd/openbsd.factor
+++ b/basis/unix/types/openbsd/openbsd.factor
@@ -1,4 +1,4 @@
-USING: alien.syntax ;
+USING: alien.syntax alien.c-types ;
 IN: unix.types
 
 ! OpenBSD 4.2
@@ -17,3 +17,5 @@ TYPEDEF: __uint32_t     fflags_t
 TYPEDEF: long           ssize_t
 TYPEDEF: int            pid_t
 TYPEDEF: int            time_t
+
+ALIAS: <time_t> <int>
\ No newline at end of file