X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplMonad.lhs;h=afe7289001aced292a521066225d7adf0be89146;hb=8655d6ca41df4aa77a559d4067ad3815797b9803;hp=800334cb6ec765043a22d3bab750553a5a8933b4;hpb=13a428caa18deb2805e307cbe7a99fa9f09c13a4;p=ghc-hetmet.git diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs index 800334c..afe7289 100644 --- a/ghc/compiler/simplCore/SimplMonad.lhs +++ b/ghc/compiler/simplCore/SimplMonad.lhs @@ -71,27 +71,30 @@ import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply, UniqSupply ) import FiniteMap -import BasicTypes ( TopLevelFlag, isTopLevel, +import BasicTypes ( TopLevelFlag, isTopLevel, isLoopBreaker, Activation, isActive, isAlwaysActive, OccInfo(..), isOneOcc ) import CmdLineOpts ( SimplifierSwitch(..), SimplifierMode(..), DynFlags, DynFlag(..), dopt, - opt_PprStyle_Debug, opt_HistorySize, opt_SimplNoPreInlining, + opt_PprStyle_Debug, opt_HistorySize, opt_SimplNoPreInlining, opt_RulesOff ) import Unique ( Unique ) -import Maybes ( expectJust ) import Outputable -import Array ( array, (//) ) import FastTypes -import GlaExts ( indexArray# ) +import FastString +import Maybes ( expectJust ) -#if __GLASGOW_HASKELL__ < 301 -import ArrBase ( Array(..) ) -#else +import GLAEXTS ( indexArray# ) + +#if __GLASGOW_HASKELL__ < 503 import PrelArr ( Array(..) ) +#else +import GHC.Arr ( Array(..) ) #endif +import Array ( array, (//) ) + infixr 0 `thenSmpl`, `thenSmpl_` \end{code} @@ -446,7 +449,7 @@ data Tick | PostInlineUnconditionally Id | UnfoldingDone Id - | RuleFired FAST_STRING -- Rule name + | RuleFired FastString -- Rule name | LetFloatFromLet | EtaExpansion Id -- LHS binder @@ -679,6 +682,8 @@ settings: SimplGently (a) Simplifying before specialiser/full laziness (b) Simplifiying inside INLINE pragma (c) Simplifying the LHS of a rule + (d) Simplifying a GHCi expression or Template + Haskell splice SimplPhase n Used at all other times @@ -690,6 +695,12 @@ because doing so inhibits floating ==> ...(case x of I# x# -> case fw x# of ...)... and now the redex (f x) isn't floatable any more. +The no-inling thing is also important for Template Haskell. You might be +compiling in one-shot mode with -O2; but when TH compiles a splice before +running it, we don't want to use -O2. Indeed, we don't want to inline +anything, because the byte-code interpreter might get confused about +unboxed tuples and suchlike. + INLINE pragmas ~~~~~~~~~~~~~~ SimplGently is also used as the mode to simplify inside an InlineMe note. @@ -862,37 +873,39 @@ story for now. \begin{code} postInlineUnconditionally :: SimplEnv -> OutId -> OccInfo -> OutExpr -> Bool postInlineUnconditionally env bndr occ_info rhs - = exprIsTrivial rhs && active && isOneOcc occ_info - -- We used to have (not loop_breaker && not (isExportedId bndr)) - -- instead of (isOneOcc occ_info). Indeed, you might suppose that + = exprIsTrivial rhs + && active + && not (isLoopBreaker occ_info) + && not (isExportedId bndr) + -- We used to have (isOneOcc occ_info) instead of + -- not (isLoopBreaker occ_info) && not (isExportedId bndr) + -- That was because a rather fragile use of rules got confused + -- if you inlined even a binding f=g e.g. We used to have + -- map = mapList + -- But now a more precise use of phases has eliminated this problem, + -- so the is_active test will do the job. I think. + -- + -- OLD COMMENT: (delete soon) + -- Indeed, you might suppose that -- there is nothing wrong with substituting for a trivial RHS, even -- if it occurs many times. But consider -- x = y -- h = _inline_me_ (...x...) -- Here we do *not* want to have x inlined, even though the RHS is -- trivial, becuase the contract for an INLINE pragma is "no inlining". - -- This is important in the rules for the Prelude (e.g. PrelEnum.eftInt). + -- This is important in the rules for the Prelude where active = case getMode env of SimplGently -> isAlwaysActive prag SimplPhase n -> isActive n prag prag = idInlinePragma bndr -\end{code} - -blackListInline tells if we must not inline at a call site because the -Id's inline pragma says not to do so. - -However, blackListInline is ignored for things with with Compulsory inlinings, -because they don't have bindings, so we must inline them no matter how -gentle we are being. -\begin{code} activeInline :: SimplEnv -> OutId -> OccInfo -> Bool activeInline env id occ = case getMode env of - SimplGently -> isAlwaysActive prag && isOneOcc occ + SimplGently -> isOneOcc occ && isAlwaysActive prag -- No inlining at all when doing gentle stuff, - -- except for things that occur once + -- except for local things that occur once -- The reason is that too little clean-up happens if you -- don't inline use-once things. Also a bit of inlining is *good* for -- full laziness; it can expose constant sub-expressions. @@ -913,8 +926,15 @@ activeInline env id occ activeRule :: SimplEnv -> Maybe (Activation -> Bool) -- Nothing => No rules at all activeRule env + | opt_RulesOff = Nothing + | otherwise = case getMode env of - SimplGently -> Nothing -- No rules in gentle mode + SimplGently -> Just isAlwaysActive + -- Used to be Nothing (no rules in gentle mode) + -- Main motivation for changing is that I wanted + -- lift String ===> ... + -- to work in Template Haskell when simplifying + -- splices, so we get simpler code for literal strings SimplPhase n -> Just (isActive n) \end{code} @@ -953,7 +973,7 @@ type SwitchChecker = SimplifierSwitch -> SwitchResult data SwitchResult = SwBool Bool -- on/off - | SwString FAST_STRING -- nothing or a String + | SwString FastString -- nothing or a String | SwInt Int -- nothing or an Int isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult @@ -974,20 +994,10 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier* defined_elems = map mk_assoc_elem tidied_on_switches in -- (avoid some unboxing, bounds checking, and other horrible things:) -#if __GLASGOW_HASKELL__ < 405 - case sw_tbl of { Array bounds_who_needs_'em stuff -> -#else case sw_tbl of { Array _ _ stuff -> -#endif \ switch -> case (indexArray# stuff (tagOf_SimplSwitch switch)) of -#if __GLASGOW_HASKELL__ < 400 - Lift v -> v -#elif __GLASGOW_HASKELL__ < 403 - (# _, v #) -> v -#else (# v #) -> v -#endif } where mk_assoc_elem k@(MaxSimplifierIterations lvl)