compiler: cleanup cfg passes to have stack effect ( cfg -- )

diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
index 97731095840d8cf2ef1eb627b998838d2c9968a8..33247b973fa140d77d75b4ae0ccd5c5cfe3eda6e 100644 (file)
--- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
+++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor
@@ -67,8 +67,8 @@ M: insn compute-stack-frame* drop ;
     [ frame-required? get [ <stack-frame> ] [ drop f ] if ]
     bi ;
 
-: build-stack-frame ( cfg -- cfg )
+: build-stack-frame ( cfg -- )
     0 param-area-size set
     0 allot-area-size set
     cell allot-area-align set
-    dup compute-stack-frame >>stack-frame ;
+    [ compute-stack-frame ] keep stack-frame<< ;

diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor
index 73d1204c37b73d0d1deea0a6b4a53a16814a5f04..dafb8c72f1306eb3328caf6187d9662e0f9268af 100644 (file)
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@@ -13,7 +13,13 @@ IN: compiler.cfg.builder.tests
 
 ! Just ensure that various CFGs build correctly.
 : unit-test-builder ( quot -- )
-    '[ _ test-builder [ [ optimize-cfg check-cfg ] with-cfg ] each ] [ ] swap unit-test ;
+    '[
+        _ test-builder [
+            [
+                [ optimize-cfg ] [ check-cfg ] bi
+            ] with-cfg
+        ] each
+    ] [ ] swap unit-test ;
 
 : blahblah ( nodes -- ? )
     { fixnum } declare [

diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor
index 853fde3f4ee19dc20cde04ec12c051062ee4b34a..0799f4b9d52c72c434beeab90340a849fb637c5d 100644 (file)
--- a/basis/compiler/cfg/debugger/debugger.factor
+++ b/basis/compiler/cfg/debugger/debugger.factor
@@ -30,25 +30,25 @@ M: word test-builder
 : test-ssa ( quot -- cfgs )
     test-builder [
         [
-            optimize-cfg
+            dup optimize-cfg
         ] with-cfg
     ] map ;
 
 : test-flat ( quot -- cfgs )
     test-builder [
         [
-            optimize-cfg
-            select-representations
-            insert-gc-checks
-            insert-save-contexts
+            dup optimize-cfg
+            dup select-representations
+            dup insert-gc-checks
+            dup insert-save-contexts
         ] with-cfg
     ] map ;
 
 : test-regs ( quot -- cfgs )
     test-builder [
         [
-            optimize-cfg
-            finalize-cfg
+            dup optimize-cfg
+            dup finalize-cfg
         ] with-cfg
     ] map ;
 

diff --git a/basis/compiler/cfg/finalization/finalization.factor b/basis/compiler/cfg/finalization/finalization.factor
index 2e904464c6764a892e36bb58baeb77429aa512ac..64c9d7244532d1aff400f52f6e6321928c251471 100644 (file)
--- a/basis/compiler/cfg/finalization/finalization.factor
+++ b/basis/compiler/cfg/finalization/finalization.factor
@@ -4,16 +4,19 @@ USING: kernel compiler.cfg.representations
 compiler.cfg.scheduling compiler.cfg.gc-checks
 compiler.cfg.write-barrier compiler.cfg.save-contexts
 compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame
-compiler.cfg.linear-scan compiler.cfg.stacks.vacant ;
+compiler.cfg.linear-scan compiler.cfg.stacks.vacant
+compiler.cfg.utilities ;
 IN: compiler.cfg.finalization
 
-: finalize-cfg ( cfg -- cfg' )
-    select-representations
-    schedule-instructions
-    insert-gc-checks
-    eliminate-write-barriers
-    dup compute-vacant-sets
-    insert-save-contexts
-    destruct-ssa
-    linear-scan
-    build-stack-frame ;
+: finalize-cfg ( cfg -- )
+    {
+        select-representations
+        schedule-instructions
+        insert-gc-checks
+        eliminate-write-barriers
+        compute-vacant-sets
+        insert-save-contexts
+        destruct-ssa
+        linear-scan
+        build-stack-frame
+    } apply-passes ;

diff --git a/basis/compiler/cfg/gc-checks/gc-checks-docs.factor b/basis/compiler/cfg/gc-checks/gc-checks-docs.factor
index eaf21a39b8030364f4216b04ca276a4ea4a1e283..2fc95c54fdb60d28e23f63ba4044e34a54c8adda 100644 (file)
--- a/basis/compiler/cfg/gc-checks/gc-checks-docs.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks-docs.factor
@@ -5,7 +5,7 @@ IN: compiler.cfg.gc-checks
 <PRIVATE
 
 HELP: insert-gc-checks
-{ $values { "cfg" cfg } { "cfg'" cfg } }
+{ $values { "cfg" cfg }  }
 { $description "Inserts gc checks in each " { $link basic-block } " in the cfg where they are needed." } ;
 
 HELP: insert-gc-check?

diff --git a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
index e9054ea74632d61c3b89dcd86a623b3f9ece5258..92c7fcd16cdaa6e6dee409277af7bb7966400922 100644 (file)
--- a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor
@@ -167,7 +167,7 @@ H{
     { 2 tagged-rep }
 } representations set
 
-[ ] [ cfg get insert-gc-checks drop ] unit-test
+[ ] [ cfg get insert-gc-checks ] unit-test
 
 [ ] [ 1 get successors>> first successors>> first 2 set ] unit-test
 
@@ -222,7 +222,7 @@ H{
     { 3 tagged-rep }
 } representations set
 
-[ ] [ cfg get insert-gc-checks drop ] unit-test
+[ ] [ cfg get insert-gc-checks ] unit-test
 [ ] [ 1 get successors>> first successors>> first 3 set ] unit-test
 [ t ] [ 2 get successors>> first instructions>> first ##phi? ] unit-test
 [ 2 ] [ 3 get instructions>> length ] unit-test
@@ -248,7 +248,7 @@ V{
 
 [ ] [ test-gc-checks ] unit-test
 
-[ ] [ cfg get insert-gc-checks drop ] unit-test
+[ ] [ cfg get insert-gc-checks ] unit-test
 
 [ ] [
     0 get successors>> first predecessors>>
@@ -294,7 +294,7 @@ V{
 
 [ ] [ test-gc-checks ] unit-test
 
-[ ] [ cfg get insert-gc-checks drop ] unit-test
+[ ] [ cfg get insert-gc-checks ] unit-test
 
 ! The GC check should come after the alien-invoke
 [
@@ -330,7 +330,7 @@ V{
 
 [ ] [ test-gc-checks ] unit-test
 
-[ ] [ cfg get insert-gc-checks drop ] unit-test
+[ ] [ cfg get insert-gc-checks ] unit-test
 
 [
     V{

diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index cb929fb47d7c699032cc71a756e41d6db5076454..5a353a543c1af4480ccc3f4571a08803e113f4d0 100644 (file)
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -127,9 +127,9 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ;
 
 PRIVATE>
 
-: insert-gc-checks ( cfg -- cfg' )
-    dup blocks-with-gc [
-        [ dup needs-predecessors ] dip
+:: insert-gc-checks ( cfg -- )
+    cfg blocks-with-gc [
+        cfg needs-predecessors
         [ process-block ] each
-        dup cfg-changed
+        cfg cfg-changed
     ] unless-empty ;

diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index 684c232564e167fcf56d5e70f307cbf294e19058..021dc3da46fe3954a26cbbc99c92d8e14fd954da 100644 (file)
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan.factor
@@ -43,5 +43,5 @@ IN: compiler.cfg.linear-scan
         [ [ frame-reg = not ] filter ] assoc-map
     ] when ;
 
-: linear-scan ( cfg -- cfg' )
-    dup dup admissible-registers (linear-scan) ;
+: linear-scan ( cfg -- )
+    dup admissible-registers (linear-scan) ;

diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index 365427168479ecfdb069d9a32d971355eb2a0694..9cd65426c93ecb6d2c5d009bace6d04cee6c4a6e 100644 (file)
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@@ -75,12 +75,17 @@ SYMBOLS: work-list loop-heads visited ;
 PRIVATE>
 
 : linearization-order ( cfg -- bbs )
-    needs-post-order needs-loops dup needs-predecessors
-
-    dup linear-order>> [ ] [
-        dup (linearization-order)
-        >>linear-order linear-order>>
-    ] ?if ;
+    {
+        [ needs-post-order ]
+        [ needs-loops ]
+        [ needs-predecessors ]
+        [
+            dup linear-order>> [ ] [
+                dup (linearization-order)
+                >>linear-order linear-order>>
+            ] ?if
+        ]
+    } cleave ;
 
 SYMBOL: numbers
 

diff --git a/basis/compiler/cfg/loop-detection/loop-detection-tests.factor b/basis/compiler/cfg/loop-detection/loop-detection-tests.factor
index b6757d36124bfecbb111a40a682f4d27f374e638..337a51c164f18c0bce2bcd98e0d2e46e1d4dc1b5 100644 (file)
--- a/basis/compiler/cfg/loop-detection/loop-detection-tests.factor
+++ b/basis/compiler/cfg/loop-detection/loop-detection-tests.factor
@@ -11,7 +11,7 @@ V{ } 2 test-bb
 2 0 edge
 
 : test-loop-detection ( -- )
-    0 get block>cfg needs-loops drop ;
+    0 get block>cfg needs-loops ;
 
 [ ] [ test-loop-detection ] unit-test
 

diff --git a/basis/compiler/cfg/loop-detection/loop-detection.factor b/basis/compiler/cfg/loop-detection/loop-detection.factor
index f0fdc7c61e08185cc0ab54197d0f0ec2024f9e44..d7c44a25fb780eb74b942c34117746aac6a827c7 100644 (file)
--- a/basis/compiler/cfg/loop-detection/loop-detection.factor
+++ b/basis/compiler/cfg/loop-detection/loop-detection.factor
@@ -77,6 +77,7 @@ PRIVATE>
 
 : current-loop-nesting ( -- n ) basic-block get loop-nesting-at ;
 
-: needs-loops ( cfg -- cfg' )
+: needs-loops ( cfg -- )
     dup needs-predecessors
-    dup loops-valid?>> [ detect-loops t >>loops-valid? ] unless ;
+    dup loops-valid?>> [ detect-loops t >>loops-valid? ] unless
+    drop ;

diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor
index a0a640c434d4317bdba2cfc93245fe6474a2cedb..356ae773ad0d9a16a4a9fcd134a3397e87362bd0 100644 (file)
--- a/basis/compiler/cfg/optimizer/optimizer.factor
+++ b/basis/compiler/cfg/optimizer/optimizer.factor
@@ -15,8 +15,8 @@ compiler.cfg.value-numbering
 kernel sequences ;
 IN: compiler.cfg.optimizer
 
-: optimize-cfg ( cfg -- cfg' )
-    dup {
+: optimize-cfg ( cfg -- )
+    {
         optimize-tail-calls
         delete-useless-conditionals
         split-branches

diff --git a/basis/compiler/cfg/representations/representations-tests.factor b/basis/compiler/cfg/representations/representations-tests.factor
index 91c60a24de7cc738a95eba46e5e1e24c38e21753..c88333e68899faae042d030702ccb859c5932b6e 100644 (file)
--- a/basis/compiler/cfg/representations/representations-tests.factor
+++ b/basis/compiler/cfg/representations/representations-tests.factor
@@ -52,7 +52,7 @@ H{ } clone representations set
 ] unit-test
 
 : test-representations ( -- )
-    0 get block>cfg dup cfg set select-representations drop ;
+    0 get block>cfg dup cfg set select-representations ;
 
 ! Make sure cost calculation isn't completely wrong
 V{

diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor
index 216d4943cedfdee12a9f8d74cbad0abbb4e13810..42e9e8bf092cf6a13ebb816c60fc2d3dea486910 100644 (file)
--- a/basis/compiler/cfg/representations/representations.factor
+++ b/basis/compiler/cfg/representations/representations.factor
@@ -18,9 +18,9 @@ IN: compiler.cfg.representations
 ! are made. The appropriate conversion operations inserted
 ! after a cost analysis.
 
-: select-representations ( cfg -- cfg' )
-    needs-loops
-    dup {
+: select-representations ( cfg -- )
+    {
+        needs-loops
         needs-predecessors
         compute-components
         compute-possibilities

diff --git a/basis/compiler/cfg/rpo/rpo.factor b/basis/compiler/cfg/rpo/rpo.factor
index 877f7770a78487498af160d4b1a1f1cadd4dbe3d..00647704219127d8ccf1ceec1b0383519bae4880 100644 (file)
--- a/basis/compiler/cfg/rpo/rpo.factor
+++ b/basis/compiler/cfg/rpo/rpo.factor
@@ -49,5 +49,5 @@ IN: compiler.cfg.rpo
 : simple-analysis ( ... cfg quot: ( ... insns -- ... ) -- ... )
     '[ _ analyze-basic-block ] each-basic-block ; inline
 
-: needs-post-order ( cfg -- cfg' )
-    dup post-order drop ;
+: needs-post-order ( cfg -- )
+    post-order drop ;

diff --git a/basis/compiler/cfg/save-contexts/save-contexts-docs.factor b/basis/compiler/cfg/save-contexts/save-contexts-docs.factor
index e66bf535545c8de3cd1f6eac15396e1cc65a3ae5..abe2dd1fe143117a9ac838f61d9fcfa7f90976dc 100644 (file)
--- a/basis/compiler/cfg/save-contexts/save-contexts-docs.factor
+++ b/basis/compiler/cfg/save-contexts/save-contexts-docs.factor
@@ -2,7 +2,7 @@ USING: compiler.cfg compiler.cfg.instructions help.markup help.syntax ;
 IN: compiler.cfg.save-contexts
 
 HELP: insert-save-contexts
-{ $values { "cfg" cfg } { "cfg'" cfg } }
+{ $values { "cfg" cfg } }
 { $description "Inserts " { $link ##save-context } " instructions in each " { $link basic-block } " in the cfg that needs them. Save contexts are needed after instructions that modify the context, or instructions that read parameter registers." }
 { $see-also needs-save-context? } ;
 

diff --git a/basis/compiler/cfg/save-contexts/save-contexts.factor b/basis/compiler/cfg/save-contexts/save-contexts.factor
index 0622ca7201a57fbee4f279dec11c3106541deecd..29989684bef3404901110d5db9dc92ef95880009 100644 (file)
--- a/basis/compiler/cfg/save-contexts/save-contexts.factor
+++ b/basis/compiler/cfg/save-contexts/save-contexts.factor
@@ -43,5 +43,5 @@ M: insn modifies-context? drop f ;
         [ insert-nth ] change-instructions drop
     ] [ drop ] if ;
 
-: insert-save-contexts ( cfg -- cfg' )
-    dup [ insert-save-context ] each-basic-block ;
+: insert-save-contexts ( cfg -- )
+    [ insert-save-context ] each-basic-block ;

diff --git a/basis/compiler/cfg/scheduling/scheduling-docs.factor b/basis/compiler/cfg/scheduling/scheduling-docs.factor
index 6571807260b5747b0983054570873480a9629e82..36dbad05c3bc2d15bade5a665e3c50dee774951d 100644 (file)
--- a/basis/compiler/cfg/scheduling/scheduling-docs.factor
+++ b/basis/compiler/cfg/scheduling/scheduling-docs.factor
@@ -2,5 +2,5 @@ USING: compiler.cfg compiler.cfg.height help.markup help.syntax sequences ;
 IN: compiler.cfg.scheduling
 
 HELP: schedule-instructions
-{ $values { "cfg" cfg } { "cfg'" cfg } }
+{ $values { "cfg" cfg } }
 { $description "Performs a instruction scheduling optimization pass over the CFG to attempt to reduce the number of spills. The step must be performed after " { $link normalize-height } " or else invalid peeks might be inserted into the CFG." } ;

diff --git a/basis/compiler/cfg/scheduling/scheduling-tests.factor b/basis/compiler/cfg/scheduling/scheduling-tests.factor
index 63dfa0e90e5a105f3e05604708e2614b85e5a5ea..f624a8c490320e403b45e5d841d44dfeda7567e0 100644 (file)
--- a/basis/compiler/cfg/scheduling/scheduling-tests.factor
+++ b/basis/compiler/cfg/scheduling/scheduling-tests.factor
@@ -55,7 +55,7 @@ IN: compiler.cfg.scheduling.tests
         T{ ##load-tagged }
         T{ ##allot }
         T{ ##set-slot-imm }
-    } insns>cfg schedule-instructions cfg>insns [ insn#>> ] all?
+    } insns>cfg dup schedule-instructions cfg>insns [ insn#>> ] all?
 ] unit-test
 
 : test-1187 ( -- insns )

diff --git a/basis/compiler/cfg/scheduling/scheduling.factor b/basis/compiler/cfg/scheduling/scheduling.factor
index 47d607a9a88b783e5b024524991d99504bdced39..3fb5eaf82e27c59d8894b4f101ca034e4ef8a4d6 100644 (file)
--- a/basis/compiler/cfg/scheduling/scheduling.factor
+++ b/basis/compiler/cfg/scheduling/scheduling.factor
@@ -71,8 +71,10 @@ conditional-branch-insn
 : schedule-block ( bb -- )
     [ reorder ] change-instructions drop ;
 
-! TODO: stack effect should be ( cfg -- )
-: schedule-instructions ( cfg --  cfg' )
-    dup number-instructions
-    dup reverse-post-order [ kill-block?>> not ] filter
-    [ schedule-block ] each ;
+: schedule-instructions ( cfg --  )
+    [ number-instructions ]
+    [
+        reverse-post-order
+        [ kill-block?>> not ] filter
+        [ schedule-block ] each
+    ] bi ;

diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor
index c2ae09e8c91478ef880749407ecb992545a4be9d..15225fba18fe04d604529a0eef76f4a96b89c5a5 100644 (file)
--- a/basis/compiler/cfg/ssa/destruction/destruction.factor
+++ b/basis/compiler/cfg/ssa/destruction/destruction.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2009, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs fry locals kernel make
-namespaces sequences sequences.deep
-sets vectors
+USING: accessors arrays assocs combinators fry locals kernel
+make namespaces sequences sequences.deep sets vectors
 cpu.architecture
 compiler.cfg.rpo
 compiler.cfg.def-use
@@ -153,14 +152,16 @@ M: insn cleanup-insn , ;
 
 PRIVATE>
 
-: destruct-ssa ( cfg -- cfg' )
-    dup needs-dominance
-    dup construct-cssa
-    dup compute-defs
-    dup compute-insns
-    dup compute-live-sets
-    dup compute-live-ranges
-    dup prepare-coalescing
-    process-copies
-    dup cleanup-cfg
-    dup compute-live-sets ;
+: destruct-ssa ( cfg -- )
+    {
+        [ needs-dominance ]
+        [ construct-cssa ]
+        [ compute-defs ]
+        [ compute-insns ]
+        [ compute-live-sets ]
+        [ compute-live-ranges ]
+        [ prepare-coalescing ]
+        [ drop process-copies ]
+        [ cleanup-cfg ]
+        [ compute-live-sets ]
+    } cleave ;

diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor
index 663d6938c73791aac9c4bc25fe3fc3d6a51bbb48..83322ead2f1cb03d7197cad5f0fe06db245c87a9 100644 (file)
--- a/basis/compiler/cfg/stacks/finalize/finalize.factor
+++ b/basis/compiler/cfg/stacks/finalize/finalize.factor
@@ -51,8 +51,7 @@ ERROR: bad-peek dst loc ;
 : visit-block ( bb -- )
     [ predecessors>> ] keep '[ _ visit-edge ] each ;
 
-: finalize-stack-shuffling ( cfg -- cfg' )
-    dup
+: finalize-stack-shuffling ( cfg -- )
     [ needs-predecessors ]
     [ [ visit-block ] each-basic-block ]
     [ cfg-changed ] tri ;

diff --git a/basis/compiler/cfg/stacks/global/global.factor b/basis/compiler/cfg/stacks/global/global.factor
index 30a999064ad1f6ce46e31edde7a68fe241b62728..15994c60f4131d695b80533b724585aaa173daa5 100644 (file)
--- a/basis/compiler/cfg/stacks/global/global.factor
+++ b/basis/compiler/cfg/stacks/global/global.factor
@@ -48,12 +48,11 @@ M: dead-analysis transfer-set
     [ replace-set assoc-union ] bi ;
 
 ! Main word
-: compute-global-sets ( cfg -- cfg' )
+: compute-global-sets ( cfg -- )
     {
         [ compute-anticip-sets ]
         [ compute-live-sets ]
         [ compute-pending-sets ]
         [ compute-dead-sets ]
         [ compute-avail-sets ]
-        [ ]
     } cleave ;

diff --git a/basis/compiler/cfg/stacks/stacks.factor b/basis/compiler/cfg/stacks/stacks.factor
index fdd6e405f56a97d328fbfdc0b5c22023da56772b..b73357c1e99012a3261916f932c86d9d4859e4c4 100644 (file)
--- a/basis/compiler/cfg/stacks/stacks.factor
+++ b/basis/compiler/cfg/stacks/stacks.factor
@@ -18,9 +18,8 @@ IN: compiler.cfg.stacks
 
 : end-stack-analysis ( -- )
     cfg get
-    compute-global-sets
-    finalize-stack-shuffling
-    drop ;
+    [ compute-global-sets ]
+    [ finalize-stack-shuffling ] bi ;
 
 : ds-drop ( -- ) -1 inc-d ;
 

diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
index 202ee4416af17bbec091ff3b9f575e52627a84eb..f3b286dc2573228e657122ecea100ea141590821 100644 (file)
--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
@@ -2748,9 +2748,9 @@ test-diamond
 
 [ ] [
     0 get block>cfg dup cfg set
-    dup value-numbering
-    select-representations
-    destruct-ssa drop
+    [ value-numbering ]
+    [ select-representations ]
+    [ destruct-ssa ] tri
 ] unit-test
 
 [ 1 ] [ 1 get successors>> length ] unit-test

diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor
index eaf8658e9450b0272285ee71e9c42a0b7d6273ea..2c2c71f7896be1ccaf5232217059e209298c0dc7 100644 (file)
--- a/basis/compiler/cfg/write-barrier/write-barrier.factor
+++ b/basis/compiler/cfg/write-barrier/write-barrier.factor
@@ -60,5 +60,5 @@ M: insn eliminate-write-barrier drop t ;
     H{ } clone copies set
     [ eliminate-write-barrier ] filter! ;
 
-: eliminate-write-barriers ( cfg -- cfg )
-    dup [ write-barriers-step ] simple-optimization ;
+: eliminate-write-barriers ( cfg -- )
+    [ write-barriers-step ] simple-optimization ;

diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor
index 7d0678218375ac27e5519a1018ae4e8239a7b4a2..fc0d6a1f2eeb309b27bfb34c9b5ecca0d4f36dcd 100644 (file)
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@@ -128,8 +128,10 @@ M: word combinator? inline? ;
 : backend ( tree word -- )
     build-cfg [
         [
-            optimize-cfg finalize-cfg
-            [ generate ] [ label>> ] bi compiled get set-at
+            [ optimize-cfg ]
+            [ finalize-cfg ]
+            [ [ generate ] [ label>> ] bi compiled get set-at ]
+            tri
         ] with-cfg
     ] each ;
 

diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor
index 683b778683c22102b408cc42a5435234a4dae346..e75dbb29758ecfcb7197232114ed41248996849a 100644 (file)
--- a/basis/compiler/tests/low-level-ir.factor
+++ b/basis/compiler/tests/low-level-ir.factor
@@ -1,4 +1,4 @@
-USING: accessors assocs compiler compiler.cfg
+USING: accessors assocs combinators compiler compiler.cfg
 compiler.cfg.debugger compiler.cfg.instructions
 compiler.cfg.registers compiler.cfg.linear-scan
 compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame
@@ -8,16 +8,18 @@ literals math arrays alien.c-types alien.syntax math.private ;
 IN: compiler.tests.low-level-ir
 
 : compile-cfg ( cfg -- word )
-    gensym
-    [ linear-scan build-stack-frame generate ] dip
+    gensym [
+        [ linear-scan ] [ build-stack-frame ] [ generate ] tri
+    ] dip
     [ associate >alist t t modify-code-heap ] keep ;
 
 : compile-test-cfg ( -- word )
-    0 get block>cfg
-    dup cfg set
-    dup fake-representations
-    destruct-ssa
-    compile-cfg ;
+    0 get block>cfg {
+        [ cfg set ]
+        [ fake-representations ]
+        [ destruct-ssa ]
+        [ compile-cfg ]
+    } cleave ;
 
 : compile-test-bb ( insns -- result )
     V{ T{ ##prologue } T{ ##branch } } [ clone ] map 0 test-bb

diff --git a/extra/compiler/cfg/graphviz/graphviz.factor b/extra/compiler/cfg/graphviz/graphviz.factor
index 26559752b4620fb5a45b4ad8e47d311bfbad8e0e..288d9281c8f4ec060366379d153639ffc6f0ba61 100644 (file)
--- a/extra/compiler/cfg/graphviz/graphviz.factor
+++ b/extra/compiler/cfg/graphviz/graphviz.factor
@@ -54,8 +54,8 @@ IN: compiler.cfg.graphviz
             [ add-cfg-vertex ] [ add-cfg-edges ] bi
         ] each-basic-block ;
 
-: perform-pass ( cfg pass pass# -- cfg' )
-    drop def>> call( cfg -- cfg' ) ;
+: perform-pass ( cfg pass pass# -- )
+    drop def>> call( cfg -- ) ;
 
 : draw-cfg ( cfg pass pass# -- cfg )
     [ dup cfgviz ]
@@ -66,7 +66,7 @@ IN: compiler.cfg.graphviz
 SYMBOL: passes
 
 : watch-pass ( cfg pass pass# -- cfg' )
-    [ perform-pass ] 2keep draw-cfg ;
+    [ perform-pass ] 3keep draw-cfg ;
 
 : begin-watching-passes ( cfg -- cfg )
     \ build-cfg 0 draw-cfg ;

diff --git a/extra/compiler/cfg/gvn/gvn.factor b/extra/compiler/cfg/gvn/gvn.factor
index 0877c6b0d460614c338cc665258ca9fc3401158d..668c1737a7009485c885bb2670ff21359237a249 100644 (file)
--- a/extra/compiler/cfg/gvn/gvn.factor
+++ b/extra/compiler/cfg/gvn/gvn.factor
@@ -118,8 +118,8 @@ M: insn gcse
     dup compute-avail-sets
     [ gcse-step ] simple-optimization ;
 
-: value-numbering ( cfg -- cfg )
-    dup {
+: value-numbering ( cfg -- )
+    {
         needs-predecessors
         determine-value-numbers
         eliminate-common-subexpressions