-- The monad
SimplM,
initSmpl,
- getDOptsSmpl, getRules, getFamEnvs,
+ getDOptsSmpl, getSimplRules, getFamEnvs,
-- Unique supply
MonadUnique(..), newId,
-- Switch checker
SwitchChecker, SwitchResult(..), getSimplIntSwitch,
- isAmongSimpl, intSwitchSet, switchIsOn
+ isAmongSimpl, intSwitchSet, switchIsOn, allOffSwitchChecker
) where
import Id ( Id, mkSysLocal )
import DynFlags ( SimplifierSwitch(..), DynFlags, DynFlag(..), dopt )
import StaticFlags ( opt_PprStyle_Debug, opt_HistorySize )
import Maybes ( expectJust )
-import FiniteMap ( FiniteMap, emptyFM, isEmptyFM, lookupFM, addToFM, plusFM_C, fmToList )
+import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, plusFM_C, fmToList )
import FastString
import Outputable
import FastTypes
(_, us1, sc1) -> unSM k st_env us1 sc1)
-- TODO: this specializing is not allowed
-{-# -- SPECIALIZE mapM :: (a -> SimplM b) -> [a] -> SimplM [b] #-}
-{-# -- SPECIALIZE mapAndUnzipM :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c]) #-}
-{-# -- SPECIALIZE mapAccumLM :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c]) #-}
+-- {-# SPECIALIZE mapM :: (a -> SimplM b) -> [a] -> SimplM [b] #-}
+-- {-# SPECIALIZE mapAndUnzipM :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c]) #-}
+-- {-# SPECIALIZE mapAccumLM :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c]) #-}
\end{code}
getDOptsSmpl :: SimplM DynFlags
getDOptsSmpl = SM (\st_env us sc -> (st_flags st_env, us, sc))
-getRules :: SimplM RuleBase
-getRules = SM (\st_env us sc -> (st_rules st_env, us, sc))
+getSimplRules :: SimplM RuleBase
+getSimplRules = SM (\st_env us sc -> (st_rules st_env, us, sc))
getFamEnvs :: SimplM (FamInstEnv, FamInstEnv)
getFamEnvs = SM (\st_env us sc -> (st_fams st_env, us, sc))
\end{code}
\begin{code}
-data SimplCount = VerySimplZero -- These two are used when
- | VerySimplNonZero -- we are only interested in
- -- termination info
-
- | SimplCount {
- ticks :: !Int, -- Total ticks
- details :: !TickCounts, -- How many of each type
- n_log :: !Int, -- N
- log1 :: [Tick], -- Last N events; <= opt_HistorySize
- log2 :: [Tick] -- Last opt_HistorySize events before that
- }
+data SimplCount
+ = VerySimplZero -- These two are used when
+ | VerySimplNonZero -- we are only interested in
+ -- termination info
+
+ | SimplCount {
+ ticks :: !Int, -- Total ticks
+ details :: !TickCounts, -- How many of each type
+
+ n_log :: !Int, -- N
+ log1 :: [Tick], -- Last N events; <= opt_HistorySize,
+ -- most recent first
+ log2 :: [Tick] -- Last opt_HistorySize events before that
+ -- Having log1, log2 lets us accumulate the
+ -- recent history reasonably efficiently
+ }
type TickCounts = FiniteMap Tick Int
isZeroSimplCount _ = False
doFreeTick tick sc@SimplCount { details = dts }
- = dts' `seqFM` sc { details = dts' }
- where
- dts' = dts `addTick` tick
+ = sc { details = dts `addTick` tick }
doFreeTick _ sc = sc
--- Gross hack to persuade GHC 3.03 to do this important seq
-seqFM :: FiniteMap key elt -> t -> t
-seqFM fm x | isEmptyFM fm = x
- | otherwise = x
-
doTick tick sc@SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1 }
| nl >= opt_HistorySize = sc1 { n_log = 1, log1 = [tick], log2 = l1 }
| otherwise = sc1 { n_log = nl+1, log1 = tick : l1 }
pprSimplCount VerySimplNonZero = ptext (sLit "Total ticks: NON-ZERO!")
pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
= vcat [ptext (sLit "Total ticks: ") <+> int tks,
- text "",
+ blankLine,
pprTickCounts (fmToList dts),
if verboseSimplStats then
- vcat [text "",
+ vcat [blankLine,
ptext (sLit "Log (most recent first)"),
nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]
else empty
tot_n = sum [n | (_,n) <- real_these]
pprTCDetails :: [(Tick, Int)] -> SDoc
-pprTCDetails ticks@((tick,_):_)
- | verboseSimplStats || isRuleFired tick
+pprTCDetails ticks
= nest 4 (vcat [int n <+> pprTickCts tick | (tick,n) <- ticks])
- | otherwise
- = empty
-pprTCDetails [] = panic "pprTCDetails []"
\end{code}
%************************************************************************
| BottomFound
| SimplifierDone -- Ticked at each iteration of the simplifier
-isRuleFired :: Tick -> Bool
-isRuleFired (RuleFired _) = True
-isRuleFired _ = False
-
instance Outputable Tick where
ppr tick = text (tickString tick) <+> pprTickCts tick
cmpTick :: Tick -> Tick -> Ordering
cmpTick a b = case (tickToTag a `compare` tickToTag b) of
GT -> GT
- EQ | isRuleFired a || verboseSimplStats -> cmpEqTick a b
- | otherwise -> EQ
+ EQ -> cmpEqTick a b
LT -> LT
- -- Always distinguish RuleFired, so that the stats
- -- can report them even in non-verbose mode
cmpEqTick :: Tick -> Tick -> Ordering
cmpEqTick (PreInlineUnconditionally a) (PreInlineUnconditionally b) = a `compare` b
| SwString FastString -- nothing or a String
| SwInt Int -- nothing or an Int
+allOffSwitchChecker :: SwitchChecker
+allOffSwitchChecker _ = SwBool False
+
isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
-- in the list; defaults right at the end.