compiler.cfg: fix stack effect of cfg-changed and predecessors changed to ( cfg -- )

diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor
index 93f48b52bb6a2514eb6427cea75eed452d94e435..39faa05790dc84f769ae23efeadc392f57bbecd2 100644 (file)
--- a/basis/compiler/cfg/block-joining/block-joining.factor
+++ b/basis/compiler/cfg/block-joining/block-joining.factor
@@ -28,10 +28,9 @@ IN: compiler.cfg.block-joining
 
 : join-blocks ( cfg -- )
     needs-predecessors
-
-    dup post-order [
-        dup join-block?
-        [ dup predecessor join-block ] [ drop ] if
-    ] each
-
-    cfg-changed predecessors-changed drop ;
+    [
+        post-order [
+            dup join-block?
+            [ dup predecessor join-block ] [ drop ] if
+        ] each
+    ] [ cfg-changed ] [ predecessors-changed ] tri ;

diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting.factor b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
index fd9eea23dfb3a1a9c85f2b805c819629f2a0afbf..f323ed4afd91c53bf2d7556b138f1b50a70509d5 100644 (file)
--- a/basis/compiler/cfg/branch-splitting/branch-splitting.factor
+++ b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
@@ -104,4 +104,4 @@ SYMBOL: visited
         successors>> [ add-to-worklist ] each
     ] slurp-deque
 
-    cfg-changed drop ;
+    cfg-changed ;

diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor
index 7fde6c137149911d2211a08433fafa55e7306663..c8625229bffdffaf3f80e7c8c59fb129ffee75c5 100644 (file)
--- a/basis/compiler/cfg/cfg.factor
+++ b/basis/compiler/cfg/cfg.factor
@@ -34,14 +34,14 @@ predecessors-valid? dominance-valid? loops-valid? ;
         swap >>word
         swap >>entry ;
 
-: cfg-changed ( cfg -- cfg )
+: cfg-changed ( cfg -- )
     f >>post-order
     f >>linear-order
     f >>dominance-valid?
-    f >>loops-valid? ; inline
+    f >>loops-valid? drop ; inline
 
-: predecessors-changed ( cfg -- cfg )
-    f >>predecessors-valid? ;
+: predecessors-changed ( cfg -- )
+    f >>predecessors-valid? drop ;
 
 : with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
     [ dup cfg ] dip with-variable ; inline

diff --git a/basis/compiler/cfg/copy-prop/copy-prop.factor b/basis/compiler/cfg/copy-prop/copy-prop.factor
index c0024f0752d370fbb51165568b5d5ab8845bad17..795028806af9645c505c219a9a7774b74a66c9db 100644 (file)
--- a/basis/compiler/cfg/copy-prop/copy-prop.factor
+++ b/basis/compiler/cfg/copy-prop/copy-prop.factor
@@ -123,4 +123,4 @@ USE: compiler.cfg
     needs-predecessors
     dup collect-copies
     dup rename-copies
-    predecessors-changed drop ;
+    predecessors-changed ;

diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index 87506e9377a2aef3031dc7285cdcfb2e8b1a5749..a73f94a235f09787edc8532837327077425dcfac 100644 (file)
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/basis/compiler/cfg/gc-checks/gc-checks.factor
@@ -131,5 +131,5 @@ PRIVATE>
     dup blocks-with-gc [
         [ needs-predecessors ] dip
         [ process-block ] each
-        cfg-changed
+        dup cfg-changed
     ] unless-empty ;

diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index 3fff763c6165539e1d836997989b14a93de32339..a925b0d08074a37c765097f3fb9bf7dd7a3c1363 100644 (file)
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -95,7 +95,7 @@ SYMBOL: temp-locations
 : perform-mappings ( bb to mappings -- )
     dup empty? [ 3drop ] [
         mapping-instructions insert-basic-block
-        cfg get cfg-changed drop
+        cfg get cfg-changed
     ] if ;
 
 : resolve-edge-data-flow ( bb to -- )

diff --git a/basis/compiler/cfg/ssa/cssa/cssa.factor b/basis/compiler/cfg/ssa/cssa/cssa.factor
index 6c2d6587b99c573ae91252eae6b63c619556d405..68b293988646052a086e06bb462a81460d0cf0d7 100644 (file)
--- a/basis/compiler/cfg/ssa/cssa/cssa.factor
+++ b/basis/compiler/cfg/ssa/cssa/cssa.factor
@@ -74,4 +74,4 @@ SYMBOLS: edge-copies phi-copies ;
 
     dup [ convert-phis ] each-basic-block
 
-    cfg-changed drop ;
+    cfg-changed ;

diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor
index 25759781bda1f9660f3e3cfabdfac8da980fbb95..cba8c8e0f74a7cfd9d7e1085a062e8278ea28634 100644 (file)
--- a/basis/compiler/cfg/stacks/finalize/finalize.factor
+++ b/basis/compiler/cfg/stacks/finalize/finalize.factor
@@ -56,4 +56,4 @@ ERROR: bad-peek dst loc ;
 
     dup [ visit-block ] each-basic-block
 
-    cfg-changed ;
+    dup cfg-changed ;

diff --git a/basis/compiler/cfg/tco/tco.factor b/basis/compiler/cfg/tco/tco.factor
index 06bdab7889e3893374837a5022d3b113a2a23365..c2117f9317989f14be11aeac7768befc81d12b4d 100644 (file)
--- a/basis/compiler/cfg/tco/tco.factor
+++ b/basis/compiler/cfg/tco/tco.factor
@@ -72,6 +72,6 @@ IN: compiler.cfg.tco
     ] [ drop ] if ;
 
 : optimize-tail-calls ( cfg -- )
-    dup [ optimize-tail-call ] each-basic-block
-
-    cfg-changed predecessors-changed drop ;
+    [ [ optimize-tail-call ] each-basic-block ]
+    [ cfg-changed ]
+    [ predecessors-changed ] tri ;

diff --git a/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor b/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor
index 126f4892dd2b3e8c10bf0bb59c69288b68b849c7..d2f7c1aa2f7f86ded4bf29f49197277ab56e1d22 100644 (file)
--- a/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor
+++ b/basis/compiler/cfg/useless-conditionals/useless-conditionals.factor
@@ -26,8 +26,9 @@ IN: compiler.cfg.useless-conditionals
     instructions>> [ pop* ] [ [ ##branch new-insn ] dip push ] bi ;
 
 : delete-useless-conditionals ( cfg -- )
-    dup [
-        dup delete-conditional? [ delete-conditional ] [ drop ] if
-    ] each-basic-block
-
-    cfg-changed predecessors-changed drop ;
+    [
+        [
+            dup delete-conditional? [ delete-conditional ] [ drop ] if
+        ] each-basic-block
+    ]
+    [ cfg-changed ] [ predecessors-changed ] tri ;

diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor
index 38296c56011a4ad098d3ac5d1b6b314dbed03c71..920542bedae5cadf993a6c23d2796c8e405fda52 100644 (file)
--- a/basis/compiler/cfg/value-numbering/value-numbering.factor
+++ b/basis/compiler/cfg/value-numbering/value-numbering.factor
@@ -53,5 +53,6 @@ M: array process-instruction
     [ process-instruction ] map flatten ;
 
 : value-numbering ( cfg -- )
-    dup [ value-numbering-step ] simple-optimization
-    cfg-changed predecessors-changed drop ;
+    [ [ value-numbering-step ] simple-optimization ]
+    [ cfg-changed ]
+    [ predecessors-changed ] tri ;

diff --git a/extra/compiler/cfg/gvn/gvn.factor b/extra/compiler/cfg/gvn/gvn.factor
index 0486058d37d6022ebee378395fccf9c410ebcf40..c172aa644c86e4a083ded97cf23499daa61ed99f 100644 (file)
--- a/extra/compiler/cfg/gvn/gvn.factor
+++ b/extra/compiler/cfg/gvn/gvn.factor
@@ -121,5 +121,4 @@ M: insn gcse
     needs-predecessors
     dup determine-value-numbers
     dup eliminate-common-subexpressions
-
-    cfg-changed predecessors-changed ;
+    [ cfg-changed ] [ predecessors-changed ] bi ;