X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSyn.lhs;h=5c7cef9ac9b99116ffecf913643b0bcf965a47bc;hb=064812423073e89805c16311728cfded5d50e306;hp=01e2be77c6517e37340631d8091d6ca7ccdbc14c;hpb=72462499b891d5779c19f3bda03f96e24f9554ae;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 01e2be7..5c7cef9 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -35,19 +35,20 @@ module CoreSyn ( isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar, -- * Unfolding data types - Unfolding(..), UnfoldingGuidance(..), InlineRuleInfo(..), + Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..), -- Abstract everywhere but in CoreUnfold.lhs -- ** Constructing 'Unfolding's noUnfolding, evaldUnfolding, mkOtherCon, + unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk, -- ** Predicates and deconstruction on 'Unfolding' unfoldingTemplate, setUnfoldingTemplate, maybeUnfoldingTemplate, otherCons, unfoldingArity, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, - isExpandableUnfolding, + isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, - isStableUnfolding, canUnfold, neverUnfoldGuidance, + isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource, -- * Strictness seqExpr, seqExprs, seqUnfolding, @@ -60,7 +61,7 @@ module CoreSyn ( -- * Core rule data types CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only - RuleName, + RuleName, IdUnfoldingFun, -- ** Operations on 'CoreRule's seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe, @@ -333,13 +334,18 @@ data CoreRule ru_fn :: Name, -- ^ As above ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes, -- if it fires, including type arguments - ru_try :: [CoreExpr] -> Maybe CoreExpr + ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr -- ^ This function does the rewrite. It given too many -- arguments, it simply discards them; the returned 'CoreExpr' -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args } -- See Note [Extra args in rule matching] in Rules.lhs +type IdUnfoldingFun = Id -> Unfolding +-- A function that embodies how to unfold an Id if you need +-- to do that in the Rule. The reason we need to pass this info in +-- is that whether an Id is unfoldable depends on the simplifier phase + isBuiltinRule :: CoreRule -> Bool isBuiltinRule (BuiltinRule {}) = True isBuiltinRule _ = False @@ -408,11 +414,14 @@ data Unfolding | CoreUnfolding { -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.) - uf_tmpl :: CoreExpr, -- Template; occurrence info is correct - uf_arity :: Arity, -- Number of value arguments expected + uf_tmpl :: CoreExpr, -- Template; occurrence info is correct + uf_src :: UnfoldingSource, -- Where the unfolding came from uf_is_top :: Bool, -- True <=> top level binding + uf_arity :: Arity, -- Number of value arguments expected uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard a `seq` on -- this variable + uf_is_conlike :: Bool, -- True <=> application of constructor or CONLIKE function + -- Cached version of exprIsConLike uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining -- Cached version of exprIsCheap uf_expandable :: Bool, -- True <=> can expand in RULE matching @@ -436,24 +445,38 @@ data Unfolding -- uf_guidance: Tells us about the /size/ of the unfolding template ------------------------------------------------ +data UnfoldingSource + = InlineCompulsory -- Something that *has* no binding, so you *must* inline it + -- Only a few primop-like things have this property + -- (see MkId.lhs, calls to mkCompulsoryUnfolding). + -- Inline absolutely always, however boring the context. + + | InlineRule -- From an {-# INLINE #-} pragma; See Note [InlineRules] + + | InlineWrapper Id -- This unfolding is a the wrapper in a + -- worker/wrapper split from the strictness analyser + -- The Id is the worker-id + -- Used to abbreviate the uf_tmpl in interface files + -- which don't need to contain the RHS; + -- it can be derived from the strictness info + + | InlineRhs -- The current rhs of the function + + -- For InlineRhs, the uf_tmpl is replaced each time around + -- For all the others we leave uf_tmpl alone + + -- | 'UnfoldingGuidance' says when unfolding should take place data UnfoldingGuidance - = UnfoldAlways -- There is /no original definition/, so you'd better unfold. - -- The unfolding is guaranteed to have no free variables - -- so no need to think about it during dependency analysis - - | InlineRule { -- See Note [InlineRules] - -- Be very keen to inline this - -- The uf_tmpl is the *original* RHS; do *not* replace it on - -- each simlifier run. Hence, the *actual* RHS of the function - -- may be different by now, because it may have been optimised. - ug_ir_info :: InlineRuleInfo, -- Supplementary info about the InlineRule - ug_small :: Bool -- True <=> the RHS is so small (eg no bigger than a call) - -- that you should always inline a saturated call, - } -- regardless of how boring the context is - -- See Note [INLINE for small functions] in CoreUnfold] - - | UnfoldIfGoodArgs { -- Arose from a normal Id; the info here is the + = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl + -- Used (a) for small *and* cheap unfoldings + -- (b) for INLINE functions + -- See Note [INLINE for small functions] in CoreUnfold + ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated + ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring + } + + | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the -- result of a simple analysis of the RHS ug_args :: [Int], -- Discount if the argument is evaluated. @@ -466,20 +489,16 @@ data UnfoldingGuidance } -- a context (case (thing args) of ...), -- (where there are the right number of arguments.) - | UnfoldNever + | UnfNever -- The RHS is big, so don't inline it -data InlineRuleInfo - = InlSat -- A user-specifed or compiler injected INLINE pragma - -- ONLY inline when it's applied to 'arity' arguments +-- Constants for the UnfWhen constructor +needSaturated, unSaturatedOk :: Bool +needSaturated = False +unSaturatedOk = True - | InlUnSat -- The compiler decided to "capture" the RHS into an - -- InlineRule, but do not require that it appears saturated - - | InlWrapper Id -- This unfolding is a the wrapper in a - -- worker/wrapper split from the strictness analyser - -- Used to abbreviate the uf_tmpl in interface files - -- which don't need to contain the RHS; - -- it can be derived from the strictness info +boringCxtNotOk, boringCxtOk :: Bool +boringCxtOk = True +boringCxtNotOk = False ------------------------------------------------ noUnfolding :: Unfolding @@ -496,17 +515,24 @@ mkOtherCon = OtherCon seqUnfolding :: Unfolding -> () seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, uf_is_value = b1, uf_is_cheap = b2, - uf_expandable = b3, uf_arity = a, uf_guidance = g}) - = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` seqGuidance g + uf_expandable = b3, uf_is_conlike = b4, + uf_arity = a, uf_guidance = g}) + = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g seqUnfolding _ = () seqGuidance :: UnfoldingGuidance -> () -seqGuidance (UnfoldIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` () -seqGuidance _ = () +seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` () +seqGuidance _ = () \end{code} \begin{code} +isInlineRuleSource :: UnfoldingSource -> Bool +isInlineRuleSource InlineCompulsory = True +isInlineRuleSource InlineRule = True +isInlineRuleSource (InlineWrapper {}) = True +isInlineRuleSource InlineRhs = False + -- | Retrieves the template of an unfolding: panics if none is known unfoldingTemplate :: Unfolding -> CoreExpr unfoldingTemplate = uf_tmpl @@ -541,6 +567,13 @@ isEvaldUnfolding (OtherCon _) = True isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald isEvaldUnfolding _ = False +-- | @True@ if the unfolding is a constructor application, the application +-- of a CONLIKE function or 'OtherCon' +isConLikeUnfolding :: Unfolding -> Bool +isConLikeUnfolding (OtherCon _) = True +isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con +isConLikeUnfolding _ = False + -- | Is the thing we will unfold into certainly cheap? isCheapUnfolding :: Unfolding -> Bool isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap @@ -551,20 +584,29 @@ isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expabl isExpandableUnfolding _ = False isInlineRule :: Unfolding -> Bool -isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True -isInlineRule _ = False - -isInlineRule_maybe :: Unfolding -> Maybe InlineRuleInfo -isInlineRule_maybe (CoreUnfolding { - uf_guidance = InlineRule { ug_ir_info = inl } }) = Just inl -isInlineRule_maybe _ = Nothing +isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src +isInlineRule _ = False + +isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool) +isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide }) + | isInlineRuleSource src + = Just (src, unsat_ok) + where + unsat_ok = case guide of + UnfWhen unsat_ok _ -> unsat_ok + _ -> needSaturated +isInlineRule_maybe _ = Nothing + +isCompulsoryUnfolding :: Unfolding -> Bool +isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True +isCompulsoryUnfolding _ = False isStableUnfolding :: Unfolding -> Bool -- True of unfoldings that should not be overwritten -- by a CoreUnfolding for the RHS of a let-binding -isStableUnfolding (CoreUnfolding { uf_guidance = InlineRule {} }) = True -isStableUnfolding (DFunUnfolding {}) = True -isStableUnfolding _ = False +isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src +isStableUnfolding (DFunUnfolding {}) = True +isStableUnfolding _ = False unfoldingArity :: Unfolding -> Arity unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity @@ -580,15 +622,15 @@ hasSomeUnfolding NoUnfolding = False hasSomeUnfolding _ = True neverUnfoldGuidance :: UnfoldingGuidance -> Bool -neverUnfoldGuidance UnfoldNever = True -neverUnfoldGuidance _ = False +neverUnfoldGuidance UnfNever = True +neverUnfoldGuidance _ = False canUnfold :: Unfolding -> Bool canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g) canUnfold _ = False \end{code} -Note [InlineRule] +Note [InlineRules] ~~~~~~~~~~~~~~~~~ When you say {-# INLINE f #-}