X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FDFMonad.hs;h=4c254e68aad251d279738f44cd5dcf247798610e;hb=5d52d9b64c21dcf77849866584744722f8121389;hp=0cf1ead0fc9b7673a71c505bac2aace0bf650783;hpb=5dc8b425443200a5160b9d1399aca1808bfcffee;p=ghc-hetmet.git diff --git a/compiler/cmm/DFMonad.hs b/compiler/cmm/DFMonad.hs index 0cf1ead..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 @@ -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) @@ -192,6 +190,10 @@ instance Monad m => Monad (DFM' m f) where DFM' f >>= k = DFM' (\l s -> do (a, s') <- 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