X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FDFMonad.hs;h=4c254e68aad251d279738f44cd5dcf247798610e;hb=5fa086c51816f09d03fb1a089dde64df6bd2d8a3;hp=4db3b966afe67c3a8fe6bb6847606ed1121de2cd;hpb=31a9d04804d9cacda35695c5397590516b964964;p=ghc-hetmet.git

diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs
index 4db3b96..4c254e6 100644
--- a/compiler/cmm/DFMonad.hs
+++ b/compiler/cmm/DFMonad.hs
@@ -16,7 +16,6 @@ import CmmTx
 import PprCmm()
 import OptimizationFuel
 
-import Control.Monad
 import Maybes
 import Outputable
 import UniqSupply
@@ -59,14 +58,14 @@ data DataflowLattice a = DataflowLattice  {
 -- case of DFM, parameterized over any monad.
 -- In practice, we apply DFM' to the FuelMonad, which provides optimization fuel and
 -- the unique supply.
-data DFState f = DFState { df_rewritten    :: ChangeFlag
-                         , df_facts        :: BlockEnv f
-                         , df_exit_fact    :: f
-                         , df_last_outs    :: [(BlockId, f)]
-                         , df_facts_change :: ChangeFlag
+data DFState f = DFState { df_rewritten    :: !ChangeFlag
+                         , df_facts        :: !(BlockEnv f)
+                         , df_exit_fact    :: !f
+                         , df_last_outs    :: ![(BlockId, f)]
+                         , df_facts_change :: !ChangeFlag
                          }
 
-newtype DFM' m fact a = DFM' (DataflowLattice fact -> DFState  fact
+newtype DFM' m fact a = DFM' (DataflowLattice fact -> DFState fact
                                                    -> m (a, DFState  fact))
 type DFM fact a = DFM' FuelMonad fact a
 
@@ -167,8 +166,7 @@ instance Monad m => DataflowAnalysis (DFM' m) where
                                     text "changed from", nest 4 (ppr old_a), text "to",
                                     nest 4 (ppr new),
                                     text "after supposedly reaching fixed point;",
-                                    text "env is", pprFacts facts]) 
-                  ; setFact id a }
+                                    text "env is", pprFacts facts]) }
          }
     where pprFacts env = vcat (map pprFact (blockEnvToList env))
           pprFact (id, a) = hang (ppr id <> colon) 4 (ppr a)
@@ -190,8 +188,12 @@ graphWasRewritten = DFM' f
                     
 instance Monad m => Monad (DFM' m f) where
   DFM' f >>= k = DFM' (\l s -> do (a, s') <- f l s
-                                  let DFM' f' = k a in f' l s')
+                                  s' `seq` case k a of DFM' f' -> f' l s')
   return a = DFM' (\_ s -> return (a, s))
+ -- The `seq` is essential to ensure that entire passes of the dataflow engine 
+ -- aren't postponed in a thunk. By making the sequence strict in the state,
+ -- we ensure that each action in the monad is executed immediately, preventing
+ -- stack overflows that previously occurred when finally forcing the old state thunks.
 
 instance FuelUsingMonad (DFM' FuelMonad f) where
   fuelRemaining = liftToDFM' fuelRemaining