Merge branch 'master' of git://factorcode.org/git/factor

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 ;

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.copy-prop compiler.cfg.rpo compiler.cfg.liveness ;
-compiler.cfg.liveness compiler.cfg.local ;
 IN: compiler.cfg.alias-analysis
 
 ! We try to eliminate redundant slot operations using some simple heuristics.
@@ -197,7 +196,7 @@ 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 -- )
+: init-alias-analysis ( insns -- insns' )
     H{ } clone histories set
     H{ } clone vregs>acs set
     H{ } clone acs>vregs set
@@ -208,7 +207,7 @@ M: ##alien-global insn-object drop \ ##alien-global ;
     0 ac-counter set
     next-ac heap-ac set
 
-    [ set-heap-ac ] each ;
+    dup local-live-in [ set-heap-ac ] each ;
 
 GENERIC: analyze-aliases* ( insn -- insn' )
 
@@ -280,9 +279,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 ;
+    [ alias-analysis-step ] local-optimization ;

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 ;

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 ;

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
 

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 ;

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

@@ -0,0 +1,97 @@
+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 ;
+
+! 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
+
+[ { 4 } ] [ 1 get dom-frontier [ number>> ] map ] unit-test
+[ { 4 } ] [ 2 get dom-frontier [ number>> ] map ] unit-test
+[ { } ] [ 0 get dom-frontier ] unit-test
+[ { } ] [ 4 get dom-frontier ] 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
+
+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

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 compiler.cfg.rpo
+USING: accessors assocs combinators sets math fry kernel math.order
-compiler.cfg.stack-analysis fry kernel math.order namespaces
+dlists deques namespaces sequences sorting compiler.cfg.rpo ;
-sequences ;
 IN: compiler.cfg.dominance
 
 ! Reference:
@@ -11,31 +10,106 @@ IN: compiler.cfg.dominance
 ! Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy
 ! http://www.cs.rice.edu/~keith/EMBED/dom.pdf
 
-SYMBOL: idoms
+! Also, a nice overview is given in these lecture notes:
-
+! http://llvm.cs.uiuc.edu/~vadve/CS526/public_html/Notes/4ssa.4up.pdf
-: idom ( bb -- bb' ) idoms get at ;
 
 <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+ [ [ dom-parent ] dip intersect ] }
-        { +gt+ [ idom 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 )
+: dom-children ( bb -- seq ) dom-childrens get at ;
-    H{ } clone idoms set
+
-    dup reverse-post-order
+<PRIVATE
-    unclip dup set-idom drop '[ _ iterate ] loop ;
+
+: 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 keys ;
+
+<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 -- )
+    [ compute-dom-parents compute-dom-children ]
+    [ compute-dom-frontiers ]
+    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 ;

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

@@ -4,6 +4,7 @@ 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
@@ -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 ;

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 { { int-regs regs } } (linear-scan)
-        dup reverse-post-order
-        { { 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

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

@@ -4,6 +4,7 @@ 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.live-intervals
@@ -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 -- )
+:: (linear-scan) ( cfg machine-registers -- )
-    rpo number-instructions
+    cfg compute-live-sets
-    rpo compute-live-intervals machine-registers allocate-registers
+    cfg number-instructions
-    rpo assign-registers
+    cfg compute-live-intervals machine-registers allocate-registers
-    rpo resolve-data-flow
+    cfg assign-registers
-    rpo check-numbering ;
+    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 ;

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.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 )

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 ( cfg -- )
-    check-numbering? get [ [ check-block-numbering ] each ] [ drop ] if ;
+    check-numbering? get [ [ check-block-numbering ] each-basic-block ] [ drop ] if ;

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.liveness
 compiler.cfg.utilities
 compiler.cfg.instructions
 compiler.cfg.linear-scan.assignment
-compiler.cfg.linear-scan.mapping compiler.cfg.liveness ;
+compiler.cfg.linear-scan.mapping ;
 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-data-flow ( cfg -- )
-    [ resolve-block-data-flow ] each ;
+    [ resolve-block-data-flow ] each-basic-block ;

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 ;

basis/compiler/cfg/liveness/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

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

@@ -1,15 +1,38 @@
-USING: compiler.cfg compiler.cfg.instructions compiler.cfg.registers
+USING: compiler.cfg.liveness compiler.cfg.debugger
-compiler.cfg.liveness accessors tools.test cpu.architecture ;
+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{
-        { "A" H{ { V int-regs 1 V int-regs 1 } { V int-regs 4 V int-regs 4 } } }
+        { V int-regs 1 V int-regs 1 }
-        { "B" H{ { V int-regs 3 V int-regs 3 } { V int-regs 2 V int-regs 2 } } }
+        { V int-regs 2 V int-regs 2 }
+        { V int-regs 3 V int-regs 3 }
     }
-] [
+]
-    <basic-block> V{
+[ 1 get live-in ]
-        T{ ##phi f V int-regs 0 { { "A" V int-regs 1 } { "B" V int-regs 2 } } }
+unit-test
-        T{ ##phi f V int-regs 1 { { "B" V int-regs 3 } { "A" V int-regs 4 } } }
-    } >>instructions compute-phi-live-in
-] unit-test

basis/compiler/cfg/liveness/liveness.factor

@@ -1,82 +1,26 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces deques accessors sets sequences assocs fry
+USING: kernel accessors assocs sequences sets
-hashtables dlists compiler.cfg.def-use compiler.cfg.instructions
+compiler.cfg.def-use compiler.cfg.dataflow-analysis
-compiler.cfg.rpo ;
+compiler.cfg.instructions ;
 IN: compiler.cfg.liveness
 
-! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis
+! See http://en.wikipedia.org/wiki/Liveness_analysis
+! Do not run after SSA construction
 
-! Assoc mapping basic blocks to sets of vregs
+BACKWARD-ANALYSIS: live
-SYMBOL: live-ins
 
-: live-in ( basic-block -- set ) live-ins get at ;
+: transfer-liveness ( live-set instructions -- live-set' )
+    [ clone ] [ <reversed> ] bi* [
+        [ uses-vregs [ over conjoin ] each ]
+        [ defs-vregs [ over delete-at ] each ] bi
+    ] each ;
 
-! Assoc mapping basic blocks to sequences of sets of vregs; each sequence
+: local-live-in ( instructions -- live-set )
-! is in conrrespondence with a predecessor
+    [ ##phi? not ] filter [ H{ } ] dip transfer-liveness keys ;
-SYMBOL: phi-live-ins
 
-: phi-live-in ( predecessor basic-block -- set ) phi-live-ins get at at ;
+M: live-analysis transfer-set
+    drop instructions>> transfer-liveness ;
 
-! Assoc mapping basic blocks to sets of vregs
+M: live-analysis join-sets
-SYMBOL: live-outs
+    drop assoc-combine ;
-
-: 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 ;
-
-: 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 [
-            '[ 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 ;

basis/compiler/cfg/local/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

basis/compiler/cfg/local/local.factor

@@ -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

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

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

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 ] |
+[ T{ ##copy f V int-regs 4 V int-regs 1 } ] [
-
+    2 get successors>> first instructions>> first
-[ ] [ 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 =
 ] unit-test
 
-[ t ] [
+[ T{ ##copy f V int-regs 4 V int-regs 2 } ] [
-    T{ ##copy f V int-regs n V int-regs 2 }
+    3 get successors>> first instructions>> first
-    3 get successors>> first instructions>> first =
 ] unit-test
 
-[ t ] [
+[ T{ ##copy f V int-regs 3 V int-regs 4 } ] [
-    T{ ##copy f V int-regs 3 V int-regs n }
+    4 get instructions>> first
-    4 get instructions>> first =
 ] unit-test
 
-]
-
 [ 3 ] [ 4 get instructions>> length ] unit-test

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

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 -- )
 
@@ -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 -- )

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

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

@@ -0,0 +1,113 @@
+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 ( -- )
+    ! 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 }
+    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
+    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
+
+: 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 } } }
+        T{ ##replace f V int-regs 6 D 0 }
+        T{ ##return }
+    }
+] [
+    3 get instructions>>
+    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

basis/compiler/cfg/ssa/ssa.factor

@@ -0,0 +1,131 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+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 must be computed first.
+
+! 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:
+! 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 [
+                _ conjoin-at
+            ] with each
+        ] with each
+    ] each-basic-block ;
+
+: insert-phi-node-later ( vreg bb -- )
+    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 -- )
+    keys dup length 2 >= [
+        iterated-dom-frontier [
+            insert-phi-node-later
+        ] with each
+    ] [ 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' )
+    {
+        [ ]
+        [ compute-live-sets ]
+        [ compute-dominance ]
+        [ compute-defs compute-phi-nodes insert-phi-nodes ]
+        [ rename ]
+    } cleave ;

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 ;

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 ;

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 ;
 

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
@@ -1218,17 +1213,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{
@@ -1264,7 +1248,6 @@ test-diamond
 [ ] [
     cfg new 0 get >>entry
     compute-predecessors
-    compute-liveness
     value-numbering
     compute-predecessors
     eliminate-dead-code
@@ -1335,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

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.rpo
-compiler.cfg.liveness
 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
+    [ value-numbering-step ] local-optimization cfg-changed ;
-    cfg-changed ;

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 ;

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
+USING: accessors arrays classes.mixin classes.parser classes.singleton
-classes.tuple classes.tuple.parser combinators effects
+classes.tuple classes.tuple.parser combinators effects effects.parser
-effects.parser fry generic generic.parser generic.standard
+fry generic generic.parser generic.standard interpolate
-interpolate io.streams.string kernel lexer locals.parser
+io.streams.string kernel lexer locals.parser locals.rewrite.closures
-locals.rewrite.closures locals.types make namespaces parser
+locals.types make namespaces parser quotations sequences vocabs.parser
-quotations sequences vocabs.parser words words.symbol ;
+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: `: }

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>

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>

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>

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 ] }

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>

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

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 ;
 

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." }

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

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"

extra/sequences/abbrev/abbrev-tests.factor

@@ -0,0 +1,26 @@
+USING: assocs sequences.abbrev tools.test ;
+IN: sequences.abbrev.tests
+
+[ { "hello" "help" } ] [
+    "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

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] [ head ] with map ;
+
+: (abbrev) ( seq -- assoc )
+    [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ;
+
+: assoc-merge ( assoc1 assoc2 -- assoc3 )
+    tuck '[ over _ at dup [ append ] [ 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 ;

extra/sequences/abbrev/authors.txt

@@ -0,0 +1 @@
+Maximilian Lupke