diff options
Diffstat (limited to 'compiler/cmm/ZipDataflow.hs')
| -rw-r--r-- | compiler/cmm/ZipDataflow.hs | 23 |
1 files changed, 19 insertions, 4 deletions
diff --git a/compiler/cmm/ZipDataflow.hs b/compiler/cmm/ZipDataflow.hs index ba8e75ac64..388d99cc95 100644 --- a/compiler/cmm/ZipDataflow.hs +++ b/compiler/cmm/ZipDataflow.hs @@ -528,8 +528,14 @@ forward_sol check_maybe = forw ; b <- finish ; return (b, fuel) } + -- The need for both k1 and k2 suggests that maybe there's an opportunity -- for improvement here -- in most cases, they're the same... + rec_rewrite :: forall t bI bW. + Maybe (AGraph m l) -> t -> DFM a bW + -> (t -> Fuel -> DFM a bI) + -> (bW -> Fuel -> DFM a bI) + -> a -> Fuel -> DFM a bI rec_rewrite rewritten analyzed finish k1 k2 in' fuel = case check_maybe fuel rewritten of -- fr_first rewrites id idfact of Nothing -> k1 analyzed fuel @@ -589,7 +595,6 @@ forward_rew -> DFM a (ForwardFixedPoint m l a (Graph m l), Fuel) forward_rew check_maybe = forw where - solve = forward_sol check_maybe forw :: RewritingDepth -> BlockEnv a -> PassName @@ -607,7 +612,8 @@ forward_rew check_maybe = forw in_fact `seq` g `seq` let Graph entry blockenv = g blocks = G.postorder_dfs_from blockenv entry - in do { _ <- solve depth name start transfers rewrites in_fact g fuel + in do { _ <- forward_sol check_maybe depth name start + transfers rewrites in_fact g fuel ; eid <- freshBlockId "temporary entry id" ; (rewritten, fuel) <- rew_tail (ZFirst eid) in_fact entry emptyBlockEnv fuel @@ -615,11 +621,18 @@ forward_rew check_maybe = forw ; a <- finish ; return (a, lgraphToGraph (LGraph eid rewritten), fuel) } + + don't_rewrite :: forall t. + BlockEnv a -> DFM a t -> a + -> Graph m l -> Fuel + -> DFM a (t, Graph m l, Fuel) don't_rewrite facts finish in_fact g fuel = - do { _ <- solve depth name facts transfers rewrites in_fact g fuel + do { _ <- forward_sol check_maybe depth name facts + transfers rewrites in_fact g fuel ; a <- finish ; return (a, g, fuel) } + inner_rew :: DFM a f -> a -> Graph m l -> Fuel -> DFM a (f, Graph m l, Fuel) inner_rew f i g fu = getAllFacts >>= \facts -> inner_rew' facts f i g fu where inner_rew' = case depth of RewriteShallow -> don't_rewrite @@ -633,6 +646,7 @@ forward_rew check_maybe = forw ; let fp = FFP cfp last_outs ; return (fp, fuel) } + -- JD: WHY AREN'T WE TAKING ANY FUEL HERE? rewrite_blocks :: [Block m l] -> (BlockEnv (Block m l)) -> Fuel -> DFM a (BlockEnv (Block m l), Fuel) @@ -1028,8 +1042,9 @@ run dir name do_block blocks b = pprFacts depth n env = my_nest depth (text "facts for iteration" <+> pp_i n <+> text "are:" $$ (nest 2 $ vcat $ map pprFact $ blockEnvToList env)) - pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a) +pprFact :: (Outputable a, Outputable b) => (a,b) -> SDoc +pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a) f4sep :: [SDoc] -> SDoc f4sep [] = fsep [] |