Make -ddump-simpl-stats a bit more informative by default

[ghc-hetmet.git] / compiler / simplCore / SimplMonad.lhs

diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs
index a4e7ef4..8a02b17 100644 (file)
--- a/compiler/simplCore/SimplMonad.lhs
+++ b/compiler/simplCore/SimplMonad.lhs
@@ -8,7 +8,7 @@ module SimplMonad (
        -- The monad
        SimplM,
        initSmpl,
-       getDOptsSmpl, getRules, getFamEnvs,
+       getDOptsSmpl, getSimplRules, getFamEnvs,
 
         -- Unique supply
         MonadUnique(..), newId,
@@ -21,7 +21,7 @@ module SimplMonad (
 
        -- Switch checker
        SwitchChecker, SwitchResult(..), getSimplIntSwitch,
-       isAmongSimpl, intSwitchSet, switchIsOn
+       isAmongSimpl, intSwitchSet, switchIsOn, allOffSwitchChecker
     ) where
 
 import Id              ( Id, mkSysLocal )
@@ -101,9 +101,9 @@ thenSmpl_ m k
                (_, 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}
 
 
@@ -130,8 +130,8 @@ instance MonadUnique SimplM where
 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))
@@ -177,17 +177,22 @@ plusSimplCount     :: SimplCount -> SimplCount -> SimplCount
 \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
 
@@ -243,10 +248,10 @@ pprSimplCount VerySimplZero    = ptext (sLit "Total ticks: ZERO!")
 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
@@ -267,12 +272,8 @@ pprTickCounts ((tick1,n1):ticks)
     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}
 
 %************************************************************************
@@ -306,10 +307,6 @@ data Tick
   | 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
 
@@ -380,11 +377,8 @@ pprTickCts _                       = empty
 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
@@ -419,6 +413,9 @@ data SwitchResult
   | 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.