X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplMonad.lhs;h=657b84b8d6a090f4c758431e1838aafb397cf1e5;hb=9bcaaaaa59acff95886ad3675677e58c43106bd2;hp=be51d7d684f190bebba891ba7a59a24ec72cebef;hpb=4033c3e0f46673b3d1af253552583e94c663bff8;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index be51d7d..657b84b 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -32,7 +32,7 @@ import UniqSupply 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 @@ -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} @@ -205,16 +205,9 @@ isZeroSimplCount (SimplCount { ticks = 0 }) = True 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 }