M: array simplify [ simplify ] map ;
M: ##copy simplify ;
+! ! ! Global value numbering
+
GENERIC: value-number ( insn -- )
M: array value-number [ value-number ] each ;
dup >expr dup exprs>vns get at
[ redundant-instruction ] [ useful-instruction ] ?if ;
-M: ##phi value-number
- dup inputs>> values [ vreg>vn ] map sift
- dup all-equal? [
- [ drop ] [ first redundant-instruction ] if-empty
- ] [ drop check-redundancy ] if ;
+! M: ##phi value-number
+! dup inputs>> values [ vreg>vn ] map sift
+! dup all-equal? [
+! [ drop ] [ first redundant-instruction ] if-empty
+! ] [ drop check-redundancy ] if ;
M: insn value-number
dup defs-vregs length 1 = [ check-redundancy ] [ drop ] if ;
changed? get
] loop ;
+! ! ! Global common subexpression elimination
+
+GENERIC: gcse ( insn -- insn' )
+
+M: array gcse [ gcse ] map ;
+
+M: alien-call-insn gcse ;
+M: ##callback-inputs gcse ;
+M: ##copy gcse ;
+
+: ?eliminate ( insn vn -- insn' )
+ dup available? [
+ [ dst>> ] dip <copy>
+ ] [ drop make-available ] if ;
+
+: eliminate-redundancy ( insn -- insn' )
+ dup >expr exprs>vns get at
+ [ ?eliminate ] [ make-available ] if* ;
+
+! M: ##phi gcse
+! dup inputs>> values [ vreg>vn ] map sift
+! dup all-equal? [
+! [ first ?eliminate ] unless-empty
+! ] [ drop eliminate-redundancy ] if ;
+
+M: insn gcse
+ dup defs-vregs length 1 = [ eliminate-redundancy ] when ;
+
+: gcse-step ( insns -- insns' )
+ ! [ simplify gcse ] map flatten ;
+ [ gcse ] map flatten ;
+
+: eliminate-common-subexpressions ( cfg -- )
+ final-iteration? on
+ dup compute-avail-sets
+ [ gcse-step ] simple-optimization ;
+
: value-numbering ( cfg -- cfg )
needs-predecessors
dup determine-value-numbers
+ dup eliminate-common-subexpressions
cfg-changed predecessors-changed ;