New local-optimization combinator removes some boilerplate

basis/compiler/cfg/alias-analysis/alias-analysis.factor

@@ -196,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 ( basic-block -- )
+: init-alias-analysis ( live-in -- )
     H{ } clone histories set
     H{ } clone vregs>acs set
     H{ } clone acs>vregs set
@@ -204,7 +204,7 @@ M: ##alien-global insn-object drop \ ##alien-global ;
     H{ } clone constants set
     H{ } clone copies set
 
-    live-in keys [ set-heap-ac ] each
+    [ set-heap-ac ] each
     
     0 ac-counter set
     next-ac heap-ac set ;
@@ -291,13 +291,10 @@ M: insn eliminate-dead-stores* ;
 : eliminate-dead-stores ( insns -- insns' )
     [ insn# set eliminate-dead-stores* ] map-index sift ;
 
-: alias-analysis-step ( basic-block -- )
+: alias-analysis-step ( insns -- insns' )
-    dup init-alias-analysis
+    analyze-aliases
-    [
+    compute-live-stores
-        analyze-aliases
+    eliminate-dead-stores ;
-        compute-live-stores
-        eliminate-dead-stores
-    ] change-instructions drop ;
 
 : alias-analysis ( rpo -- )
-    [ alias-analysis-step ] each ;
+    [ init-alias-analysis ] [ alias-analysis-step ] local-optimization ;

basis/compiler/cfg/height/height.factor

@@ -46,12 +46,10 @@ M: insn normalize-height* ;
 : height-step ( insns -- insns' )
     0 ds-height set
     0 rs-height set
-    [
+    [ [ compute-heights ] each ]
-        [ [ compute-heights ] each ]
+    [ [ [ normalize-height* ] map sift ] with-scope ] bi
-        [ [ [ normalize-height* ] map sift ] with-scope ] bi
+    ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
-        ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
+    rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if ;
-        rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if
-    ] change-instructions drop ;
 
 : normalize-height ( rpo -- )
-    [ height-step ] each ;
+    [ ] [ height-step ] local-optimization ;

basis/compiler/cfg/liveness/liveness.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel namespaces deques accessors sets sequences assocs fry dlists
+USING: kernel namespaces deques accessors sets sequences assocs fry
-compiler.cfg.def-use compiler.cfg.rpo ;
+dlists compiler.cfg.def-use ;
 IN: compiler.cfg.liveness
 
 ! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis

basis/compiler/cfg/rpo/rpo.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors namespaces make math sequences sets
-assocs fry compiler.cfg compiler.cfg.instructions ;
+assocs fry compiler.cfg compiler.cfg.instructions
+compiler.cfg.liveness ;
 IN: compiler.cfg.rpo
 
 SYMBOL: visited
@@ -28,3 +29,9 @@ SYMBOL: visited
 
 : each-basic-block ( cfg quot -- )
     [ reverse-post-order ] dip each ; inline
+
+: optimize-basic-block ( bb init-quot insn-quot -- )
+    [ '[ live-in keys _ each ] ] [ '[ _ change-instructions drop ] ] bi* bi ; inline
+
+: local-optimization ( rpo init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- )
+    '[ _ _ optimize-basic-block ] each ;

basis/compiler/cfg/value-numbering/value-numbering.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces assocs biassocs classes kernel math accessors
 sorting sets sequences
-compiler.cfg.liveness
+compiler.cfg.rpo
 compiler.cfg.value-numbering.graph
 compiler.cfg.value-numbering.expressions
 compiler.cfg.value-numbering.propagate
@@ -10,14 +10,16 @@ compiler.cfg.value-numbering.simplify
 compiler.cfg.value-numbering.rewrite ;
 IN: compiler.cfg.value-numbering
 
-: number-input-values ( basic-block -- )
+: number-input-values ( live-in -- )
-    live-in keys [ [ next-input-expr ] dip set-vn ] each ;
+    [ [ f next-input-expr ] dip set-vn ] each ;
 
-: value-numbering-step ( basic-block -- )
+: init-value-numbering ( live-in -- )
     init-value-graph
     init-expressions
-    dup number-input-values
+    number-input-values ;
-    [ [ [ number-values ] [ rewrite propagate ] bi ] map ] change-instructions drop ;
+
+: value-numbering-step ( insns -- insns' )
+    [ [ number-values ] [ rewrite propagate ] bi ] map ;
 
 : value-numbering ( rpo -- )
-    [ value-numbering-step ] each ;
+    [ init-value-numbering ] [ value-numbering-step ] local-optimization ;

basis/compiler/cfg/write-barrier/write-barrier.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! 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 compiler.cfg.instructions compiler.cfg.copy-prop
+compiler.cfg.rpo ;
 IN: compiler.cfg.write-barrier
 
 ! Eliminate redundant write barrier hits.
@@ -35,11 +36,11 @@ M: ##set-slot-imm eliminate-write-barrier
 
 M: insn eliminate-write-barrier ;
 
-: write-barriers-step ( basic-block -- )
+: write-barriers-step ( insns -- insns' )
     H{ } clone safe set
     H{ } clone mutated set
     H{ } clone copies set
-    [ [ eliminate-write-barrier ] map sift ] change-instructions drop ;
+    [ eliminate-write-barrier ] map sift ;
 
 : eliminate-write-barriers ( rpo -- )
-    [ write-barriers-step ] each ;
+    [ ] [ write-barriers-step ] local-optimization ;