compiler.cfg.gvn: some poorly thought-out attempts at redundancy elimination that don't work; committed for posterity

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>canon-vn ] map \ ##phi prefix ;
+    inputs>> values [ vreg>leader ] map \ ##phi prefix ;

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

@@ -25,14 +25,10 @@ SYMBOL: final-iteration?
 
 : vn>insn ( vn -- insn ) vns>insns get at ;
 
-: vreg>canon-vn ( vreg -- vn )
+: vreg>leader ( vreg -- vn ) vregs>vns get at ;
-    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 ;
+    dup vreg>leader dup available? [ nip ] [ drop ] if ;
 
 : set-vn ( vn vreg -- )
     vregs>vns get maybe-set-at [ changed? on ] when ;
@@ -41,12 +37,10 @@ SYMBOL: final-iteration?
 
 : clear-exprs ( -- )
     exprs>vns get clear-assoc
-    vns>insns get clear-assoc
+    vns>insns get clear-assoc ;
-    bbs>defns get clear-assoc ;
 
 : init-value-graph ( -- )
     0 input-expr-counter set
     H{ } clone vregs>vns set
     H{ } clone exprs>vns set
-    H{ } clone vns>insns set
+    H{ } clone vns>insns set ;
-    H{ } clone bbs>defns set ;

extra/compiler/cfg/gvn/gvn.factor

@@ -18,8 +18,7 @@ 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' )
@@ -32,7 +31,6 @@ GENERIC: process-instruction ( insn -- insn' )
     vn vn set-vn
     vn expr exprs>vns get set-at
     insn vn vns>insns get set-at
-    vn vn basic-block get bbs>defns get [ ?set-at ] change-at
     insn ;
 
 : check-redundancy ( insn -- insn' )
@@ -44,6 +42,11 @@ M: insn process-instruction
     [ process-instruction ]
     [ dup defs-vregs length 1 = [ check-redundancy ] when ] ?if ;
 
+UNION: don't-check-redundancy alien-call-insn ##callback-inputs ;
+
+M: don't-check-redundancy process-instruction
+    dup rewrite [ process-instruction ] [ ] ?if ;
+
 M: ##copy process-instruction
     dup [ src>> vreg>vn ] [ dst>> ] bi set-vn ;
 
@@ -59,6 +62,7 @@ M: array process-instruction
 
 : identify-redundancies ( cfg -- )
     final-iteration? off
+    ! dup compute-avail-sets
     init-value-graph
     '[
         changed? off
@@ -66,9 +70,21 @@ M: array process-instruction
         changed? get
     ] loop ;
 
+: eliminate-redundancies ( cfg -- )
+    final-iteration? on
+    ! dup compute-avail-sets
+    clear-exprs
+    [ value-numbering-step ] simple-optimization ;
+
+USE: prettyprint
+
 : value-numbering ( cfg -- cfg )
     needs-predecessors
 
+    dup compute-avail-sets
+
+    ! avail-ins get [ [ number>> ] [ keys ] bi* ] assoc-map .
+
     dup identify-redundancies
     dup eliminate-redundancies
 

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

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