X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FcoreSyn%2FCoreSyn.lhs;h=5c7cef9ac9b99116ffecf913643b0bcf965a47bc;hb=c86161c5cf11de77e911fcb9e1e2bd1f8bd80b42;hp=25d2cdb3bafebca528b41f17903902890b548d70;hpb=d95ce839533391e7118257537044f01cbb1d6694;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 25d2cdb..5c7cef9 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -25,7 +25,7 @@ module CoreSyn ( mkConApp, mkTyBind, varToCoreExpr, varsToCoreExprs, - isTyVar, isIdVar, cmpAltCon, cmpAlt, ltAlt, + isTyVar, isId, cmpAltCon, cmpAlt, ltAlt, -- ** Simple 'Expr' access functions and predicates bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, @@ -35,16 +35,20 @@ module CoreSyn ( isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar, -- * Unfolding data types - Unfolding(..), UnfoldingGuidance(..), -- Both abstract everywhere but in CoreUnfold.lhs + 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, - isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding, - isInlineRule, isClosedUnfolding, hasSomeUnfolding, canUnfold, neverUnfoldGuidance, + maybeUnfoldingTemplate, otherCons, unfoldingArity, + isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, + isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, + isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, + isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource, -- * Strictness seqExpr, seqExprs, seqUnfolding, @@ -57,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, @@ -310,6 +314,8 @@ data CoreRule -- And the right-hand side ru_rhs :: CoreExpr, -- ^ Right hand side of the rule + -- Occurrence info is guaranteed correct + -- See Note [OccInfo in unfoldings and rules] -- Locality ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is @@ -324,17 +330,22 @@ data CoreRule -- | Built-in rules are used for constant folding -- and suchlike. They have no free variables. | BuiltinRule { - ru_name :: RuleName, -- ^ As above - ru_fn :: Name, -- ^ As above - ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' expects, - -- including type arguments - ru_try :: [CoreExpr] -> Maybe CoreExpr + ru_name :: RuleName, -- ^ As above + ru_fn :: Name, -- ^ As above + ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes, + -- if it fires, including type arguments + 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 @@ -378,60 +389,54 @@ The @Unfolding@ type is declared here to avoid numerous loops -- identifier would have if we substituted its definition in for the identifier. -- This type should be treated as abstract everywhere except in "CoreUnfold" data Unfolding - = NoUnfolding -- ^ We have no information about the unfolding - - | OtherCon [AltCon] -- ^ It ain't one of these constructors. - -- @OtherCon xs@ also indicates that something has been evaluated - -- and hence there's no point in re-evaluating it. - -- @OtherCon []@ is used even for non-data-type values - -- to indicated evaluated-ness. Notably: - -- - -- > data C = C !(Int -> Int) - -- > case x of { C f -> ... } - -- - -- Here, @f@ gets an @OtherCon []@ unfolding. - - | CompulsoryUnfolding { -- There is /no original definition/, so you'd better unfold. - uf_tmpl :: CoreExpr -- The unfolding is guaranteed to have no free variables - } -- so no need to think about it during dependency analysis - - | InlineRule { -- The function has an INLINE pragma, with the specified (original) RHS - -- (The inline phase, if any, is in the InlinePragInfo for this Id.) - -- Inline when (a) applied to at least this number of args - -- (b) if there is something interesting about args or context - uf_tmpl :: CoreExpr, -- The *original* RHS; occurrence info is correct - -- (The actual RHS of the function may be different by now, - -- but what we inline is still the original RHS (kept in the InlineRule).) - uf_is_top :: Bool, - - uf_arity :: Arity, -- Don't inline unless applied to this number of *value* args - uf_is_value :: Bool, -- True <=> exprIsHNF is true; save to discard a `seq` - uf_worker :: Maybe Id -- Just wrk_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 - -- In the Just case, interface files don't actually - -- need to contain the RHS; it can be derived from - -- the strictness info - -- Also used in CoreUnfold to guide inlining decisions - } + = NoUnfolding -- ^ We have no information about the unfolding + + | OtherCon [AltCon] -- ^ It ain't one of these constructors. + -- @OtherCon xs@ also indicates that something has been evaluated + -- and hence there's no point in re-evaluating it. + -- @OtherCon []@ is used even for non-data-type values + -- to indicated evaluated-ness. Notably: + -- + -- > data C = C !(Int -> Int) + -- > case x of { C f -> ... } + -- + -- Here, @f@ gets an @OtherCon []@ unfolding. + + | DFunUnfolding DataCon [CoreExpr] + -- The Unfolding of a DFunId + -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn) + -- (op2 a1..am d1..dn) + -- where Arity = n, the number of dict args to the dfun + -- The [CoreExpr] are the superclasses and methods [op1,op2], + -- in positional order. + -- They are usually variables, but can be trivial expressions + -- instead (e.g. a type application). | 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; binder-info is correct - 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_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining - -- Basically it's exprIsCheap - uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. + 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 + -- Cached version of exprIsExpandable + uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template. } -- ^ An unfolding with redundant cached information. Parameters: -- - -- uf_tmpl: Template used to perform unfolding; binder-info is correct + -- uf_tmpl: Template used to perform unfolding; + -- NB: Occurrence info is guaranteed correct: + -- see Note [OccInfo in unfoldings and rules] -- -- uf_is_top: Is this a top level binding? -- - -- uf_is_valiue: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on + -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on -- this variable -- -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining? @@ -440,23 +445,61 @@ 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 - = UnfoldNever - | UnfoldIfGoodArgs { - ug_arity :: Arity, -- "n" value args + = 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. -- (i.e., a simplification will definitely -- be possible). One elt of the list per *value* arg. - ug_size :: Int, -- The "size" of the unfolding; to be elaborated - -- later. ToDo + ug_size :: Int, -- The "size" of the unfolding. ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in } -- a context (case (thing args) of ...), -- (where there are the right number of arguments.) + | UnfNever -- The RHS is big, so don't inline it + +-- Constants for the UnfWhen constructor +needSaturated, unSaturatedOk :: Bool +needSaturated = False +unSaturatedOk = True + +boringCxtNotOk, boringCxtOk :: Bool +boringCxtOk = True +boringCxtNotOk = False + ------------------------------------------------ noUnfolding :: Unfolding -- ^ There is no known 'Unfolding' @@ -471,16 +514,25 @@ mkOtherCon = OtherCon seqUnfolding :: Unfolding -> () seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, - uf_is_value = b1, uf_is_cheap = b2, uf_guidance = g}) - = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g + uf_is_value = b1, uf_is_cheap = b2, + 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 n ns a b) = n `seq` sum ns `seq` a `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 @@ -491,8 +543,6 @@ setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs } -- | Retrieves the template of an unfolding if possible maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr -maybeUnfoldingTemplate (CompulsoryUnfolding { uf_tmpl = expr }) = Just expr -maybeUnfoldingTemplate (InlineRule { uf_tmpl = expr }) = Just expr maybeUnfoldingTemplate _ = Nothing -- | The constructors that the unfolding could never be: @@ -505,38 +555,66 @@ otherCons _ = [] -- yield a value (something in HNF): returns @False@ if unsure isValueUnfolding :: Unfolding -> Bool -- Returns False for OtherCon -isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald -isValueUnfolding (InlineRule { uf_is_value = is_evald }) = is_evald -isValueUnfolding _ = False +isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald +isValueUnfolding _ = False -- | Determines if it possibly the case that the unfolding will -- yield a value. Unlike 'isValueUnfolding' it returns @True@ -- for 'OtherCon' isEvaldUnfolding :: Unfolding -> Bool -- Returns True for OtherCon -isEvaldUnfolding (OtherCon _) = True -isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald -isEvaldUnfolding (InlineRule { uf_is_value = is_evald }) = is_evald -isEvaldUnfolding _ = False +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 isCheapUnfolding _ = False +isExpandableUnfolding :: Unfolding -> Bool +isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable +isExpandableUnfolding _ = False + isInlineRule :: Unfolding -> Bool -isInlineRule (InlineRule {}) = True -isInlineRule _ = False +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 --- | Must this unfolding happen for the code to be executable? isCompulsoryUnfolding :: Unfolding -> Bool -isCompulsoryUnfolding (CompulsoryUnfolding {}) = True -isCompulsoryUnfolding _ = False +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_src = src }) = isInlineRuleSource src +isStableUnfolding (DFunUnfolding {}) = True +isStableUnfolding _ = False + +unfoldingArity :: Unfolding -> Arity +unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity +unfoldingArity _ = panic "unfoldingArity" isClosedUnfolding :: Unfolding -> Bool -- No free variables -isClosedUnfolding (CoreUnfolding {}) = False -isClosedUnfolding (InlineRule {}) = False -isClosedUnfolding _ = True +isClosedUnfolding (CoreUnfolding {}) = False +isClosedUnfolding _ = True -- | Only returns False if there is no unfolding information available at all hasSomeUnfolding :: Unfolding -> Bool @@ -544,15 +622,54 @@ hasSomeUnfolding NoUnfolding = False hasSomeUnfolding _ = True neverUnfoldGuidance :: UnfoldingGuidance -> Bool -neverUnfoldGuidance UnfoldNever = True -neverUnfoldGuidance _ = False +neverUnfoldGuidance UnfNever = True +neverUnfoldGuidance _ = False canUnfold :: Unfolding -> Bool -canUnfold (InlineRule {}) = True canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g) canUnfold _ = False \end{code} +Note [InlineRules] +~~~~~~~~~~~~~~~~~ +When you say + {-# INLINE f #-} + f x = +you intend that calls (f e) are replaced by [e/x] So we +should capture (\x.) in the Unfolding of 'f', and never meddle +with it. Meanwhile, we can optimise to our heart's content, +leaving the original unfolding intact in Unfolding of 'f'. + +So the representation of an Unfolding has changed quite a bit +(see CoreSyn). An INLINE pragma gives rise to an InlineRule +unfolding. + +Moreover, it's only used when 'f' is applied to the +specified number of arguments; that is, the number of argument on +the LHS of the '=' sign in the original source definition. +For example, (.) is now defined in the libraries like this + {-# INLINE (.) #-} + (.) f g = \x -> f (g x) +so that it'll inline when applied to two arguments. If 'x' appeared +on the left, thus + (.) f g x = f (g x) +it'd only inline when applied to three arguments. This slightly-experimental +change was requested by Roman, but it seems to make sense. + +See also Note [Inlining an InlineRule] in CoreUnfold. + + +Note [OccInfo in unfoldings and rules] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In unfoldings and rules, we guarantee that the template is occ-analysed, +so that the occurence info on the binders is correct. This is important, +because the Simplifier does not re-analyse the template when using it. If +the occurrence info is wrong + - We may get more simpifier iterations than necessary, because + once-occ info isn't there + - More seriously, we may get an infinite loop if there's a Rec + without a loop breaker marked + %************************************************************************ %* * @@ -730,7 +847,7 @@ mkTyBind tv ty = NonRec tv (Type ty) -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately varToCoreExpr :: CoreBndr -> Expr b -varToCoreExpr v | isIdVar v = Var v +varToCoreExpr v | isId v = Var v | otherwise = Type (mkTyVarTy v) varsToCoreExprs :: [CoreBndr] -> [Expr b] @@ -803,8 +920,8 @@ collectTyBinders expr collectValBinders expr = go [] expr where - go ids (Lam b e) | isIdVar b = go (b:ids) e - go ids body = (reverse ids, body) + go ids (Lam b e) | isId b = go (b:ids) e + go ids body = (reverse ids, body) \end{code} \begin{code} @@ -842,7 +959,7 @@ at runtime. Similarly isRuntimeArg. \begin{code} -- | Will this variable exist at runtime? isRuntimeVar :: Var -> Bool -isRuntimeVar = isIdVar +isRuntimeVar = isId -- | Will this argument expression exist at runtime? isRuntimeArg :: CoreExpr -> Bool @@ -860,7 +977,7 @@ isTypeArg _ = False -- | The number of binders that bind values rather than types valBndrCount :: [CoreBndr] -> Int -valBndrCount = count isIdVar +valBndrCount = count isId -- | The number of argument expressions that are values rather than types at their top level valArgCount :: [Arg b] -> Int