import PprCmm()
import OptimizationFuel
-import Control.Monad
import Maybes
import Outputable
import UniqSupply
-- 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
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)
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