Commit a327c140 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Whitespace only in simplCore/SimplMonad.lhs

parent d131d66e
......@@ -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}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment