Commit 02f2f21c authored by Michal Terepeta's avatar Michal Terepeta Committed by Ben Gamari

cmm/Hoopl/Dataflow: remove unused code

We had *a lot* of code copied from Hoopl that is for rewriting. But GHC
doesn't use it (it only uses some forked Hoopl code for analysis).

So we can safely kill all this code and make it much easier to refactor
and improve the parts that we do use.
Signed-off-by: Michal Terepeta's avatarMichal Terepeta <michal.terepeta@gmail.com>

Test Plan: ./validate

Reviewers: austin, simonmar, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2612
parent 3866481f
......@@ -58,8 +58,8 @@ module CmmUtils(
toBlockListEntryFirst, toBlockListEntryFirstFalseFallthrough,
foldGraphBlocks, mapGraphNodes, postorderDfs, mapGraphNodes1,
analFwd, analBwd, analRewFwd, analRewBwd,
dataflowPassFwd, dataflowPassBwd, dataflowAnalFwd, dataflowAnalBwd,
analFwd, analBwd,
dataflowAnalFwd, dataflowAnalBwd,
dataflowAnalFwdBlocks,
-- * Ticks
......@@ -565,30 +565,10 @@ postorderDfs g = {-# SCC "postorderDfs" #-} postorder_dfs_from (toBlockMap g) (g
analFwd :: DataflowLattice f -> FwdTransfer n f -> FwdPass UniqSM n f
analBwd :: DataflowLattice f -> BwdTransfer n f -> BwdPass UniqSM n f
analFwd lat xfer = analRewFwd lat xfer noFwdRewrite
analBwd lat xfer = analRewBwd lat xfer noBwdRewrite
-- Constructing forward and backward analysis + rewrite pass
analRewFwd :: DataflowLattice f -> FwdTransfer n f
-> FwdRewrite UniqSM n f
-> FwdPass UniqSM n f
analRewBwd :: DataflowLattice f
-> BwdTransfer n f
-> BwdRewrite UniqSM n f
-> BwdPass UniqSM n f
analRewFwd lat xfer rew = FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = rew}
analRewBwd lat xfer rew = BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = rew}
-- Running forward and backward dataflow analysis + optional rewrite
dataflowPassFwd :: NonLocal n =>
GenCmmGraph n -> [(BlockId, f)]
-> FwdPass UniqSM n f
-> UniqSM (GenCmmGraph n, BlockEnv f)
dataflowPassFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
(graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
analFwd lat xfer =
FwdPass {fp_lattice = lat, fp_transfer = xfer, fp_rewrite = noFwdRewrite}
analBwd lat xfer =
BwdPass {bp_lattice = lat, bp_transfer = xfer, bp_rewrite = noBwdRewrite}
dataflowAnalFwd :: NonLocal n =>
GenCmmGraph n -> [(BlockId, f)]
......@@ -613,14 +593,6 @@ dataflowAnalBwd :: NonLocal n =>
dataflowAnalBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd =
analyzeBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
dataflowPassBwd :: NonLocal n =>
GenCmmGraph n -> [(BlockId, f)]
-> BwdPass UniqSM n f
-> UniqSM (GenCmmGraph n, BlockEnv f)
dataflowPassBwd (CmmGraph {g_entry=entry, g_graph=graph}) facts bwd = do
(graph, facts, NothingO) <- analyzeAndRewriteBwd bwd (JustC [entry]) graph (mkFactBase (bp_lattice bwd) facts)
return (CmmGraph {g_entry=entry, g_graph=graph}, facts)
-------------------------------------------------
-- Tick utilities
......
......@@ -3,9 +3,6 @@
module Hoopl (
module Compiler.Hoopl,
module Hoopl.Dataflow,
deepFwdRw, deepFwdRw3,
deepBwdRw, deepBwdRw3,
thenFwdRw
) where
import Compiler.Hoopl hiding
......@@ -23,109 +20,6 @@ import Compiler.Hoopl hiding
)
import Hoopl.Dataflow
import Control.Monad
import UniqSupply
deepFwdRw3 :: (n C O -> f -> UniqSM (Maybe (Graph n C O)))
-> (n O O -> f -> UniqSM (Maybe (Graph n O O)))
-> (n O C -> f -> UniqSM (Maybe (Graph n O C)))
-> (FwdRewrite UniqSM n f)
deepFwdRw :: (forall e x . n e x -> f -> UniqSM (Maybe (Graph n e x))) -> FwdRewrite UniqSM n f
deepFwdRw3 f m l = iterFwdRw $ mkFRewrite3 f m l
deepFwdRw f = deepFwdRw3 f f f
-- N.B. rw3, rw3', and rw3a are triples of functions.
-- But rw and rw' are single functions.
thenFwdRw :: forall n f.
FwdRewrite UniqSM n f
-> FwdRewrite UniqSM n f
-> FwdRewrite UniqSM n f
thenFwdRw rw3 rw3' = wrapFR2 thenrw rw3 rw3'
where
thenrw :: forall e x t t1.
(t -> t1 -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
-> (t -> t1 -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
-> t
-> t1
-> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f))
thenrw rw rw' n f = rw n f >>= fwdRes
where fwdRes Nothing = rw' n f
fwdRes (Just gr) = return $ Just $ fadd_rw rw3' gr
iterFwdRw :: forall n f.
FwdRewrite UniqSM n f
-> FwdRewrite UniqSM n f
iterFwdRw rw3 = wrapFR iter rw3
where iter :: forall a e x t.
(t -> a -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
-> t
-> a
-> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f))
iter rw n = (liftM $ liftM $ fadd_rw (iterFwdRw rw3)) . rw n
-- | Function inspired by 'rew' in the paper
_frewrite_cps :: ((Graph n e x, FwdRewrite UniqSM n f) -> UniqSM a)
-> UniqSM a
-> (forall e x . n e x -> f -> UniqSM (Maybe (Graph n e x, FwdRewrite UniqSM n f)))
-> n e x
-> f
-> UniqSM a
_frewrite_cps j n rw node f =
do mg <- rw node f
case mg of Nothing -> n
Just gr -> j gr
-- | Function inspired by 'add' in the paper
fadd_rw :: FwdRewrite UniqSM n f
-> (Graph n e x, FwdRewrite UniqSM n f)
-> (Graph n e x, FwdRewrite UniqSM n f)
fadd_rw rw2 (g, rw1) = (g, rw1 `thenFwdRw` rw2)
deepBwdRw3 ::
(n C O -> f -> UniqSM (Maybe (Graph n C O)))
-> (n O O -> f -> UniqSM (Maybe (Graph n O O)))
-> (n O C -> FactBase f -> UniqSM (Maybe (Graph n O C)))
-> (BwdRewrite UniqSM n f)
deepBwdRw :: (forall e x . n e x -> Fact x f -> UniqSM (Maybe (Graph n e x)))
-> BwdRewrite UniqSM n f
deepBwdRw3 f m l = iterBwdRw $ mkBRewrite3 f m l
deepBwdRw f = deepBwdRw3 f f f
thenBwdRw :: forall n f. BwdRewrite UniqSM n f -> BwdRewrite UniqSM n f -> BwdRewrite UniqSM n f
thenBwdRw rw1 rw2 = wrapBR2 f rw1 rw2
where f :: forall t t1 t2 e x.
t
-> (t1 -> t2 -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f)))
-> (t1 -> t2 -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f)))
-> t1
-> t2
-> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f))
f _ rw1 rw2' n f = do
res1 <- rw1 n f
case res1 of
Nothing -> rw2' n f
Just gr -> return $ Just $ badd_rw rw2 gr
iterBwdRw :: forall n f. BwdRewrite UniqSM n f -> BwdRewrite UniqSM n f
iterBwdRw rw = wrapBR f rw
where f :: forall t e x t1 t2.
t
-> (t1 -> t2 -> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f)))
-> t1
-> t2
-> UniqSM (Maybe (Graph n e x, BwdRewrite UniqSM n f))
f _ rw' n f = liftM (liftM (badd_rw (iterBwdRw rw))) (rw' n f)
-- | Function inspired by 'add' in the paper
badd_rw :: BwdRewrite UniqSM n f
-> (Graph n e x, BwdRewrite UniqSM n f)
-> (Graph n e x, BwdRewrite UniqSM n f)
badd_rw rw2 (g, rw1) = (g, rw1 `thenBwdRw` rw2)
-- Note [Deprecations in Hoopl]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment