getCoreToDo, dumpSimplPhase,
-- * Counting
- SimplCount, doSimplTick, doFreeSimplTick,
+ SimplCount, doSimplTick, doFreeSimplTick, simplCountN,
pprSimplCount, plusSimplCount, zeroSimplCount, isZeroSimplCount, Tick(..),
-- * The monad
import Bag
import Maybes
import UniqSupply
-import LazyUniqFM ( UniqFM, mapUFM, filterUFM )
+import UniqFM ( UniqFM, mapUFM, filterUFM )
import FiniteMap
import Util ( split )
; Err.ghcExit dflags 1 }
| not (isEmptyBag warns)
+ , not (case pass of { CoreDesugar -> True; _ -> False })
+ -- Suppress warnings after desugaring pass because some
+ -- are legitimate. Notably, the desugarer generates instance
+ -- methods with INLINE pragmas that form a mutually recursive
+ -- group. Only afer a round of simplification are they unravelled.
, not opt_NoDebugOutput
, showLintWarnings pass
= printDump (banner "warnings" $$ Err.pprMessageBag warns)
-- initial simplify: mk specialiser happy: minimum effort please
simpl_gently = CoreDoSimplify
(SimplGently { sm_rules = True, sm_inline = False })
+ -- See Note [Gentle mode] and
+ -- Note [RULEs enabled in SimplGently] in SimplUtils
max_iter
[
- -- Simplify "gently"
- -- Don't inline anything till full laziness has bitten
- -- In particular, inlining wrappers inhibits floating
- -- e.g. ...(case f x of ...)...
- -- ==> ...(case (case x of I# x# -> fw x#) of ...)...
- -- ==> ...(case x of I# x# -> case fw x# of ...)...
- -- and now the redex (f x) isn't floatable any more
- -- Similarly, don't apply any rules until after full
- -- laziness. Notably, list fusion can prevent floating.
+
NoCaseOfCase -- Don't do case-of-case transformations.
-- This makes full laziness work better
\begin{code}
data SimplCount
- = VerySimplZero -- These two are used when
- | VerySimplNonZero -- we are only interested in
- -- termination info
+ = VerySimplCount !Int -- Used when don't want detailed stats
| SimplCount {
ticks :: !Int, -- Total ticks
type TickCounts = FiniteMap Tick Int
+simplCountN :: SimplCount -> Int
+simplCountN (VerySimplCount n) = n
+simplCountN (SimplCount { ticks = n }) = n
+
zeroSimplCount dflags
-- This is where we decide whether to do
-- the VerySimpl version or the full-stats version
= SimplCount {ticks = 0, details = emptyFM,
n_log = 0, log1 = [], log2 = []}
| otherwise
- = VerySimplZero
+ = VerySimplCount 0
-isZeroSimplCount VerySimplZero = True
-isZeroSimplCount (SimplCount { ticks = 0 }) = True
-isZeroSimplCount _ = False
+isZeroSimplCount (VerySimplCount n) = n==0
+isZeroSimplCount (SimplCount { ticks = n }) = n==0
doFreeSimplTick tick sc@SimplCount { details = dts }
= sc { details = dts `addTick` tick }
where
sc1 = sc { ticks = tks+1, details = dts `addTick` tick }
-doSimplTick _ _ = VerySimplNonZero -- The very simple case
+doSimplTick _ (VerySimplCount n) = VerySimplCount (n+1)
-- Don't use plusFM_C because that's lazy, and we want to
| null (log2 sc2) = sc2 { log2 = log1 sc1 }
| otherwise = sc2
-plusSimplCount VerySimplZero VerySimplZero = VerySimplZero
-plusSimplCount _ _ = VerySimplNonZero
+plusSimplCount (VerySimplCount n) (VerySimplCount m) = VerySimplCount (n+m)
+plusSimplCount _ _ = panic "plusSimplCount"
+ -- We use one or the other consistently
-pprSimplCount VerySimplZero = ptext (sLit "Total ticks: ZERO!")
-pprSimplCount VerySimplNonZero = ptext (sLit "Total ticks: NON-ZERO!")
+pprSimplCount (VerySimplCount n) = ptext (sLit "Total ticks:") <+> int n
pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
= vcat [ptext (sLit "Total ticks: ") <+> int tks,
blankLine,