diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/simplCore/SimplMonad.lhs | 91 |
1 files changed, 42 insertions, 49 deletions
diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index 9d9856923a..50d133f62c 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -4,32 +4,25 @@ \section[SimplMonad]{The simplifier Monad} \begin{code} -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - module SimplMonad ( - -- The monad - SimplM, - initSmpl, - getSimplRules, getFamEnvs, + -- The monad + SimplM, + initSmpl, + getSimplRules, getFamEnvs, -- Unique supply MonadUnique(..), newId, - -- Counting - SimplCount, tick, freeTick, checkedTick, - getSimplCount, zeroSimplCount, pprSimplCount, + -- Counting + SimplCount, tick, freeTick, checkedTick, + getSimplCount, zeroSimplCount, pprSimplCount, plusSimplCount, isZeroSimplCount ) where -import Id ( Id, mkSysLocal ) +import Id ( Id, mkSysLocal ) import Type ( Type ) -import FamInstEnv ( FamInstEnv ) -import Rules ( RuleBase ) +import FamInstEnv ( FamInstEnv ) +import Rules ( RuleBase ) import UniqSupply import DynFlags import CoreMonad @@ -39,9 +32,9 @@ import MonadUtils \end{code} %************************************************************************ -%* * +%* * \subsection{Monad plumbing} -%* * +%* * %************************************************************************ For the simplifier monad, we want to {\em thread} a unique supply and a counter. @@ -49,41 +42,41 @@ For the simplifier monad, we want to {\em thread} a unique supply and a counter. \begin{code} newtype SimplM result - = SM { unSM :: SimplTopEnv -- Envt that does not change much - -> UniqSupply -- We thread the unique supply because - -- constantly splitting it is rather expensive - -> SimplCount - -> IO (result, UniqSupply, SimplCount)} + = SM { unSM :: SimplTopEnv -- Envt that does not change much + -> UniqSupply -- We thread the unique supply because + -- constantly splitting it is rather expensive + -> SimplCount + -> IO (result, UniqSupply, SimplCount)} -- we only need IO here for dump output -data SimplTopEnv - = STE { st_flags :: DynFlags - , st_max_ticks :: Int -- Max #ticks in this simplifier run - -- Zero means infinity! - , st_rules :: RuleBase - , st_fams :: (FamInstEnv, FamInstEnv) } +data SimplTopEnv + = STE { st_flags :: DynFlags + , st_max_ticks :: Int -- Max #ticks in this simplifier run + -- Zero means infinity! + , st_rules :: RuleBase + , st_fams :: (FamInstEnv, FamInstEnv) } \end{code} \begin{code} -initSmpl :: DynFlags -> RuleBase -> (FamInstEnv, FamInstEnv) - -> UniqSupply -- No init count; set to 0 - -> Int -- Size of the bindings, used to limit +initSmpl :: DynFlags -> RuleBase -> (FamInstEnv, FamInstEnv) + -> UniqSupply -- No init count; set to 0 + -> Int -- Size of the bindings, used to limit -- the number of ticks we allow - -> SimplM a - -> IO (a, SimplCount) + -> SimplM a + -> IO (a, SimplCount) initSmpl dflags rules fam_envs us size m = do (result, _, count) <- unSM m env us (zeroSimplCount dflags) return (result, count) where env = STE { st_flags = dflags, st_rules = rules - , st_max_ticks = computeMaxTicks dflags size + , st_max_ticks = computeMaxTicks dflags size , st_fams = fam_envs } computeMaxTicks :: DynFlags -> Int -> Int -- Compute the max simplifier ticks as -- (base-size + pgm-size) * magic-multiplier * tick-factor/100 --- where +-- where -- magic-multiplier is a constant that gives reasonable results -- base-size is a constant to deal with size-zero programs computeMaxTicks dflags size @@ -91,13 +84,13 @@ computeMaxTicks dflags size * toInteger (tick_factor * magic_multiplier)) `div` 100) where - tick_factor = simplTickFactor dflags + tick_factor = simplTickFactor dflags base_size = 100 magic_multiplier = 40 - -- MAGIC NUMBER, multiplies the simplTickFactor - -- We can afford to be generous; this is really - -- just checking for loops, and shouldn't usually fire - -- A figure of 20 was too small: see Trac #553 + -- MAGIC NUMBER, multiplies the simplTickFactor + -- We can afford to be generous; this is really + -- just checking for loops, and shouldn't usually fire + -- A figure of 20 was too small: see Trac #553 {-# INLINE thenSmpl #-} {-# INLINE thenSmpl_ #-} @@ -132,9 +125,9 @@ thenSmpl_ m k %************************************************************************ -%* * +%* * \subsection{The unique supply} -%* * +%* * %************************************************************************ \begin{code} @@ -172,9 +165,9 @@ newId fs ty = do uniq <- getUniqueM %************************************************************************ -%* * +%* * \subsection{Counting up what we've done} -%* * +%* * %************************************************************************ \begin{code} @@ -187,7 +180,7 @@ tick t = SM (\st_env us sc -> let sc' = doSimplTick (st_flags st_env) t sc checkedTick :: Tick -> SimplM () -- Try to take a tick, but fail if too many -checkedTick t +checkedTick t = SM (\st_env us sc -> if st_max_ticks st_env <= simplCountN sc then pprPanic "Simplifier ticks exhausted" (msg sc) else let sc' = doSimplTick (st_flags st_env) t sc @@ -201,12 +194,12 @@ checkedTick t pp_details sc | hasDetailedCounts sc = empty | otherwise = ptext (sLit "To see detailed counts use -ddump-simpl-stats") - + freeTick :: Tick -> SimplM () -- Record a tick, but don't add to the total tick count, which is -- used to decide when nothing further has happened -freeTick t +freeTick t = SM (\_st_env us sc -> let sc' = doFreeSimplTick t sc in sc' `seq` return ((), us, sc')) \end{code} |