X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplMonad.lhs;h=39fb7180bee5f3c02b104440ce4a1f688773e0a6;hb=7fa25f74d02cf36cb4997477c7527324104c74ee;hp=a4e7ef48c28204eb755f4c0422d787df5d60f77b;hpb=a425df1a4e65b24018db36d4f9b919fc8af3447e;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index a4e7ef4..39fb718 100644 --- 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)) @@ -243,10 +243,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 @@ -419,6 +419,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.