X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSyn.lhs;h=072463081ba5d2f2422889c1dfc7592941cb064c;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hp=01e2be77c6517e37340631d8091d6ca7ccdbc14c;hpb=72462499b891d5779c19f3bda03f96e24f9554ae;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 01e2be7..0724630 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -35,7 +35,7 @@ module CoreSyn ( isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar, -- * Unfolding data types - Unfolding(..), UnfoldingGuidance(..), InlineRuleInfo(..), + Unfolding(..), UnfoldingGuidance(..), InlineRuleInfo(..), InlSatFlag(..), -- Abstract everywhere but in CoreUnfold.lhs -- ** Constructing 'Unfolding's @@ -45,7 +45,7 @@ module CoreSyn ( unfoldingTemplate, setUnfoldingTemplate, maybeUnfoldingTemplate, otherCons, unfoldingArity, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, - isExpandableUnfolding, + isExpandableUnfolding, isConLikeUnfolding, isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, isStableUnfolding, canUnfold, neverUnfoldGuidance, @@ -413,6 +413,8 @@ data Unfolding uf_is_top :: Bool, -- True <=> top level binding 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 @@ -438,20 +440,14 @@ data Unfolding ------------------------------------------------ -- | '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 + = InlineRule { -- Be very keen to inline this; See Note [InlineRules] -- 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] + + ir_sat :: InlSatFlag, + ir_info :: InlineRuleInfo + } | UnfoldIfGoodArgs { -- Arose from a normal Id; the info here is the -- result of a simple analysis of the RHS @@ -466,20 +462,30 @@ data UnfoldingGuidance } -- a context (case (thing args) of ...), -- (where there are the right number of arguments.) - | UnfoldNever + | UnfoldNever -- A variant of UnfoldIfGoodArgs, used for big RHSs data InlineRuleInfo - = InlSat -- A user-specifed or compiler injected INLINE pragma - -- ONLY inline when it's applied to 'arity' arguments + = InlAlways -- Inline absolutely always, however boring the context. + -- There is /no original definition/. Only a few primop-like things + -- have this property (see MkId.lhs, calls to mkCompulsoryUnfolding). - | InlUnSat -- The compiler decided to "capture" the RHS into an - -- InlineRule, but do not require that it appears saturated + | InlSmall -- The RHS is very small (eg no bigger than a call), so inline any + -- /saturated/ application, regardless of context + -- See Note [INLINE for small functions] in CoreUnfold - | 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 + | InlVanilla + + | InlWrapper 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 + -- [In principle this is orthogonal to the InlSmall/InVanilla thing, + -- but it's convenient to have it here.] + +data InlSatFlag = InlSat | InlUnSat + -- Specifies whether to INLINE only if the thing is applied to 'arity' args ------------------------------------------------ noUnfolding :: Unfolding @@ -496,8 +502,9 @@ 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 _ = () @@ -541,6 +548,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 @@ -554,10 +568,10 @@ 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_maybe :: Unfolding -> Maybe (InlineRuleInfo, InlSatFlag) +isInlineRule_maybe (CoreUnfolding { uf_guidance = + InlineRule { ir_info = inl, ir_sat = sat } }) = Just (inl,sat) +isInlineRule_maybe _ = Nothing isStableUnfolding :: Unfolding -> Bool -- True of unfoldings that should not be overwritten