compiler.cfg.gvn: refactor

extra/compiler/cfg/gvn/comparisons/comparisons.factor

@@ -98,8 +98,9 @@ UNION: general-compare-insn scalar-compare-insn ##test-vector ;
     } cond ;
 
 : fold-branch ( ? -- insn )
-    0 1 ?
+    drop
-    basic-block get [ nth 1vector ] change-successors drop
+    ! 0 1 ?
+    ! basic-block get [ nth 1vector ] change-successors drop
     \ ##branch new-insn ;
 
 : fold-compare-imm-branch ( insn -- insn/f )

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

@@ -5,7 +5,8 @@ IN: compiler.cfg.gvn.graph
 
 SYMBOL: input-expr-counter
 
-! assoc mapping vregs to value numbers
+! assoc mapping vregs to *optimistic* value numbers
+! initialized per iteration of global value numbering
 ! this is the identity on canonical representatives
 SYMBOL: vregs>vns
 
@@ -15,35 +16,36 @@ SYMBOL: exprs>vns
 ! assoc mapping value numbers to instructions
 SYMBOL: vns>insns
 
-! assoc mapping vregs to *global* value numbers
+! assoc mapping vregs to value numbers
-SYMBOL: vregs>gvns
+! once this stops changing, we know the value numbers are sound
+SYMBOL: valid-vns
 
+! boolean to track whether valid-vns changes
 SYMBOL: changed?
 
 : vn>insn ( vn -- insn ) vns>insns get at ;
 
-! : vreg>vn ( vreg -- vn ) vregs>vns get [ ] cache ;
+: vreg>vn ( vreg -- vn ) valid-vns get at ;
 
-: vreg>vn ( vreg -- vn ) vregs>gvns get at ;
+: optimistic-vn ( default-vn vreg -- vn )
-
-! : set-vn ( vn vreg -- ) vregs>vns get set-at ;
-
-: local-vn ( vn vreg -- lvn )
     vregs>vns get ?at
     [ nip ]
     [ dupd vregs>vns get set-at ] if ;
 
-: set-vn ( vn vreg -- )
+: set-vn ( default-vn vreg -- )
-    [ local-vn ] keep
+    [ optimistic-vn ] keep
-    vregs>gvns get maybe-set-at [ changed? on ] when ;
+    valid-vns get maybe-set-at [ changed? on ] when ;
 
 : vreg>insn ( vreg -- insn ) vreg>vn vn>insn ;
 
-: init-gvn ( -- )
+: clear-optimistic-value-graph ( -- )
-    H{ } clone vregs>gvns set ;
+    vregs>vns get clear-assoc
+    exprs>vns get clear-assoc
+    vns>insns get clear-assoc ;
 
 : init-value-graph ( -- )
     0 input-expr-counter set
+    H{ } clone valid-vns set
     H{ } clone vregs>vns set
     H{ } clone exprs>vns set
     H{ } clone vns>insns set ;

extra/compiler/cfg/gvn/gvn.factor

@@ -49,7 +49,7 @@ M: ##copy process-instruction
 M: ##phi rewrite
     [ dst>> ] [ inputs>> values [ vreg>vn ] map ] bi
     dup sift
-    dup all-equal?  [
+    dup all-equal? [
         nip
         [ drop f ]
         [ first <copy> ] if-empty
@@ -66,26 +66,29 @@ M: array process-instruction
     [ process-instruction ] map ;
 
 : value-numbering-step ( insns -- insns' )
-    init-value-graph
+    [ process-instruction ] map flatten ;
-    ! [ process-instruction ] map flatten ;
 
-    ! idea: let rewrite do the constant/copy propagation (as
+! XXX there's going to be trouble with certain rewrites that
-    ! that eventually leads to better VNs), but don't actually
+! modify the cfg / instructions destructively; namely those in
-    ! use them here, since changing the CFG mid-optimistic-GVN
+! comparisons.factor, alien.factor, and slots.factor
-    ! won't be sound
-    dup [ process-instruction drop ] each ;
 
 : value-numbering-iteration ( cfg -- )
-    [ value-numbering-step ] simple-optimization ;
+    clear-optimistic-value-graph
+    [ value-numbering-step drop ] simple-analysis ;
 
-: value-numbering ( cfg -- cfg )
+: identify-redundancies ( cfg -- )
-    dup
+    init-value-graph
-    init-gvn
     '[
         changed? off
         _ value-numbering-iteration
         changed? get
-    ] loop
+    ] loop ;
 
-    dup [ init-value-graph [ process-instruction ] map flatten ] simple-optimization
+: eliminate-redundancies ( cfg -- )
+    clear-optimistic-value-graph
+    [ value-numbering-step ] simple-optimization ;
+
+: value-numbering ( cfg -- cfg )
+    dup identify-redundancies
+    dup eliminate-redundancies
     cfg-changed predecessors-changed ;

extra/compiler/cfg/gvn/testing/testing.factor

@@ -12,7 +12,7 @@ GENERIC: expr>str ( expr -- str )
 
 M: integer-expr expr>str value>> number>string ;
 
-M: reference-expr expr>str value>> number>string "&" prepend ;
+M: reference-expr expr>str value>> unparse ;
 
 M: object expr>str [ unparse ] map " " join ;
 
@@ -23,7 +23,7 @@ M: object expr>str [ unparse ] map " " join ;
         drop "%d -> <%d>\\l" sprintf
     ] if ;
 
-: lvns ( -- str )
+: optimistic ( -- str )
     vregs>vns get >alist natural-sort [
         first2 local-value-mapping
     ] map "" concat-as ;
@@ -33,8 +33,8 @@ M: object expr>str [ unparse ] map " " join ;
         [ push-at ] curry assoc-each
     ] keep ;
 
-: gvns ( -- str )
+: valid ( -- str )
-    vregs>gvns get invert-assoc >alist natural-sort [
+    valid-vns get invert-assoc >alist natural-sort [
         first2
         natural-sort [ number>string ] map ", " join
         "<%d> : {%s}\\l" sprintf
@@ -43,16 +43,16 @@ M: object expr>str [ unparse ] map " " join ;
 : basic-block# ( -- n )
     basic-block get number>> ;
 
-: add-gvns ( graph -- graph' )
+: add-valid-vns ( graph -- graph' )
     <anon>
-        "gvns" add-node[ gvns =label "plaintext" =shape ];
+        "valid" add-node[ valid =label "plaintext" =shape ];
-        "gvns" 0 add-edge[ "invis" =style ];
+        "valid" 0 add-edge[ "invis" =style ];
     add ;
 
-: add-lvns ( graph -- graph' )
+: add-optimistic-vns ( graph -- graph' )
-    "lvn" <cluster>
+    "opt" <cluster>
         "invis" =style
-        "lvns" add-node[ lvns =label "plaintext" =shape ];
+        "opt" add-node[ optimistic =label "plaintext" =shape ];
         basic-block# add-node[ "bold" =style ];
     add ;
 
@@ -66,7 +66,7 @@ SYMBOL: iteration
 
 : draw-annotated-cfg ( -- )
     iteration-dir [
-        cfg get cfgviz add-gvns add-lvns
+        cfg get cfgviz add-valid-vns add-optimistic-vns
         basic-block# number>string "bb" prepend png
     ] with-directory ;