X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSyn.lhs;h=1181931fa7723d4e1be533a6709a23dfa0313ffd;hb=5e218036aabd1666ff2b509436e4e88491596c37;hp=5c7cef9ac9b99116ffecf913643b0bcf965a47bc;hpb=c86161c5cf11de77e911fcb9e1e2bd1f8bd80b42;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index 5c7cef9..1181931 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -4,6 +4,7 @@ % \begin{code} +{-# LANGUAGE DeriveDataTypeable #-} -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection module CoreSyn ( @@ -25,7 +26,7 @@ module CoreSyn ( mkConApp, mkTyBind, varToCoreExpr, varsToCoreExprs, - isTyVar, isId, cmpAltCon, cmpAlt, ltAlt, + isTyCoVar, isId, cmpAltCon, cmpAlt, ltAlt, -- ** Simple 'Expr' access functions and predicates bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, @@ -33,6 +34,7 @@ module CoreSyn ( collectArgs, coreExprCc, flattenBinds, isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar, + notSccNote, -- * Unfolding data types Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..), @@ -43,12 +45,13 @@ module CoreSyn ( unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk, -- ** Predicates and deconstruction on 'Unfolding' - unfoldingTemplate, setUnfoldingTemplate, + unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe, maybeUnfoldingTemplate, otherCons, unfoldingArity, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, - isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, - isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource, + isStableUnfolding, isStableUnfolding_maybe, + isClosedUnfolding, hasSomeUnfolding, + canUnfold, neverUnfoldGuidance, isStableSource, -- * Strictness seqExpr, seqExprs, seqUnfolding, @@ -56,6 +59,9 @@ module CoreSyn ( -- * Annotated expression data types AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt, + -- ** Operations on annotated expressions + collectAnnArgs, + -- ** Operations on annotations deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs, @@ -83,9 +89,10 @@ import FastString import Outputable import Util +import Data.Data import Data.Word -infixl 4 `mkApps`, `mkTyApps`, `mkVarApps` +infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App` -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys) \end{code} @@ -98,8 +105,6 @@ infixl 4 `mkApps`, `mkTyApps`, `mkVarApps` These data types are the heart of the compiler \begin{code} -infixl 8 `App` -- App brackets to the left - -- | This is the data type that represents GHCs core intermediate language. Currently -- GHC uses System FC for this purpose, -- which is closely related to the simpler and better known System F . @@ -135,11 +140,15 @@ infixl 8 `App` -- App brackets to the left -- The type parameter @b@ is for the type of binders in the expression tree. data Expr b = Var Id -- ^ Variables + | Lit Literal -- ^ Primitive literals + | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'. -- -- See "CoreSyn#let_app_invariant" for another invariant + | Lam b (Expr b) -- ^ Lambda abstraction + | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally -- this corresponds to allocating a thunk for the things -- bound and then executing the sub-expression. @@ -152,14 +161,16 @@ data Expr b -- the meaning of /lifted/ vs. /unlifted/). -- -- #let_app_invariant# - -- The right hand side of of a non-recursive 'Let' _and_ the argument of an 'App', + -- The right hand side of of a non-recursive 'Let' + -- _and_ the argument of an 'App', -- /may/ be of unlifted type, but only if the expression - -- is ok-for-speculation. This means that the let can be floated around - -- without difficulty. For example, this is OK: + -- is ok-for-speculation. This means that the let can be floated + -- around without difficulty. For example, this is OK: -- -- > y::Int# = x +# 1# -- - -- But this is not, as it may affect termination if the expression is floated out: + -- But this is not, as it may affect termination if the + -- expression is floated out: -- -- > y::Int# = fac 4# -- @@ -179,6 +190,7 @@ data Expr b -- At the moment, the rest of the compiler only deals with type-let -- in a Let expression, rather than at top level. We may want to revist -- this choice. + | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating -- the scrutinee (expression examined) to weak head normal form -- and then examining at most one level of resulting constructor (i.e. you @@ -188,15 +200,17 @@ data Expr b -- and the 'Type' must be that of all the case alternatives -- -- #case_invariants# - -- This is one of the more complicated elements of the Core language, and comes - -- with a number of restrictions: + -- This is one of the more complicated elements of the Core language, + -- and comes with a number of restrictions: -- - -- The 'DEFAULT' case alternative must be first in the list, if it occurs at all. + -- The 'DEFAULT' case alternative must be first in the list, + -- if it occurs at all. -- -- The remaining cases are in order of increasing -- tag (for 'DataAlts') or -- lit (for 'LitAlts'). - -- This makes finding the relevant constructor easy, and makes comparison easier too. + -- This makes finding the relevant constructor easy, + -- and makes comparison easier too. -- -- The list of alternatives must be exhaustive. An /exhaustive/ case -- does not necessarily mention all constructors: @@ -210,14 +224,19 @@ data Expr b -- Blue -> ... ) ... -- @ -- - -- The inner case does not need a @Red@ alternative, because @x@ can't be @Red@ at - -- that program point. - | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type. This is used to implement @newtype@s - -- (a @newtype@ constructor or destructor just becomes a 'Cast' in Core) and GADTs. + -- The inner case does not need a @Red@ alternative, because @x@ + -- can't be @Red@ at that program point. + + | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type. + -- This is used to implement @newtype@s (a @newtype@ constructor or + -- destructor just becomes a 'Cast' in Core) and GADTs. + | Note Note (Expr b) -- ^ Notes. These allow general information to be -- added to expressions in the syntax tree + | Type Type -- ^ A type: this should only show up at the top -- level of an Arg + deriving (Data, Typeable) -- | Type synonym for expressions that occur in function argument positions. -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not @@ -233,11 +252,12 @@ data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@ | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@ | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@ - deriving (Eq, Ord) + deriving (Eq, Ord, Data, Typeable) -- | Binding, used for top level bindings in a module and local bindings in a @let@. data Bind b = NonRec b (Expr b) | Rec [(b, (Expr b))] + deriving (Data, Typeable) \end{code} -------------------------- CoreSyn INVARIANTS --------------------------- @@ -277,6 +297,7 @@ See #type_let# data Note = SCC CostCentre -- ^ A cost centre annotation for profiling | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC + deriving (Data, Typeable) \end{code} @@ -301,7 +322,7 @@ data CoreRule = Rule { ru_name :: RuleName, -- ^ Name of the rule, for communication with the user ru_act :: Activation, -- ^ When the rule is active - + -- Rough-matching stuff -- see comments with InstEnv.Instance( is_cls, is_rough ) ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule @@ -318,6 +339,10 @@ data CoreRule -- See Note [OccInfo in unfoldings and rules] -- Locality + ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated + -- @False@ <=> generated at the users behest + -- Main effect: reporting of orphan-hood + ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is -- defined in the same module as the rule -- and is not an implicit 'Id' (like a record selector, @@ -402,27 +427,35 @@ data Unfolding -- -- Here, @f@ gets an @OtherCon []@ unfolding. - | DFunUnfolding DataCon [CoreExpr] - -- The Unfolding of a DFunId + | DFunUnfolding -- The Unfolding of a DFunId + -- See Note [DFun unfoldings] -- 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], + + Arity -- Arity = m+n, the *total* number of args + -- (unusually, both type and value) to the dfun + + DataCon -- The dictionary data constructor (possibly a newtype datacon) + + [CoreExpr] -- 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.) + | 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_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 + uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard + -- a `seq` on this variable + uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function -- Cached version of exprIsConLike - uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining + 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 @@ -446,13 +479,31 @@ data Unfolding ------------------------------------------------ data UnfoldingSource - = InlineCompulsory -- Something that *has* no binding, so you *must* inline it + = InlineRhs -- The current rhs of the function + -- Replace uf_tmpl each time around + + | InlineStable -- From an INLINE or INLINABLE pragma + -- INLINE if guidance is UnfWhen + -- INLINABLE if guidance is UnfIfGoodArgs + -- (well, technically an INLINABLE might be made + -- UnfWhen if it was small enough, and then + -- it will behave like INLINE outside the current + -- module, but that is the way automatic unfoldings + -- work so it is consistent with the intended + -- meaning of INLINABLE). + -- + -- uf_tmpl may change, but only as a result of + -- gentle simplification, it doesn't get updated + -- to the current RHS during compilation as with + -- InlineRhs. + -- + -- See Note [InlineRules] + + | 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 @@ -460,10 +511,6 @@ data UnfoldingSource -- 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 @@ -474,6 +521,7 @@ data UnfoldingGuidance -- 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 + -- So True,True means "always" } | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the @@ -490,7 +538,37 @@ data UnfoldingGuidance -- (where there are the right number of arguments.) | UnfNever -- The RHS is big, so don't inline it +\end{code} + + +Note [DFun unfoldings] +~~~~~~~~~~~~~~~~~~~~~~ +The Arity in a DFunUnfolding is total number of args (type and value) +that the DFun needs to produce a dictionary. That's not necessarily +related to the ordinary arity of the dfun Id, esp if the class has +one method, so the dictionary is represented by a newtype. Example + + class C a where { op :: a -> Int } + instance C a -> C [a] where op xs = op (head xs) + +The instance translates to + + $dfCList :: forall a. C a => C [a] -- Arity 2! + $dfCList = /\a.\d. $copList {a} d |> co + + $copList :: forall a. C a => [a] -> Int -- Arity 2! + $copList = /\a.\d.\xs. op {a} d (head xs) + +Now we might encounter (op (dfCList {ty} d) a1 a2) +and we want the (op (dfList {ty} d)) rule to fire, because $dfCList +has all its arguments, even though its (value) arity is 2. That's +why we record the number of expected arguments in the DFunUnfolding. + +Note that although it's an Arity, it's most convenient for it to give +the *total* number of arguments, both type and value. See the use +site in exprIsConApp_maybe. +\begin{code} -- Constants for the UnfWhen constructor needSaturated, unSaturatedOk :: Bool needSaturated = False @@ -527,11 +605,12 @@ seqGuidance _ = () \end{code} \begin{code} -isInlineRuleSource :: UnfoldingSource -> Bool -isInlineRuleSource InlineCompulsory = True -isInlineRuleSource InlineRule = True -isInlineRuleSource (InlineWrapper {}) = True -isInlineRuleSource InlineRhs = False +isStableSource :: UnfoldingSource -> Bool +-- Keep the unfolding template +isStableSource InlineCompulsory = True +isStableSource InlineStable = True +isStableSource (InlineWrapper {}) = True +isStableSource InlineRhs = False -- | Retrieves the template of an unfolding: panics if none is known unfoldingTemplate :: Unfolding -> CoreExpr @@ -583,19 +662,22 @@ isExpandableUnfolding :: Unfolding -> Bool isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable isExpandableUnfolding _ = False -isInlineRule :: Unfolding -> Bool -isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src -isInlineRule _ = False +expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr +-- Expand an expandable unfolding; this is used in rule matching +-- See Note [Expanding variables] in Rules.lhs +-- The key point here is that CONLIKE things can be expanded +expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs +expandUnfolding_maybe _ = Nothing -isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool) -isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide }) - | isInlineRuleSource src +isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool) +isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide }) + | isStableSource src = Just (src, unsat_ok) where unsat_ok = case guide of UnfWhen unsat_ok _ -> unsat_ok _ -> needSaturated -isInlineRule_maybe _ = Nothing +isStableUnfolding_maybe _ = Nothing isCompulsoryUnfolding :: Unfolding -> Bool isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True @@ -604,7 +686,7 @@ 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 (CoreUnfolding { uf_src = src }) = isStableSource src isStableUnfolding (DFunUnfolding {}) = True isStableUnfolding _ = False @@ -614,6 +696,7 @@ unfoldingArity _ = panic "unfoldingArity" isClosedUnfolding :: Unfolding -> Bool -- No free variables isClosedUnfolding (CoreUnfolding {}) = False +isClosedUnfolding (DFunUnfolding {}) = False isClosedUnfolding _ = True -- | Only returns False if there is no unfolding information available at all @@ -638,11 +721,13 @@ When you say 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'. +leaving the original unfolding intact in Unfolding of 'f'. For example + all xs = foldr (&&) True xs + any p = all . map p {-# INLINE any #-} +We optimise any's RHS fully, but leave the InlineRule saying "all . map p", +which deforests well at the call site. -So the representation of an Unfolding has changed quite a bit -(see CoreSyn). An INLINE pragma gives rise to an InlineRule -unfolding. +So INLINE pragma gives rise to an InlineRule, which captures the original RHS. Moreover, it's only used when 'f' is applied to the specified number of arguments; that is, the number of argument on @@ -914,7 +999,7 @@ collectTyAndValBinders expr collectTyBinders expr = go [] expr where - go tvs (Lam b e) | isTyVar b = go (b:tvs) e + go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e go tvs e = (reverse tvs, e) collectValBinders expr @@ -982,6 +1067,10 @@ valBndrCount = count isId -- | The number of argument expressions that are values rather than types at their top level valArgCount :: [Arg b] -> Int valArgCount = count isValArg + +notSccNote :: Note -> Bool +notSccNote (SCC {}) = False +notSccNote _ = True \end{code} @@ -1069,6 +1158,17 @@ data AnnBind bndr annot \end{code} \begin{code} +-- | Takes a nested application expression and returns the the function +-- being applied and the arguments to which it is applied +collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a]) +collectAnnArgs expr + = go expr [] + where + go (_, AnnApp f a) as = go f (a:as) + go e as = (e, as) +\end{code} + +\begin{code} deAnnotate :: AnnExpr bndr annot -> Expr bndr deAnnotate (_, e) = deAnnotate' e