-- The monad
SimplM,
initSmpl,
- getDOptsSmpl, getRules, getFamEnvs,
+ getDOptsSmpl, getSimplRules, getFamEnvs,
-- Unique supply
MonadUnique(..), newId,
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))
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 }