-instance DataflowAnalysis DFM where
- markFactsUnchanged = liftAnal $ markFactsUnchanged
- factsStatus = liftAnal $ factsStatus
- subAnalysis = dfmSubAnalysis
- getFact id = liftAnal $ getFact id
- setFact id new = liftAnal $ setFact id new
- botFact = liftAnal $ botFact
- forgetFact id = liftAnal $ forgetFact id
- forgetLastOutFacts = dfmForgetLastOutFacts
- allFacts = liftAnal $ allFacts
- checkFactMatch id a = liftAnal $ checkFactMatch id a
-
- lattice = liftAnal $ lattice
-
-dfmSubAnalysis :: DFM f a -> DFM f a
-dfmSubAnalysis (DFM f) = DFM f'
- where f' l s = let s' = s { df_astate = subAnalysisState (df_astate s) }
- (a, _) = f l s'
- in (a, s)
-
-dfmForgetLastOutFacts :: DFM f ()
-dfmForgetLastOutFacts = DFM f
- where f _ s = ((), s { df_last_outs = [] })
-
-addLastOutFact :: (BlockId, f) -> DFM f ()
-addLastOutFact pair = DFM f
- where f _ s = ((), s { df_last_outs = pair : df_last_outs s })
-
-lastOutFacts :: DFM f [(BlockId, f)]
-lastOutFacts = DFM f
- where f _ s = (df_last_outs s, s)
-
-markGraphRewritten :: DFM f ()
-markGraphRewritten = DFM f
- where f _ s = ((), s {df_rewritten = SomeChange})
-
-freshBlockId :: String -> DFM f BlockId
-freshBlockId _s = liftUSM $ getUniqueUs >>= return . BlockId
-
-liftUSM :: UniqSM a -> DFM f a
-liftUSM uc = DFM f
- where f _ s = let (a, us') = initUs (df_uniqs s) uc
- in (a, s {df_uniqs = us'})
-
-instance Monad (DFA f) where
- DFA f >>= k = DFA (\l s -> let (a, s') = f l s
- DFA f' = k a
- in f' l s')
- return a = DFA (\_ s -> (a, s))
-
-instance Monad (DFM f) where
- DFM f >>= k = DFM (\l s -> let (a, s') = f l s
- DFM f' = k a
- in f' l s')
- return a = DFM (\_ s -> (a, s))
-
-instance Monad (DFTx) where
- DFTx f >>= k = DFTx (\s -> let (a, s') = f s
- DFTx f' = k a
- in f' s')
- return a = DFTx (\s -> (a, s))
-
-pprSetFact :: Outputable f => BlockId -> f -> f -> f -> SDoc
+markGraphRewritten :: Monad m => DFM' m f ()
+markGraphRewritten = DFM' f
+ where f _ s = return ((), s {df_rewritten = SomeChange})
+
+graphWasRewritten :: DFM f ChangeFlag
+graphWasRewritten = DFM' f
+ where f _ s = return (df_rewritten s, s)
+
+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
+ lastFuelPass = liftToDFM' lastFuelPass
+ fuelExhausted = liftToDFM' fuelExhausted
+ fuelDecrement p f f' = liftToDFM' (fuelDecrement p f f')
+ fuelDec1 = liftToDFM' fuelDec1
+instance MonadUnique (DFM' FuelMonad f) where
+ getUniqueSupplyM = liftToDFM' getUniqueSupplyM
+ getUniqueM = liftToDFM' getUniqueM
+ getUniquesM = liftToDFM' getUniquesM
+
+liftToDFM' :: Monad m => m x -> DFM' m f x
+liftToDFM' m = DFM' (\ _ s -> m >>= (\a -> return (a, s)))
+liftToDFM :: FuelMonad x -> DFM f x
+liftToDFM m = DFM' (\ _ s -> m >>= (\a -> return (a, s)))
+
+
+pprSetFact :: (Show a, Outputable f) => a -> f -> f -> f -> SDoc