stack overflows and out of memory's

1. Stack overflow fixed by making dataflow monad strict in the state.
2. Out of memory fixed by "forgetting" lastoutfacts in the dataflow monad
   where we should. We were creating an unnecessarily long list that grew
   exponentially...

1 files changed, 7 insertions, 7 deletions

diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs
index 4db3b966af..0cf1ead0fc 100644
--- a/compiler/cmm/DFMonad.hs
+++ b/compiler/cmm/DFMonad.hs
@@ -59,14 +59,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
 
@@ -190,7 +190,7 @@ 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))
 
 instance FuelUsingMonad (DFM' FuelMonad f) where