summaryrefslogtreecommitdiff
path: root/compiler/cmm/ZipDataflow.hs
diff options
context:
space:
mode:
authorNorman Ramsey <nr@eecs.harvard.edu>2007-09-11 15:06:35 +0000
committerNorman Ramsey <nr@eecs.harvard.edu>2007-09-11 15:06:35 +0000
commitc0a5a5d2e41341046aaf37c1d2155372e7ed3ee8 (patch)
tree4d8992c7b35e9945042645c2bbb5739fb73a4ef5 /compiler/cmm/ZipDataflow.hs
parent8acda75bd98763ac5643a2152960102a4d98122b (diff)
downloadhaskell-c0a5a5d2e41341046aaf37c1d2155372e7ed3ee8.tar.gz
split the CmmGraph constructor interface from the representation
Interface MkZipCfgCmm should now be sufficient for all construction needs, though some identifiers are re-exported from (and explained in) MkZipCfg. ZipCfgCmmRep should be used only by modules involved in analysis, optimization, or translation of Cmm programs.
Diffstat (limited to 'compiler/cmm/ZipDataflow.hs')
-rw-r--r--compiler/cmm/ZipDataflow.hs62
1 files changed, 32 insertions, 30 deletions
diff --git a/compiler/cmm/ZipDataflow.hs b/compiler/cmm/ZipDataflow.hs
index 8a8315ff24..2ce7a25eb9 100644
--- a/compiler/cmm/ZipDataflow.hs
+++ b/compiler/cmm/ZipDataflow.hs
@@ -1,5 +1,5 @@
{-# OPTIONS -Wall -fno-warn-name-shadowing #-}
-{-# LANGUAGE ScopedTypeVariables, MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
module ZipDataflow
( Answer(..)
, BComputation(..), BAnalysis, BTransformation, BFunctionalTransformation
@@ -177,9 +177,9 @@ It's possible we could make these things more regular.
-- | The analysis functions set properties on unique IDs.
-run_b_anal :: forall m l a . (DebugNodes m l, LastNode l, Outputable a) =>
+run_b_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
BAnalysis m l a -> LGraph m l -> DFA a ()
-run_f_anal :: forall m l a . (DebugNodes m l, LastNode l, Outputable a) =>
+run_f_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
FAnalysis m l a -> a -> LGraph m l -> DFA a ()
-- ^ extra parameter is the entry fact
@@ -208,10 +208,10 @@ fold_edge_facts_with_nodes_b :: LastNode l
class (Outputable m, Outputable l, LastNode l, Outputable (LGraph m l)) => DebugNodes m l
-refine_f_anal :: forall m l a . (DebugNodes m l, LastNode l, Outputable a) =>
+refine_f_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
FAnalysis m l a -> LGraph m l -> DFA a () -> DFA a ()
-refine_b_anal :: forall m l a . (DebugNodes m l, LastNode l, Outputable a) =>
+refine_b_anal :: (DebugNodes m l, LastNode l, Outputable a) =>
BAnalysis m l a -> LGraph m l -> DFA a () -> DFA a ()
b_rewrite :: (DebugNodes m l, Outputable a) =>
@@ -352,14 +352,14 @@ comp_with_exit_b comp exit_fact =
-- Rewrite should always use exactly one of these monadic operations.
solve_graph_b ::
- forall m l a . (DebugNodes m l, Outputable a) =>
- BPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, a)
+ (DebugNodes m l, Outputable a) =>
+ BPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, a)
solve_graph_b comp fuel graph exit_fact =
general_backward (comp_with_exit_b comp exit_fact) fuel graph
where
- general_backward :: BPass m l a -> OptimizationFuel -> G.LGraph m l -> DFM a (OptimizationFuel, a)
+ -- general_backward :: BPass m l a -> OptimizationFuel -> G.LGraph m l -> DFM a (OptimizationFuel, a)
general_backward comp fuel graph =
- let set_block_fact :: OptimizationFuel -> G.Block m l -> DFM a OptimizationFuel
+ let -- set_block_fact :: OptimizationFuel -> G.Block m l -> DFM a OptimizationFuel
set_block_fact fuel b =
do { (fuel, block_in) <-
let (h, l) = G.goto_end (G.unzip b) in
@@ -423,8 +423,8 @@ The tail is in final form; the head is still to be rewritten.
-}
solve_and_rewrite_b ::
- forall m l a. (DebugNodes m l, Outputable a) =>
- BPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
+ (DebugNodes m l, Outputable a) =>
+ BPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
solve_and_rewrite_b comp fuel graph exit_fact =
do { (_, a) <- solve_graph_b comp fuel graph exit_fact -- pass 1
@@ -441,9 +441,9 @@ solve_and_rewrite_b comp fuel graph exit_fact =
eid = G.gr_entry graph
backward_rewrite comp fuel graph =
rewrite_blocks comp fuel emptyBlockEnv $ reverse (G.postorder_dfs graph)
- rewrite_blocks ::
- BPass m l a -> OptimizationFuel ->
- BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel,G.LGraph m l)
+ -- rewrite_blocks ::
+ -- BPass m l a -> OptimizationFuel ->
+ -- BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel,G.LGraph m l)
rewrite_blocks _comp fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
rewrite_blocks comp fuel rewritten (b:bs) =
let rewrite_next_block fuel =
@@ -460,8 +460,8 @@ solve_and_rewrite_b comp fuel graph exit_fact =
; -- continue at entry of g
propagate fuel h a t rewritten'
}
- propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l ->
- BlockEnv (Block m l) -> DFM a (OptimizationFuel, G.LGraph m l)
+ -- propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l ->
+ -- BlockEnv (Block m l) -> DFM a (OptimizationFuel, G.LGraph m l)
propagate fuel (G.ZHead h m) out tail rewritten =
bc_middle_in comp out m fuel >>= \x -> case x of
Dataflow a -> propagate fuel h a (G.ZTail m tail) rewritten
@@ -612,9 +612,9 @@ comp_with_exit_f comp exit_fact_id = comp { fc_exit_outs = exit_outs }
-- | Given [[comp_with_exit_f]], we can now solve a graph simply by doing a
-- forward analysis on the modified computation.
solve_graph_f ::
- forall m l a . (DebugNodes m l, Outputable a) =>
- FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
- DFM a (OptimizationFuel, a, LastOutFacts a)
+ (DebugNodes m l, Outputable a) =>
+ FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
+ DFM a (OptimizationFuel, a, LastOutFacts a)
solve_graph_f comp fuel g in_fact =
do { exit_fact_id <- freshBlockId "proxy for exit node"
; fuel <- general_forward (comp_with_exit_f comp exit_fact_id) fuel in_fact g
@@ -623,11 +623,11 @@ solve_graph_f comp fuel g in_fact =
; forgetFact exit_fact_id -- close space leak
; return (fuel, a, LastOutFacts outs) }
where
- general_forward :: FPass m l a -> OptimizationFuel -> a -> G.LGraph m l -> DFM a OptimizationFuel
+ -- general_forward :: FPass m l a -> OptimizationFuel -> a -> G.LGraph m l -> DFM a OptimizationFuel
general_forward comp fuel entry_fact graph =
let blocks = G.postorder_dfs g
is_local id = isJust $ lookupBlockEnv (G.gr_blocks g) id
- set_or_save :: LastOutFacts a -> DFM a ()
+ -- set_or_save :: LastOutFacts a -> DFM a ()
set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
set_or_save_one (id, a) =
if is_local id then setFact id a else addLastOutFact (id, a)
@@ -677,8 +677,9 @@ between a head and tail.
The tail is in final form; the head is still to be rewritten.
-}
solve_and_rewrite_f ::
- forall m l a . (DebugNodes m l, Outputable a) =>
- FPass m l a -> OptimizationFuel -> LGraph m l -> a -> DFM a (OptimizationFuel, a, LGraph m l)
+ (DebugNodes m l, Outputable a) =>
+ FPass m l a -> OptimizationFuel -> LGraph m l -> a ->
+ DFM a (OptimizationFuel, a, LGraph m l)
solve_and_rewrite_f comp fuel graph in_fact =
do solve_graph_f comp fuel graph in_fact -- pass 1
exit_id <- freshBlockId "proxy for exit node"
@@ -687,22 +688,23 @@ solve_and_rewrite_f comp fuel graph in_fact =
return (fuel, exit_fact, g)
forward_rewrite ::
- forall m l a . (DebugNodes m l, Outputable a) =>
- FPass m l a -> OptimizationFuel -> G.LGraph m l -> a -> DFM a (OptimizationFuel, G.LGraph m l)
+ (DebugNodes m l, Outputable a) =>
+ FPass m l a -> OptimizationFuel -> G.LGraph m l -> a ->
+ DFM a (OptimizationFuel, G.LGraph m l)
forward_rewrite comp fuel graph entry_fact =
do setFact eid entry_fact
rewrite_blocks fuel emptyBlockEnv (G.postorder_dfs graph)
where
eid = G.gr_entry graph
is_local id = isJust $ lookupBlockEnv (G.gr_blocks graph) id
- set_or_save :: LastOutFacts a -> DFM a ()
+ -- set_or_save :: LastOutFacts a -> DFM a ()
set_or_save (LastOutFacts l) = mapM_ set_or_save_one l
set_or_save_one (id, a) =
if is_local id then checkFactMatch id a
else panic "set fact outside graph during rewriting pass?!"
- rewrite_blocks ::
- OptimizationFuel -> BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel, LGraph m l)
+ -- rewrite_blocks ::
+ -- OptimizationFuel -> BlockEnv (Block m l) -> [Block m l] -> DFM a (OptimizationFuel, LGraph m l)
rewrite_blocks fuel rewritten [] = return (fuel, G.LGraph eid rewritten)
rewrite_blocks fuel rewritten (G.Block id t : bs) =
do id_fact <- getFact id
@@ -712,8 +714,8 @@ forward_rewrite comp fuel graph entry_fact =
Rewrite fg -> do { markGraphRewritten
; rewrite_blocks (fuel-1) rewritten
(G.postorder_dfs (labelGraph id fg) ++ bs) }
- propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l -> BlockEnv (G.Block m l) ->
- [G.Block m l] -> DFM a (OptimizationFuel, G.LGraph m l)
+ -- propagate :: OptimizationFuel -> G.ZHead m -> a -> G.ZTail m l -> BlockEnv (G.Block m l) ->
+ -- [G.Block m l] -> DFM a (OptimizationFuel, G.LGraph m l)
propagate fuel h in' (G.ZTail m t) rewritten bs =
my_trace "Rewriting middle node" (ppr m) $
do fc_middle_out comp in' m fuel >>= \x -> case x of