compiler.cfg.*: changed stack effect of needs-predecessors from ( cfg -- cfg') to ( cfg -- )

basis/compiler/cfg/block-joining/block-joining.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.short-circuit kernel sequences math
+USING: accessors combinators combinators.short-circuit compiler.utilities
-compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
+compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
-compiler.cfg.predecessors compiler.cfg.utilities ;
+compiler.cfg.predecessors compiler.cfg.utilities kernel math sequences ;
 IN: compiler.cfg.block-joining
 
 ! Joining blocks that are not calls and are connected by a single CFG edge.
@@ -27,10 +27,14 @@ IN: compiler.cfg.block-joining
     [ join-instructions ] [ update-successors ] 2bi ;
 
 : join-blocks ( cfg -- )
-    needs-predecessors
+    {
-    [
+        [ needs-predecessors ]
-        post-order [
+        [
-            dup join-block?
+            post-order [
-            [ dup predecessor join-block ] [ drop ] if
+                dup join-block?
-        ] each
+                [ dup predecessor join-block ] [ drop ] if
-    ] [ cfg-changed ] [ predecessors-changed ] tri ;
+            ] each
+        ]
+        [ cfg-changed ]
+        [ predecessors-changed ]
+    } cleave ;

basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor

@@ -9,13 +9,11 @@ IN: compiler.cfg.branch-splitting.tests
 
 : check-predecessors ( cfg -- )
     [ get-predecessors ]
-    [ needs-predecessors drop ]
+    [ needs-predecessors ]
     [ get-predecessors ] tri assert= ;
 
 : check-branch-splitting ( cfg -- )
-    needs-predecessors
+    [ needs-predecessors ] [ split-branches ] [ check-predecessors ] tri ;
-    split-branches
-    check-predecessors ;
 
 : test-branch-splitting ( -- )
     0 get block>cfg check-branch-splitting ;

basis/compiler/cfg/branch-splitting/branch-splitting.factor

@@ -94,14 +94,16 @@ SYMBOL: visited
     entry>> add-to-worklist ;
 
 : split-branches ( cfg -- )
-    needs-predecessors
+    {
-    dup init-worklist
+        [ needs-predecessors ]
-    ! For back-edge?
+        [ init-worklist ]
-    dup post-order drop
+        [
-
+            ! For back-edge?
-    worklist get [
+            post-order drop
-        dup split-branch? [ dup split-branch ] when
+            worklist get [
-        successors>> [ add-to-worklist ] each
+                dup split-branch? [ dup split-branch ] when
-    ] slurp-deque
+                successors>> [ add-to-worklist ] each
-
+            ] slurp-deque
-    cfg-changed ;
+        ]
+        [ cfg-changed ]
+    } cleave ;

basis/compiler/cfg/copy-prop/copy-prop.factor

@@ -120,7 +120,9 @@ PRIVATE>
 USE: compiler.cfg
 
 : copy-propagation ( cfg -- )
-    needs-predecessors
+    {
-    dup collect-copies
+        [ needs-predecessors ]
-    dup rename-copies
+        [ collect-copies ]
-    predecessors-changed ;
+        [ rename-copies ]
+        [ predecessors-changed ]
+    } cleave ;

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

@@ -47,7 +47,7 @@ MIXIN: dataflow-analysis
     ] when ; inline
 
 :: run-dataflow-analysis ( cfg dfa -- in-sets out-sets )
-    cfg needs-predecessors drop
+    cfg needs-predecessors
     H{ } clone :> in-sets
     H{ } clone :> out-sets
     cfg dfa <dfa-worklist> :> work-list

basis/compiler/cfg/dce/dce.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2010 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs kernel namespaces sequences
+USING: accessors arrays assocs kernel namespaces sequences combinators
 compiler.cfg.instructions compiler.cfg.def-use
 compiler.cfg.rpo compiler.cfg.predecessors hash-sets sets ;
 FROM: assocs => change-at ;
@@ -116,13 +116,13 @@ M: flushable-insn live-insn? defs-vregs [ live-vreg? ] any? ;
 M: insn live-insn? drop t ;
 
 : eliminate-dead-code ( cfg -- )
+    init-dead-code
     ! Even though we don't use predecessors directly, we depend
     ! on the predecessors pass updating phi nodes to remove dead
     ! inputs.
-    needs-predecessors
+    {
-
+        [ needs-predecessors ]
-    init-dead-code
+        [ [ [ build-liveness-graph ] each ] simple-analysis ]
-    [ [ [ build-liveness-graph ] each ] simple-analysis ]
+        [ [ [ compute-live-vregs ] each ] simple-analysis ]
-    [ [ [ compute-live-vregs ] each ] simple-analysis ]
+        [ [ [ live-insn? ] filter! ] simple-optimization ]
-    [ [ [ live-insn? ] filter! ] simple-optimization ]
+    } cleave ;
-    tri ;

basis/compiler/cfg/dominance/dominance.factor

@@ -79,7 +79,7 @@ PRIVATE>
 PRIVATE>
 
 : needs-dominance ( cfg -- )
-    needs-predecessors
+    dup needs-predecessors
     dup dominance-valid?>> [ compute-dominance t >>dominance-valid? ] unless
     drop ;
 

basis/compiler/cfg/gc-checks/gc-checks.factor

@@ -129,7 +129,7 @@ PRIVATE>
 
 : insert-gc-checks ( cfg -- cfg' )
     dup blocks-with-gc [
-        [ needs-predecessors ] dip
+        [ dup needs-predecessors ] dip
         [ process-block ] each
         dup cfg-changed
     ] unless-empty ;

basis/compiler/cfg/linear-scan/resolve/resolve.factor

@@ -107,6 +107,6 @@ SYMBOL: temp-locations
     ] if ;
 
 : resolve-data-flow ( cfg -- )
-    needs-predecessors
     init-resolve
-    [ resolve-block-data-flow ] each-basic-block ;
+    [ needs-predecessors ]
+    [ [ resolve-block-data-flow ] each-basic-block ] bi ;

basis/compiler/cfg/linearization/linearization.factor

@@ -75,7 +75,7 @@ SYMBOLS: work-list loop-heads visited ;
 PRIVATE>
 
 : linearization-order ( cfg -- bbs )
-    needs-post-order needs-loops needs-predecessors
+    needs-post-order needs-loops dup needs-predecessors
 
     dup linear-order>> [ ] [
         dup (linearization-order)

basis/compiler/cfg/liveness/liveness.factor

@@ -158,15 +158,15 @@ SYMBOL: work-list
     ] [ drop ] if ;
 
 : compute-live-sets ( cfg -- )
-    needs-predecessors
-    dup compute-insns
-
     <hashed-dlist> work-list set
     H{ } clone live-ins set
     H{ } clone edge-live-ins set
     H{ } clone live-outs set
     H{ } clone base-pointers set
-    post-order add-to-work-list
+
+    [ needs-predecessors ]
+    [ compute-insns ]
+    [ post-order add-to-work-list ] tri
     work-list get [ liveness-step ] slurp-deque ;
 
 : live-in? ( vreg bb -- ? ) live-in key? ;

basis/compiler/cfg/loop-detection/loop-detection.factor

@@ -63,12 +63,13 @@ SYMBOL: loop-nesting
     ] keep loop-nesting set ;
 
 : detect-loops ( cfg -- cfg' )
-    needs-predecessors
     H{ } clone loops set
     HS{ } clone visited set
     HS{ } clone active set
     H{ } clone loop-nesting set
-    dup entry>> find-loop-headers process-loop-headers compute-loop-nesting ;
+    [ needs-predecessors ]
+    [ entry>> find-loop-headers process-loop-headers compute-loop-nesting ]
+    [ ] tri ;
 
 PRIVATE>
 
@@ -77,5 +78,5 @@ PRIVATE>
 : current-loop-nesting ( -- n ) basic-block get loop-nesting-at ;
 
 : needs-loops ( cfg -- cfg' )
-    needs-predecessors
+    dup needs-predecessors
     dup loops-valid?>> [ detect-loops t >>loops-valid? ] unless ;

basis/compiler/cfg/predecessors/predecessors-docs.factor

@@ -2,5 +2,5 @@ USING: compiler.cfg help.markup help.syntax kernel ;
 IN: compiler.cfg.predecessors
 
 HELP: needs-predecessors
-{ $values { "cfg" cfg } { "cfg'" cfg } }
+{ $values { "cfg" cfg } }
 { $description "Computes predecessor info for the cfg unless it already is up-to-date." } ;

basis/compiler/cfg/predecessors/predecessors.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors combinators fry sequences assocs compiler.cfg.rpo
+USING: kernel accessors fry sequences assocs compiler.cfg.rpo
 compiler.cfg.instructions compiler.cfg.utilities ;
 IN: compiler.cfg.predecessors
 
@@ -18,16 +18,13 @@ IN: compiler.cfg.predecessors
 : update-phis ( bb -- )
     dup [ update-phi ] with each-phi ;
 
-: compute-predecessors ( cfg -- cfg' )
+: compute-predecessors ( cfg -- )
-    {
+    [ [ V{ } clone >>predecessors drop ] each-basic-block ]
-        [ [ V{ } clone >>predecessors drop ] each-basic-block ]
+    [ [ update-predecessors ] each-basic-block ]
-        [ [ update-predecessors ] each-basic-block ]
+    [ [ update-phis ] each-basic-block ] tri ;
-        [ [ update-phis ] each-basic-block ]
-        [ ]
-    } cleave ;
 
 PRIVATE>
 
-: needs-predecessors ( cfg -- cfg' )
+: needs-predecessors ( cfg -- )
-    dup predecessors-valid?>>
+    dup predecessors-valid?>> [ drop ]
-    [ compute-predecessors t >>predecessors-valid? ] unless ;
+    [ t >>predecessors-valid? compute-predecessors ] if ;

basis/compiler/cfg/representations/representations.factor

@@ -18,9 +18,8 @@ IN: compiler.cfg.representations
 
 : select-representations ( cfg -- cfg' )
     needs-loops
-    needs-predecessors
-
     {
+        [ needs-predecessors ]
         [ compute-components ]
         [ compute-possibilities ]
         [ compute-representations ]

basis/compiler/cfg/ssa/cssa/cssa.factor

@@ -70,8 +70,6 @@ SYMBOLS: edge-copies phi-copies ;
     tri ;
 
 : construct-cssa ( cfg -- )
-    needs-predecessors
+    [ needs-predecessors ]
-
+    [ [ convert-phis ] each-basic-block ]
-    dup [ convert-phis ] each-basic-block
+    [ cfg-changed ] tri ;
-
-    cfg-changed ;

basis/compiler/cfg/stacks/finalize/finalize.factor

@@ -52,8 +52,7 @@ ERROR: bad-peek dst loc ;
     [ predecessors>> ] keep '[ _ visit-edge ] each ;
 
 : finalize-stack-shuffling ( cfg -- cfg' )
-    needs-predecessors
+    dup
-
+    [ needs-predecessors ]
-    dup [ visit-block ] each-basic-block
+    [ [ visit-block ] each-basic-block ]
-
+    [ cfg-changed ] tri ;
-    dup cfg-changed ;

extra/compiler/cfg/gvn/gvn.factor

@@ -4,6 +4,7 @@ USING: namespaces arrays assocs hashtables kernel accessors fry
 grouping sorting sets sequences locals
 cpu.architecture
 sequences.deep
+combinators
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.def-use
@@ -118,7 +119,10 @@ M: insn gcse
     [ gcse-step ] simple-optimization ;
 
 : value-numbering ( cfg -- cfg )
-    needs-predecessors
+    dup {
-    dup determine-value-numbers
+        [ needs-predecessors ]
-    dup eliminate-common-subexpressions
+        [ determine-value-numbers ]
-    [ cfg-changed ] [ predecessors-changed ] bi ;
+        [ eliminate-common-subexpressions ]
+        [ cfg-changed ]
+        [ predecessors-changed ]
+    } cleave ;

extra/compiler/graphviz/graphviz.factor

@@ -90,7 +90,7 @@ IN: compiler.graphviz
 : dom-trees ( cfgs -- )
     [
         [
-            needs-dominance drop
+            needs-dominance
             dom-childrens get [
                 [
                     bb-edge,
@@ -125,7 +125,7 @@ SYMBOL: vertex-names
         {
             [ { } call-graph-edge, ]
             [ [ vertex-name ] [ label>> loop?>> { "shape=box" } { } ? ] bi node-style, ]
-            [ [ vertex-name ] [ calls>> ] bi (call-graph-back-edges) ] 
+            [ [ vertex-name ] [ calls>> ] bi (call-graph-back-edges) ]
             [ [ vertex-name ] [ children>> ] bi (call-graph-edges) ]
         } cleave
     ] with each ;