X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreSyn.lhs;h=603b745cf2547e4a8c14894f7396f5dd502c5db1;hb=841e81e28f8cc711f624fdca122219a5bbde2fae;hp=b6e73134597f199b50c0786711cd01a78cda1817;hpb=c01e472e205f09e6cdadc1c878263998f637bc8d;p=ghc-hetmet.git diff --git a/compiler/coreSyn/CoreSyn.lhs b/compiler/coreSyn/CoreSyn.lhs index b6e7313..603b745 100644 --- a/compiler/coreSyn/CoreSyn.lhs +++ b/compiler/coreSyn/CoreSyn.lhs @@ -4,6 +4,7 @@ % \begin{code} +{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-} -- | 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,21 +34,24 @@ module CoreSyn ( collectArgs, coreExprCc, flattenBinds, isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar, + notSccNote, -- * Unfolding data types - Unfolding(..), UnfoldingGuidance(..), InlineRuleInfo(..), - -- Abstract everywhere but in CoreUnfold.lhs - + Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..), + DFunArg(..), dfunArgExprs, + -- ** Constructing 'Unfolding's noUnfolding, evaldUnfolding, mkOtherCon, + unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk, -- ** Predicates and deconstruction on 'Unfolding' - unfoldingTemplate, setUnfoldingTemplate, + unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe, maybeUnfoldingTemplate, otherCons, unfoldingArity, isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, - isExpandableUnfolding, isConLikeUnfolding, - isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding, - isStableUnfolding, canUnfold, neverUnfoldGuidance, + isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding, + isStableUnfolding, isStableCoreUnfolding_maybe, + isClosedUnfolding, hasSomeUnfolding, + canUnfold, neverUnfoldGuidance, isStableSource, -- * Strictness seqExpr, seqExprs, seqUnfolding, @@ -55,17 +59,23 @@ module CoreSyn ( -- * Annotated expression data types AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt, + -- ** Operations on annotated expressions + collectAnnArgs, + -- ** Operations on annotations deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs, -- * Core rule data types CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only - RuleName, + RuleName, IdUnfoldingFun, -- ** Operations on 'CoreRule's - seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe, + seqRules, ruleArity, ruleName, ruleIdName, ruleActivation, setRuleIdName, - isBuiltinRule, isLocalRule + isBuiltinRule, isLocalRule, + + -- * Core vectorisation declarations data type + CoreVect(..) ) where #include "HsVersions.h" @@ -82,9 +92,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} @@ -97,8 +108,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 . @@ -134,11 +143,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. @@ -151,14 +164,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# -- @@ -178,6 +193,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 @@ -187,15 +203,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: @@ -209,14 +227,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 @@ -232,11 +255,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 --------------------------- @@ -276,6 +300,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} @@ -300,7 +325,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 @@ -317,6 +342,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, @@ -333,13 +362,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 @@ -353,9 +387,9 @@ ruleArity (Rule {ru_args = args}) = length args ruleName :: CoreRule -> RuleName ruleName = ru_name -ruleActivation_maybe :: CoreRule -> Maybe Activation -ruleActivation_maybe (BuiltinRule { }) = Nothing -ruleActivation_maybe (Rule { ru_act = act }) = Just act +ruleActivation :: CoreRule -> Activation +ruleActivation (BuiltinRule { }) = AlwaysActive +ruleActivation (Rule { ru_act = act }) = act -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side ruleIdName :: CoreRule -> Name @@ -371,6 +405,20 @@ setRuleIdName nm ru = ru { ru_fn = nm } %************************************************************************ +%* * +\subsection{Vectorisation declarations} +%* * +%************************************************************************ + +Representation of desugared vectorisation declarations that are fed to the vectoriser (via +'ModGuts'). + +\begin{code} +data CoreVect = Vect Id (Maybe CoreExpr) +\end{code} + + +%************************************************************************ %* * Unfoldings %* * @@ -396,26 +444,32 @@ 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], - -- 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; occurrence info is correct - uf_arity :: Arity, -- Number of value arguments expected + + 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) + + [DFunArg CoreExpr] -- Specification of superclasses and methods, in positional order + + | 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_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_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 <=> 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 @@ -438,24 +492,70 @@ data Unfolding -- uf_guidance: Tells us about the /size/ of the unfolding template ------------------------------------------------ +data DFunArg e -- Given (df a b d1 d2 d3) + = DFunPolyArg e -- Arg is (e a b d1 d2 d3) + | DFunConstArg e -- Arg is e, which is constant + | DFunLamArg Int -- Arg is one of [a,b,d1,d2,d3], zero indexed + deriving( Functor ) + + -- 'e' is often CoreExpr, which are usually variables, but can + -- be trivial expressions instead (e.g. a type application). + +dfunArgExprs :: [DFunArg e] -> [e] +dfunArgExprs [] = [] +dfunArgExprs (DFunPolyArg e : as) = e : dfunArgExprs as +dfunArgExprs (DFunConstArg e : as) = e : dfunArgExprs as +dfunArgExprs (DFunLamArg {} : as) = dfunArgExprs as + + +------------------------------------------------ +data UnfoldingSource + = 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/UnfoldNever + -- (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. + + | 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 + + + -- | '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 + -- So True,True means "always" + } + + | 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. @@ -468,20 +568,46 @@ 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 +\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 -data InlineRuleInfo - = InlSat -- A user-specifed or compiler injected INLINE pragma - -- ONLY inline when it's applied to 'arity' arguments + class C a where { op :: a -> Int } + instance C a -> C [a] where op xs = op (head xs) - | InlUnSat -- The compiler decided to "capture" the RHS into an - -- InlineRule, but do not require that it appears saturated +The instance translates to - | 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 + $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 +unSaturatedOk = True + +boringCxtNotOk, boringCxtOk :: Bool +boringCxtOk = True +boringCxtNotOk = False ------------------------------------------------ noUnfolding :: Unfolding @@ -505,11 +631,18 @@ seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, 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} +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 unfoldingTemplate = uf_tmpl @@ -560,21 +693,28 @@ isExpandableUnfolding :: Unfolding -> Bool isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable isExpandableUnfolding _ = False -isInlineRule :: Unfolding -> Bool -isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True -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 + +isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource +isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src }) + | isStableSource src = Just src +isStableCoreUnfolding_maybe _ = Nothing -isInlineRule_maybe :: Unfolding -> Maybe InlineRuleInfo -isInlineRule_maybe (CoreUnfolding { - uf_guidance = InlineRule { ug_ir_info = inl } }) = Just inl -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 }) = isStableSource src +isStableUnfolding (DFunUnfolding {}) = True +isStableUnfolding _ = False unfoldingArity :: Unfolding -> Arity unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity @@ -582,6 +722,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 @@ -590,15 +731,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 #-} @@ -606,11 +747,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 @@ -882,7 +1025,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 @@ -950,6 +1093,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} @@ -1037,6 +1184,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