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

diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor
index 39faa05790dc84f769ae23efeadc392f57bbecd2..0649923b16b729c16958209e14d5af450ae1f4f0 100644 (file)
--- a/basis/compiler/cfg/block-joining/block-joining.factor
+++ b/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
-compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
-compiler.cfg.predecessors compiler.cfg.utilities ;
+USING: accessors combinators combinators.short-circuit compiler.utilities
+compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
+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
-    [
-        post-order [
-            dup join-block?
-            [ dup predecessor join-block ] [ drop ] if
-        ] each
-    ] [ cfg-changed ] [ predecessors-changed ] tri ;
+    {
+        [ needs-predecessors ]
+        [
+            post-order [
+                dup join-block?
+                [ dup predecessor join-block ] [ drop ] if
+            ] each
+        ]
+        [ cfg-changed ]
+        [ predecessors-changed ]
+    } cleave ;

diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor b/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor
index 4785fd812997cf297b9d4adee231c0c25e76d559..4c29a1c6138afbcfd0f9726fda83a00f9334497a 100644 (file)
--- a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor
+++ b/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
-    split-branches
-    check-predecessors ;
+    [ needs-predecessors ] [ split-branches ] [ check-predecessors ] tri ;
 
 : test-branch-splitting ( -- )
     0 get block>cfg check-branch-splitting ;

diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting.factor b/basis/compiler/cfg/branch-splitting/branch-splitting.factor
index f323ed4afd91c53bf2d7556b138f1b50a70509d5..80f57e116ae636964a9707a898948d09f308cae2 100644 (file)
--- a/basis/compiler/cfg/branch-splitting/branch-splitting.factor
+++ b/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
-    ! For back-edge?
-    dup post-order drop
-
-    worklist get [
-        dup split-branch? [ dup split-branch ] when
-        successors>> [ add-to-worklist ] each
-    ] slurp-deque
-
-    cfg-changed ;
+    {
+        [ needs-predecessors ]
+        [ init-worklist ]
+        [
+            ! For back-edge?
+            post-order drop
+            worklist get [
+                dup split-branch? [ dup split-branch ] when
+                successors>> [ add-to-worklist ] each
+            ] slurp-deque
+        ]
+        [ cfg-changed ]
+    } cleave ;

diff --git a/basis/compiler/cfg/copy-prop/copy-prop.factor b/basis/compiler/cfg/copy-prop/copy-prop.factor
index 795028806af9645c505c219a9a7774b74a66c9db..e65b25d4fa42677a759fbf95353994118f838e9d 100644 (file)
--- a/basis/compiler/cfg/copy-prop/copy-prop.factor
+++ b/basis/compiler/cfg/copy-prop/copy-prop.factor
@@ -120,7 +120,9 @@ PRIVATE>
 USE: compiler.cfg
 
 : copy-propagation ( cfg -- )
-    needs-predecessors
-    dup collect-copies
-    dup rename-copies
-    predecessors-changed ;
+    {
+        [ needs-predecessors ]
+        [ collect-copies ]
+        [ rename-copies ]
+        [ predecessors-changed ]
+    } cleave ;

diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
index 30017f87ec80b9d0e1146d0c332e8f1db4d837df..e227ca0f6145b78305ff925d25ace31fd8c69676 100644 (file)
--- a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
+++ b/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

diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor
index 456cb07827f67256ff7749d074214989d0ae43d7..0cf4b111360992bf6db766455fe1614bb623bdc9 100644 (file)
--- a/basis/compiler/cfg/dce/dce.factor
+++ b/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
-
-    init-dead-code
-    [ [ [ build-liveness-graph ] each ] simple-analysis ]
-    [ [ [ compute-live-vregs ] each ] simple-analysis ]
-    [ [ [ live-insn? ] filter! ] simple-optimization ]
-    tri ;
+    {
+        [ needs-predecessors ]
+        [ [ [ build-liveness-graph ] each ] simple-analysis ]
+        [ [ [ compute-live-vregs ] each ] simple-analysis ]
+        [ [ [ live-insn? ] filter! ] simple-optimization ]
+    } cleave ;

diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor
index 8d8b868f3d0b82813cc6eb10f3b4ebde7469886a..86742574d3d929309ad2ae6312cdec6dd970d9fd 100644 (file)
--- a/basis/compiler/cfg/dominance/dominance.factor
+++ b/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 ;
 

diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor
index a73f94a235f09787edc8532837327077425dcfac..cb929fb47d7c699032cc71a756e41d6db5076454 100644 (file)
--- a/basis/compiler/cfg/gc-checks/gc-checks.factor
+++ b/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 ;

diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index a925b0d08074a37c765097f3fb9bf7dd7a3c1363..c52382c9795c9574ab3520863f66b7fafda3d3ec 100644 (file)
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/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 ;

diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor
index a113ac277a5677855513358b1d5403d2ba0a5fea..365427168479ecfdb069d9a32d971355eb2a0694 100644 (file)
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/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)

diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor
index 82002fea71b2874db3a86b272e52b0a486d3cc6a..5eaf3446f7dce0b6574e86905e09d824c605d664 100644 (file)
--- a/basis/compiler/cfg/liveness/liveness.factor
+++ b/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? ;

diff --git a/basis/compiler/cfg/loop-detection/loop-detection.factor b/basis/compiler/cfg/loop-detection/loop-detection.factor
index 34693046e4d8caca3fc23d9c842d0f48e13338ba..f0fdc7c61e08185cc0ab54197d0f0ec2024f9e44 100644 (file)
--- a/basis/compiler/cfg/loop-detection/loop-detection.factor
+++ b/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 ;

diff --git a/basis/compiler/cfg/predecessors/predecessors-docs.factor b/basis/compiler/cfg/predecessors/predecessors-docs.factor
index 1977d727fbbbe59840a8d1702e1485b1bd5e0845..c77d783a8aa45419630c3e65d4651723cf7a8525 100644 (file)
--- a/basis/compiler/cfg/predecessors/predecessors-docs.factor
+++ b/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." } ;

diff --git a/basis/compiler/cfg/predecessors/predecessors.factor b/basis/compiler/cfg/predecessors/predecessors.factor
index 506d4aa46cdc465f90afbdce7d92ec01ab49588e..a329d3ab6ba3f68f522590807f7fdb682efc72d3 100644 (file)
--- a/basis/compiler/cfg/predecessors/predecessors.factor
+++ b/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' )
-    {
-        [ [ V{ } clone >>predecessors drop ] each-basic-block ]
-        [ [ update-predecessors ] each-basic-block ]
-        [ [ update-phis ] each-basic-block ]
-        [ ]
-    } cleave ;
+: compute-predecessors ( cfg -- )
+    [ [ V{ } clone >>predecessors drop ] each-basic-block ]
+    [ [ update-predecessors ] each-basic-block ]
+    [ [ update-phis ] each-basic-block ] tri ;
 
 PRIVATE>
 
-: needs-predecessors ( cfg -- cfg' )
-    dup predecessors-valid?>>
-    [ compute-predecessors t >>predecessors-valid? ] unless ;
+: needs-predecessors ( cfg -- )
+    dup predecessors-valid?>> [ drop ]
+    [ t >>predecessors-valid? compute-predecessors ] if ;

diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor
index 2160ad26e6e7e2f2fe14aa66fa78013f5d48a9d8..2267aa1333aa58ec92eb084a2797d09ed04534fd 100644 (file)
--- a/basis/compiler/cfg/representations/representations.factor
+++ b/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 ]

diff --git a/basis/compiler/cfg/ssa/cssa/cssa.factor b/basis/compiler/cfg/ssa/cssa/cssa.factor
index 68b293988646052a086e06bb462a81460d0cf0d7..ff8521ce3a676606df7aa55a069660623ea7f33f 100644 (file)
--- a/basis/compiler/cfg/ssa/cssa/cssa.factor
+++ b/basis/compiler/cfg/ssa/cssa/cssa.factor
@@ -70,8 +70,6 @@ SYMBOLS: edge-copies phi-copies ;
     tri ;
 
 : construct-cssa ( cfg -- )
-    needs-predecessors
-
-    dup [ convert-phis ] each-basic-block
-
-    cfg-changed ;
+    [ needs-predecessors ]
+    [ [ convert-phis ] each-basic-block ]
+    [ cfg-changed ] tri ;

diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor
index cba8c8e0f74a7cfd9d7e1085a062e8278ea28634..663d6938c73791aac9c4bc25fe3fc3d6a51bbb48 100644 (file)
--- a/basis/compiler/cfg/stacks/finalize/finalize.factor
+++ b/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 [ visit-block ] each-basic-block
-
-    dup cfg-changed ;
+    dup
+    [ needs-predecessors ]
+    [ [ visit-block ] each-basic-block ]
+    [ cfg-changed ] tri ;

diff --git a/extra/compiler/cfg/gvn/gvn.factor b/extra/compiler/cfg/gvn/gvn.factor
index c172aa644c86e4a083ded97cf23499daa61ed99f..959cd7930a9ee76bdfda7470006e7da6b84447cd 100644 (file)
--- a/extra/compiler/cfg/gvn/gvn.factor
+++ b/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 determine-value-numbers
-    dup eliminate-common-subexpressions
-    [ cfg-changed ] [ predecessors-changed ] bi ;
+    dup {
+        [ needs-predecessors ]
+        [ determine-value-numbers ]
+        [ eliminate-common-subexpressions ]
+        [ cfg-changed ]
+        [ predecessors-changed ]
+    } cleave ;

diff --git a/extra/compiler/graphviz/graphviz.factor b/extra/compiler/graphviz/graphviz.factor
index f0b7c85494b3c720cb90a829cae4238acafa79bb..fa268c6db57dff92693d23b6a4eaf597fdbdd27b 100644 (file)
--- a/extra/compiler/graphviz/graphviz.factor
+++ b/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 ;