New local-optimization combinator removes some boilerplate

diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
index 3a153740d5eb9e95271c152d59c5d05432ea8d7f..8e1034fb0d04809e6da60512ff59a0c65bd9b449 100644 (file)
--- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor
+++ b/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 -- )
-    dup init-alias-analysis
-    [
-        analyze-aliases
-        compute-live-stores
-        eliminate-dead-stores
-    ] change-instructions drop ;
+: alias-analysis-step ( insns -- insns' )
+    analyze-aliases
+    compute-live-stores
+    eliminate-dead-stores ;
 
 : alias-analysis ( rpo -- )
-    [ alias-analysis-step ] each ;
\ No newline at end of file
+    [ init-alias-analysis ] [ alias-analysis-step ] local-optimization ;
\ No newline at end of file

diff --git a/basis/compiler/cfg/height/height.factor b/basis/compiler/cfg/height/height.factor
index 9c305442e5ba7f173cecdf15d5c527b87c5c0168..336a8a33c28b380cc31ae4d4c821e2c3dfe4640f 100644 (file)
--- a/basis/compiler/cfg/height/height.factor
+++ b/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 ]
-        [ [ [ normalize-height* ] map sift ] with-scope ] bi
-        ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
-        rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if
-    ] change-instructions drop ;
+    [ [ compute-heights ] each ]
+    [ [ [ normalize-height* ] map sift ] with-scope ] bi
+    ds-height get dup zero? [ drop ] [ f \ ##inc-d boa prefix ] if
+    rs-height get dup zero? [ drop ] [ f \ ##inc-r boa prefix ] if ;
 
 : normalize-height ( rpo -- )
-    [ height-step ] each ;
+    [ ] [ height-step ] local-optimization ;

diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor
index 66a584c6133626a2055745569b8ea2eae6ed8625..7cc6158e6827623900696f54587c9c3ec530bbe0 100644 (file)
--- a/basis/compiler/cfg/liveness/liveness.factor
+++ b/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
-compiler.cfg.def-use compiler.cfg.rpo ;
+USING: kernel namespaces deques accessors sets sequences assocs fry
+dlists compiler.cfg.def-use ;
 IN: compiler.cfg.liveness
 
 ! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis

diff --git a/basis/compiler/cfg/rpo/rpo.factor b/basis/compiler/cfg/rpo/rpo.factor
index 766373175cfd12659eaa7ad308804fda2680fba0..32ca87de97f1231c1fc0cc5a7b240566c9ce075c 100644 (file)
--- a/basis/compiler/cfg/rpo/rpo.factor
+++ b/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 ;
\ No newline at end of file

diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor
index ac0c512bf883eaa4fe6df490f3178f2b034f7b96..b22c8b4388b24ab2dac89f8613e1803e214c0ce7 100644 (file)
--- a/basis/compiler/cfg/value-numbering/value-numbering.factor
+++ b/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 -- )
-    live-in keys [ [ next-input-expr ] dip set-vn ] each ;
+: number-input-values ( live-in -- )
+    [ [ 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-values ] [ rewrite propagate ] bi ] map ] change-instructions drop ;
+    number-input-values ;
+
+: 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 ;

diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor
index 5a082966171f989beb757f06f4dac242bf18f6a5..b952c062e71c86e85b9ff86ea47f13b85062f298 100644 (file)
--- a/basis/compiler/cfg/write-barrier/write-barrier.factor
+++ b/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 ;