X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FsimplCore%2FSimplMonad.lhs;h=aec3c1b09dff3b3f0ba47653097c374f4cf865d2;hb=9eb6cb808766126461564120923eb5d983221843;hp=27c9eec8907bde8f7c6ea84586c3925710aafcdf;hpb=5f087cf4add4e140e7df05d896ee6b271133f822;p=ghc-hetmet.git diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs index 27c9eec..aec3c1b 100644 --- a/ghc/compiler/simplCore/SimplMonad.lhs +++ b/ghc/compiler/simplCore/SimplMonad.lhs @@ -37,7 +37,7 @@ module SimplMonad ( -- Environments SimplEnv, emptySimplEnv, getSubst, setSubst, getSubstEnv, extendSubst, extendSubstList, - getInScope, setInScope, modifyInScope, addNewInScopeIds, + getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds, setSubstEnv, zapSubstEnv, -- Floats @@ -62,7 +62,7 @@ import VarEnv import VarSet import OrdList import qualified Subst -import Subst ( Subst, mkSubst, substEnv, +import Subst ( Subst, emptySubst, substEnv, InScopeSet, mkInScopeSet, substInScope, isInScope ) @@ -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 @@ -594,10 +597,10 @@ data SimplEnv -- have a correctly-substituted type. So we use a lookup in this -- set to replace occurrences -emptySimplEnv :: SimplifierMode -> [SimplifierSwitch] -> VarSet -> SimplEnv -emptySimplEnv mode switches in_scope - = SimplEnv { seChkr = isAmongSimpl switches, seCC = subsumedCCS, seMode = mode, - seSubst = mkSubst (mkInScopeSet in_scope) emptySubstEnv } +emptySimplEnv :: SimplifierMode -> [SimplifierSwitch] -> SimplEnv +emptySimplEnv mode switches + = SimplEnv { seChkr = isAmongSimpl switches, seCC = subsumedCCS, + seMode = mode, seSubst = emptySubst } -- The top level "enclosing CC" is "SUBSUMED". --------------------- @@ -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. @@ -756,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 @@ -785,6 +805,9 @@ 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 @@ -795,7 +818,7 @@ preInlineUnconditionally env top_lvl bndr -- 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) @@ -850,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. @@ -901,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} @@ -941,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 @@ -962,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)