X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplMonad.lhs;h=afe7289001aced292a521066225d7adf0be89146;hb=e6834cad29914f123edb32c20d42b16e3308e667;hp=adaa6c44a3ba7fe77648adc334c47a007e31b5c6;hpb=61bfd5dd3b9d70404d6f93c030a9bb1c402b9d31;p=ghc-hetmet.git diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs index adaa6c4..afe7289 100644 --- a/ghc/compiler/simplCore/SimplMonad.lhs +++ b/ghc/compiler/simplCore/SimplMonad.lhs @@ -52,9 +52,7 @@ module SimplMonad ( #include "HsVersions.h" -import Id ( Id, idType, isDataConWrapId, - idOccInfo, idInlinePragma - ) +import Id ( Id, idType, idOccInfo, idInlinePragma ) import CoreSyn import CoreUtils ( needsCaseBinding, exprIsTrivial ) import PprCore () -- Instances @@ -73,27 +71,30 @@ import UniqSupply ( uniqsFromSupply, uniqFromSupply, splitUniqSupply, UniqSupply ) import FiniteMap -import BasicTypes ( TopLevelFlag, isTopLevel, +import BasicTypes ( TopLevelFlag, isTopLevel, isLoopBreaker, Activation, isActive, isAlwaysActive, - OccInfo(..) + 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} @@ -448,7 +449,7 @@ data Tick | PostInlineUnconditionally Id | UnfoldingDone Id - | RuleFired FAST_STRING -- Rule name + | RuleFired FastString -- Rule name | LetFloatFromLet | EtaExpansion Id -- LHS binder @@ -681,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 @@ -692,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. @@ -758,7 +767,16 @@ big the RHS might be. If this is the case we don't simplify the RHS first, but just inline it un-simplified. This is much better than first simplifying a perhaps-huge RHS and then -inlining and re-simplifying it. +inlining and re-simplifying it. Indeed, it can be at least quadratically +better. Consider + + x1 = e1 + x2 = e2[x1] + x3 = e3[x2] + ...etc... + xN = eN[xN-1] + +We may end up simplifying e1 N times, e2 N-1 times, e3 N-3 times etc. NB: we don't even look at the RHS to see if it's trivial We might have @@ -787,21 +805,27 @@ seems to be to do a callSiteInline based on the fact that there is something interesting about the call site (it's strict). Hmm. That seems a bit fragile. +Conclusion: inline top level things gaily until Phase 0 (the last +phase), at which point don't. + \begin{code} preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> Bool preInlineUnconditionally env top_lvl bndr - | isTopLevel top_lvl = False + | isTopLevel top_lvl, SimplPhase 0 <- phase = False -- If we don't have this test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to -- top level, and preInlineUnconditionally floats them all back in. -- Result is (a) static allocation replaced by dynamic allocation -- (b) many simplifier iterations because this tickles --- a related problem +-- a related problem; only one inlining per pass -- -- On the other hand, I have seen cases where top-level fusion is -- lost if we don't inline top level thing (e.g. string constants) --- We'll have to see +-- Hence the test for phase zero (which is the phase for all the final +-- simplifications). Until phase zero we take no special notice of +-- top level things, but then we become more leery about inlining +-- them. | not active = False | opt_SimplNoPreInlining = False @@ -811,7 +835,8 @@ preInlineUnconditionally env top_lvl bndr -- Not inside a lambda, one occurrence ==> safe! other -> False where - active = case getMode env of + phase = getMode env + active = case phase of SimplGently -> isAlwaysActive prag SimplPhase n -> isActive n prag prag = idInlinePragma bndr @@ -846,33 +871,41 @@ our new view that inlining is like a RULE, so I'm sticking to the 'active' story for now. \begin{code} -postInlineUnconditionally :: SimplEnv -> OutId -> Bool -> OutExpr -> Bool -postInlineUnconditionally env bndr loop_breaker rhs +postInlineUnconditionally :: SimplEnv -> OutId -> OccInfo -> OutExpr -> Bool +postInlineUnconditionally env bndr occ_info rhs = exprIsTrivial rhs && active - && not loop_breaker + && 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 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 -> 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. @@ -886,17 +919,22 @@ activeInline env id occ -- and they are now constructed as Compulsory unfoldings (in MkId) -- so they'll happen anyway. - SimplPhase n -> isActive n (idInlinePragma id) - --- Belongs in BasicTypes; this frag occurs in OccurAnal too -isOneOcc (OneOcc _ _) = True -isOneOcc other = False + SimplPhase n -> isActive n prag + where + prag = idInlinePragma id 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} @@ -935,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 @@ -956,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)