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

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 [
+        post-order [
-        dup join-block?
+            dup join-block?
-        [ dup predecessor join-block ] [ drop ] if
+            [ dup predecessor join-block ] [ drop ] if
-    ] each
+        ] each
-
+    ] [ cfg-changed ] [ predecessors-changed ] tri ;
-    cfg-changed predecessors-changed drop ;

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 ;

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 )
+: predecessors-changed ( cfg -- )
-    f >>predecessors-valid? ;
+    f >>predecessors-valid? drop ;
 
 : with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
     [ dup cfg ] dip with-variable ; inline

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 ;

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 ;

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 -- )

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 ;

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 ;

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
+    [ [ optimize-tail-call ] each-basic-block ]
-
+    [ cfg-changed ]
-    cfg-changed predecessors-changed drop ;
+    [ predecessors-changed ] tri ;

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
+            dup delete-conditional? [ delete-conditional ] [ drop ] if
-
+        ] each-basic-block
-    cfg-changed predecessors-changed drop ;
+    ]
+    [ cfg-changed ] [ predecessors-changed ] tri ;

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
+    [ [ value-numbering-step ] simple-optimization ]
-    cfg-changed predecessors-changed drop ;
+    [ cfg-changed ]
+    [ predecessors-changed ] tri ;

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 ] bi ;
-    cfg-changed predecessors-changed ;