compiler.cfg.gvn.redundancy-elimination: horrific tinkering that doesn't even work

extra/compiler/cfg/gvn/avail/authors.txt

@@ -0,0 +1 @@
+Alex Vondrak

extra/compiler/cfg/gvn/avail/avail.factor

@@ -0,0 +1,26 @@
+! Copyright (C) 2011 Alex Vondrak.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs compiler.cfg
+compiler.cfg.dataflow-analysis compiler.cfg.def-use hashtables
+kernel namespaces sequences ;
+IN: compiler.cfg.gvn.avail
+
+! assoc mapping basic blocks to the set of value numbers that
+! are defined in the block
+SYMBOL: bbs>defns
+
+! : defined ( bb -- vns ) bbs>defns get at ;
+
+: defined ( bb -- vregs )
+    instructions>> [ defs-vregs ] map concat [ dup ] H{ } map>assoc ;
+
+FORWARD-ANALYSIS: avail
+
+M: avail-analysis transfer-set drop defined assoc-union ;
+
+: available? ( vn -- ? )
+    basic-block get avail-ins get at key? ;
+
+: make-available ( insn -- insn )
+    dup dst>>
+    basic-block get avail-ins get [ dupd ?set-at ] change-at ;

extra/compiler/cfg/gvn/expressions/expressions.factor

@@ -88,4 +88,4 @@ M: ##load-reference >expr obj>> <reference-expr> ;
 ! phi equivalences
 
 M: ##phi >expr
-    inputs>> values [ vreg>vn ] map \ ##phi prefix ;
+    inputs>> values [ vreg>canon-vn ] map \ ##phi prefix ;

extra/compiler/cfg/gvn/graph/graph.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math namespaces assocs ;
+USING: accessors compiler.cfg.gvn.avail kernel math namespaces
+assocs ;
 IN: compiler.cfg.gvn.graph
 
 SYMBOL: input-expr-counter
@@ -15,24 +16,29 @@ SYMBOL: exprs>vns
 ! assoc mapping value numbers to instructions
 SYMBOL: vns>insns
 
-! assoc mapping basic blocks to the set of value numbers that
-! are defined in the block
-SYMBOL: bbs>defns
-
 ! boolean to track whether vregs>vns changes
 SYMBOL: changed?
 
+! boolean to track when it's safe to alter the CFG in a rewrite
+! method (i.e., after vregs>vns stops changing)
+SYMBOL: final-iteration?
+
 : vn>insn ( vn -- insn ) vns>insns get at ;
 
-: vreg>vn ( vreg -- vn ) vregs>vns get at ;
+: vreg>canon-vn ( vreg -- vn )
+    vregs>vns get at ;
+
+: vreg>avail-vn ( vreg -- vn )
+    dup vreg>canon-vn dup available? [ nip ] [ drop ] if ;
+
+: vreg>vn ( vreg -- vn )
+    final-iteration? get [ vreg>avail-vn ] [ vreg>canon-vn ] if ;
 
 : set-vn ( vn vreg -- )
     vregs>vns get maybe-set-at [ changed? on ] when ;
 
 : vreg>insn ( vreg -- insn ) vreg>vn vn>insn ;
 
-: defined ( bb -- vns ) bbs>defns get at ;
-
 : clear-exprs ( -- )
     exprs>vns get clear-assoc
     vns>insns get clear-assoc

extra/compiler/cfg/gvn/gvn.factor

@@ -9,14 +9,17 @@ compiler.cfg.rpo
 compiler.cfg.def-use
 compiler.cfg.utilities
 compiler.cfg.instructions
+compiler.cfg.predecessors
 compiler.cfg.gvn.alien
+compiler.cfg.gvn.avail
 compiler.cfg.gvn.comparisons
 compiler.cfg.gvn.graph
 compiler.cfg.gvn.math
 compiler.cfg.gvn.rewrite
 compiler.cfg.gvn.slots
 compiler.cfg.gvn.misc
-compiler.cfg.gvn.expressions ;
+compiler.cfg.gvn.expressions
+compiler.cfg.gvn.redundancy-elimination ;
 IN: compiler.cfg.gvn
 
 GENERIC: process-instruction ( insn -- insn' )
@@ -63,16 +66,10 @@ M: array process-instruction
         changed? get
     ] loop ;
 
-! FIXME can't just do a pass through the cfg to rewrite---not
-! all canonical leaders are necessarily available in a
-! particular rewrite
-
-: eliminate-redundancies ( cfg -- )
-    final-iteration? on
-    clear-exprs
-    [ value-numbering-step ] simple-optimization ;
-
 : value-numbering ( cfg -- cfg )
+    needs-predecessors
+
     dup identify-redundancies
-    ! dup eliminate-redundancies
+    dup eliminate-redundancies
+
     cfg-changed predecessors-changed ;

extra/compiler/cfg/gvn/misc/misc.factor

@@ -16,7 +16,7 @@ M: ##replace rewrite
     ] [ 2drop f ] if ;
 
 M: ##phi rewrite
-    [ dst>> ] [ inputs>> values [ vreg>vn ] map sift ] bi
+    [ dst>> ] [ inputs>> values [ vreg>canon-vn ] map sift ] bi
     dup all-equal? [
         [ drop f ]
         [ first <copy> ] if-empty

extra/compiler/cfg/gvn/redundancy-elimination/redundancy-elimination.factor

@@ -1,60 +1,61 @@
 ! Copyright (C) 2011 Alex Vondrak.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ;
+USING: accessors arrays assocs combinators.short-circuit
+compiler.cfg.def-use compiler.cfg.gvn.avail
+compiler.cfg.gvn.expressions compiler.cfg.gvn.graph
+compiler.cfg.gvn.rewrite compiler.cfg.instructions
+compiler.cfg.registers compiler.cfg.renaming.functor
+compiler.cfg.rpo compiler.cfg.utilities kernel namespaces
+sequences sequences.deep ;
 IN: compiler.cfg.gvn.redundancy-elimination
 
-! ! ! Available expressions analysis
+RENAMING: copy-prop [ vreg>vn ] [ vreg>vn ] [ drop next-vreg ]
 
-FORWARD-ANALYSIS: avail
+: copy-prop ( insn -- insn' )
+    dup vreg-insn? [ dup copy-prop-insn-uses ] when ;
 
-M: avail-analysis transfer-set drop defined assoc-union ;
+GENERIC: update-insn ( insn -- insn/f )
 
-: available? ( vn -- ? )
-    basic-block get avail-ins get at key? ;
-
-! ! ! Copy propagation
-
-RENAMING: propagate [ vreg>avail-vn ] [ vreg>avail-vn ] [ drop next-vreg ]
-
-! ! ! Redundancy elimination
-
-! Returns f if insn should be removed
-GENERIC: process-instruction ( insn -- insn'/f )
-
-: redundant-instruction ( insn vn -- f ) 2drop f ; inline
-
-: make-available ( vn -- )
-    dup basic-block get avail-ins get [ ?set-at ] change-at ;
-
-:: useful-instruction ( insn expr -- insn' )
-    insn dst>> :> vn
-    vn make-available
-    insn propagate-insn-uses ! I think that's right?
-    insn ;
-
-: check-redundancy ( insn -- insn'/f )
-    dup >expr dup exrs>vns get at
-    [ redundant-instruction ] [ useful-instruction ] ?if ;
+: canonical-leader? ( vreg -- ? ) dup vreg>vn = ;
 
 : check-redundancy? ( insn -- ? )
     defs-vregs {
         [ length 1 = ]
-        [ first dup vreg>vn = not ] ! avoid ##copy x x
+        ! [ first canonical-leader? not ]
     } 1&& ;
 
-M: insn process-instruction
-    dup rewrite
-    [ process-instruction ]
-    [ dup check-redundancy? [ check-redundancy ] when ] ?if ;
+: redundant? ( insn -- ? )
+    ! [ dst>> ] [ >expr exprs>vns get at ] bi = not ;
+    >expr exprs>vns get key? ;
 
-M: ##copy process-instruction drop f ;
+: check-redundancy ( insn -- insn/f )
+    dup check-redundancy? [
+        dup redundant?
+        [ [ dst>> ] [ >expr exprs>vns get at ] bi <copy> ]
+        [ make-available ] if
+    ] when ;
 
-M: array process-instruction [ process-instruction ] map ;
+M: insn update-insn
+    dup rewrite [ update-insn ] [ check-redundancy ] ?if ;
 
-: redundancy-elimination-step ( insns -- insns' )
-    [ process-instruction ] map flatten sift ;
+M: ##copy update-insn ;
 
-: eliminate-redunancies ( cfg -- )
-    final-iteration? on ! if vreg>vn uses this to obey avail-ins
+M: array update-insn [ update-insn ] map ;
+
+: (eliminate-redundancies) ( insns -- insns' )
+    [ update-insn ] map flatten sift ;
+
+! USING: accessors io prettyprint compiler.cfg compiler.cfg.graphviz
+! graphviz.render ;
+
+: eliminate-redundancies ( cfg -- )
+    final-iteration? on
     dup compute-avail-sets
-    [ redundancy-elimination-step ] simple-optimization ;
+    [
+        ! "Before:" print
+        ! avail-ins get [ [ number>> ] [ keys ] bi* ] assoc-map .
+        (eliminate-redundancies)
+        ! "After:" print
+        ! avail-ins get [ [ number>> ] [ keys ] bi* ] assoc-map .
+        ! cfg get cfgviz preview
+    ] simple-optimization ;

extra/compiler/cfg/gvn/rewrite/rewrite.factor

@@ -11,10 +11,6 @@ GENERIC: rewrite ( insn -- insn/f )
 
 M: insn rewrite drop f ;
 
-! Boolean to track when it's safe to alter the CFG in a rewrite
-! method (i.e., after we've already iterated till fixpoint)
-SYMBOL: final-iteration?
-
 ! Utilities
 GENERIC: insn>integer ( insn -- n )