[commit: ghc] wip/js-hoopl-cleanup: Simplify fwd analysis (52bcb77)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/js-hoopl-cleanup
Link       : http://ghc.haskell.org/trac/ghc/changeset/52bcb77c18743bf871d06f3b5365d93e6e11ec8d/ghc

>---------------------------------------------------------------

commit 52bcb77c18743bf871d06f3b5365d93e6e11ec8d
Author: Jan Stolarek <jan.stolarek at p.lodz.pl>
Date:   Mon Jan 18 21:20:58 2016 +0100

    Simplify fwd analysis


>---------------------------------------------------------------

52bcb77c18743bf871d06f3b5365d93e6e11ec8d
 compiler/cmm/CmmUtils.hs       |  4 ++--
 compiler/cmm/Hoopl/Dataflow.hs | 30 ++++++++++--------------------
 2 files changed, 12 insertions(+), 22 deletions(-)

diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index dca57dc..ef24923 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -581,7 +581,7 @@ dataflowAnalFwd :: NonLocal n =>
                 -> FwdPass UniqSM n f
                 -> BlockEnv f
 dataflowAnalFwd (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd =
-  analyzeFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
+  analyzeFwd fwd entry graph (mkFactBase (fp_lattice fwd) facts)
 
 dataflowAnalFwdBlocks :: NonLocal n =>
                    GenCmmGraph n -> [(BlockId, f)]
@@ -590,7 +590,7 @@ dataflowAnalFwdBlocks :: NonLocal n =>
 dataflowAnalFwdBlocks (CmmGraph {g_entry=entry, g_graph=graph}) facts fwd = do
 --  (graph, facts, NothingO) <- analyzeAndRewriteFwd fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts)
 --  return facts
-  return (analyzeFwdBlocks fwd (JustC [entry]) graph (mkFactBase (fp_lattice fwd) facts))
+  return (analyzeFwdBlocks fwd entry graph (mkFactBase (fp_lattice fwd) facts))
 
 dataflowAnalBwd :: NonLocal n =>
                    GenCmmGraph n -> [(BlockId, f)]
diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs
index 6507d7e..6b38608 100644
--- a/compiler/cmm/Hoopl/Dataflow.hs
+++ b/compiler/cmm/Hoopl/Dataflow.hs
@@ -231,21 +231,16 @@ forwardBlockList entries blks = postorder_dfs_from blks entries
 analyzeFwd
    :: forall n f .  NonLocal n =>
       FwdPass UniqSM n f
-   -> MaybeC C [Label]
+   -> Label
    -> Graph n C C -> FactBase f
    -> FactBase f
 analyzeFwd FwdPass { fp_lattice = lattice,
                      fp_transfer = FwdTransfer3 (ftr, mtr, ltr) }
-  (JustC entries) (GMany NothingO blockmap NothingO) in_fact
-  = body entries in_fact
+  entry (GMany NothingO blockmap NothingO) in_fact
+  = fixpointAnal Fwd (fact_join lattice) do_block [entry] blockmap in_fact
   where
-    body  :: [Label] -> FactBase f -> FactBase f
-    body entries f
-         = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f
-         where
-           do_block :: forall x . Block n C x -> FactBase f -> Fact x f
-           do_block b fb = block b entryFact
-             where entryFact = getFact (entryLabel b) fb
+    do_block :: forall x . Block n C x -> FactBase f -> Fact x f
+    do_block b fb = block b (getFact (entryLabel b) fb)
 
     -- NB. eta-expand block, GHC can't do this by itself.  See #5809.
     block :: forall e x . Block n e x -> f -> Fact x f
@@ -268,22 +263,17 @@ analyzeFwd FwdPass { fp_lattice = lattice,
 analyzeFwdBlocks
    :: forall n f.  NonLocal n =>
       FwdPass UniqSM n f
-   -> MaybeC C [Label]
+   -> Label
    -> Graph n C C -> Fact C f
    -> FactBase f
 analyzeFwdBlocks FwdPass { fp_lattice = lattice,
                            fp_transfer = FwdTransfer3 (ftr, _, ltr) }
-                 (JustC entries)
+                 entry
                  (GMany NothingO blockmap NothingO) in_fact
-  = body entries in_fact
+  = fixpointAnal Fwd (fact_join lattice) do_block [entry] blockmap in_fact
   where
-    body  :: [Label] -> Fact C f -> Fact C f
-    body entries f
-         = fixpointAnal Fwd (fact_join lattice) do_block entries blockmap f
-         where
-           do_block :: Block n C C -> FactBase f -> Fact C f
-           do_block b fb = block b entryFact
-             where entryFact = getFact (entryLabel b) fb
+    do_block :: Block n C C -> FactBase f -> Fact C f
+    do_block b fb = block b (getFact (entryLabel b) fb)
 
     -- NB. eta-expand block, GHC can't do this by itself.  See #5809.
     block :: forall e x . Block n e x -> f -> Fact x f