2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
7 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
9 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
12 Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
13 CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
14 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
16 -- ** 'Expr' construction
18 mkApps, mkTyApps, mkVarApps,
20 mkIntLit, mkIntLitInt,
21 mkWordLit, mkWordLitWord,
22 mkCharLit, mkStringLit,
23 mkFloatLit, mkFloatLitFloat,
24 mkDoubleLit, mkDoubleLitDouble,
27 varToCoreExpr, varsToCoreExprs,
29 isTyCoVar, isId, cmpAltCon, cmpAlt, ltAlt,
31 -- ** Simple 'Expr' access functions and predicates
32 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
33 collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
34 collectArgs, coreExprCc, flattenBinds,
36 isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
39 -- * Unfolding data types
40 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
41 DFunArg(..), dfunArgExprs,
43 -- ** Constructing 'Unfolding's
44 noUnfolding, evaldUnfolding, mkOtherCon,
45 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
47 -- ** Predicates and deconstruction on 'Unfolding'
48 unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
49 maybeUnfoldingTemplate, otherCons, unfoldingArity,
50 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
51 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
52 isStableUnfolding, isStableCoreUnfolding_maybe,
53 isClosedUnfolding, hasSomeUnfolding,
54 canUnfold, neverUnfoldGuidance, isStableSource,
57 seqExpr, seqExprs, seqUnfolding,
59 -- * Annotated expression data types
60 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
62 -- ** Operations on annotated expressions
65 -- ** Operations on annotations
66 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
68 -- * Core rule data types
69 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
70 RuleName, IdUnfoldingFun,
72 -- ** Operations on 'CoreRule's
73 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
75 isBuiltinRule, isLocalRule,
77 -- * Core vectorisation declarations data type
81 #include "HsVersions.h"
98 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`
99 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
102 %************************************************************************
104 \subsection{The main data types}
106 %************************************************************************
108 These data types are the heart of the compiler
111 -- | This is the data type that represents GHCs core intermediate language. Currently
112 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
113 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
115 -- We get from Haskell source to this Core language in a number of stages:
117 -- 1. The source code is parsed into an abstract syntax tree, which is represented
118 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
120 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
121 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
122 -- For example, this program:
125 -- f x = let f x = x + 1
129 -- Would be renamed by having 'Unique's attached so it looked something like this:
132 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
136 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
137 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
139 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
140 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
141 -- optimization, analysis and code generation on.
143 -- The type parameter @b@ is for the type of binders in the expression tree.
145 = Var Id -- ^ Variables
147 | Lit Literal -- ^ Primitive literals
149 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
151 -- See "CoreSyn#let_app_invariant" for another invariant
153 | Lam b (Expr b) -- ^ Lambda abstraction
155 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
156 -- this corresponds to allocating a thunk for the things
157 -- bound and then executing the sub-expression.
159 -- #top_level_invariant#
160 -- #letrec_invariant#
162 -- The right hand sides of all top-level and recursive @let@s
163 -- /must/ be of lifted type (see "Type#type_classification" for
164 -- the meaning of /lifted/ vs. /unlifted/).
166 -- #let_app_invariant#
167 -- The right hand side of of a non-recursive 'Let'
168 -- _and_ the argument of an 'App',
169 -- /may/ be of unlifted type, but only if the expression
170 -- is ok-for-speculation. This means that the let can be floated
171 -- around without difficulty. For example, this is OK:
173 -- > y::Int# = x +# 1#
175 -- But this is not, as it may affect termination if the
176 -- expression is floated out:
178 -- > y::Int# = fac 4#
180 -- In this situation you should use @case@ rather than a @let@. The function
181 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
182 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
183 -- which will generate a @case@ if necessary
186 -- We allow a /non-recursive/ let to bind a type variable, thus:
188 -- > Let (NonRec tv (Type ty)) body
190 -- This can be very convenient for postponing type substitutions until
191 -- the next run of the simplifier.
193 -- At the moment, the rest of the compiler only deals with type-let
194 -- in a Let expression, rather than at top level. We may want to revist
197 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
198 -- the scrutinee (expression examined) to weak head normal form
199 -- and then examining at most one level of resulting constructor (i.e. you
200 -- cannot do nested pattern matching directly with this).
202 -- The binder gets bound to the value of the scrutinee,
203 -- and the 'Type' must be that of all the case alternatives
206 -- This is one of the more complicated elements of the Core language,
207 -- and comes with a number of restrictions:
209 -- The 'DEFAULT' case alternative must be first in the list,
210 -- if it occurs at all.
212 -- The remaining cases are in order of increasing
213 -- tag (for 'DataAlts') or
214 -- lit (for 'LitAlts').
215 -- This makes finding the relevant constructor easy,
216 -- and makes comparison easier too.
218 -- The list of alternatives must be exhaustive. An /exhaustive/ case
219 -- does not necessarily mention all constructors:
222 -- data Foo = Red | Green | Blue
225 -- other -> f (case x of
230 -- The inner case does not need a @Red@ alternative, because @x@
231 -- can't be @Red@ at that program point.
233 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type.
234 -- This is used to implement @newtype@s (a @newtype@ constructor or
235 -- destructor just becomes a 'Cast' in Core) and GADTs.
237 | Note Note (Expr b) -- ^ Notes. These allow general information to be
238 -- added to expressions in the syntax tree
240 | Type Type -- ^ A type: this should only show up at the top
242 deriving (Data, Typeable)
244 -- | Type synonym for expressions that occur in function argument positions.
245 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
248 -- | A case split alternative. Consists of the constructor leading to the alternative,
249 -- the variables bound from the constructor, and the expression to be executed given that binding.
250 -- The default alternative is @(DEFAULT, [], rhs)@
251 type Alt b = (AltCon, [b], Expr b)
253 -- | A case alternative constructor (i.e. pattern match)
254 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
255 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
256 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
257 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
258 deriving (Eq, Ord, Data, Typeable)
260 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
261 data Bind b = NonRec b (Expr b)
262 | Rec [(b, (Expr b))]
263 deriving (Data, Typeable)
266 -------------------------- CoreSyn INVARIANTS ---------------------------
268 Note [CoreSyn top-level invariant]
269 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
270 See #toplevel_invariant#
272 Note [CoreSyn letrec invariant]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
274 See #letrec_invariant#
276 Note [CoreSyn let/app invariant]
277 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278 See #let_app_invariant#
280 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
282 Note [CoreSyn case invariants]
283 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
284 See #case_invariants#
286 Note [CoreSyn let goal]
287 ~~~~~~~~~~~~~~~~~~~~~~~
288 * The simplifier tries to ensure that if the RHS of a let is a constructor
289 application, its arguments are trivial, so that the constructor can be
299 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
301 = SCC CostCentre -- ^ A cost centre annotation for profiling
302 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
303 deriving (Data, Typeable)
307 %************************************************************************
309 \subsection{Transformation rules}
311 %************************************************************************
313 The CoreRule type and its friends are dealt with mainly in CoreRules,
314 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
317 -- | A 'CoreRule' is:
319 -- * \"Local\" if the function it is a rule for is defined in the
320 -- same module as the rule itself.
322 -- * \"Orphan\" if nothing on the LHS is defined in the same module
323 -- as the rule itself
326 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
327 ru_act :: Activation, -- ^ When the rule is active
329 -- Rough-matching stuff
330 -- see comments with InstEnv.Instance( is_cls, is_rough )
331 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
332 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
334 -- Proper-matching stuff
335 -- see comments with InstEnv.Instance( is_tvs, is_tys )
336 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
337 ru_args :: [CoreExpr], -- ^ Left hand side arguments
339 -- And the right-hand side
340 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
341 -- Occurrence info is guaranteed correct
342 -- See Note [OccInfo in unfoldings and rules]
345 ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
346 -- @False@ <=> generated at the users behest
347 -- Main effect: reporting of orphan-hood
349 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
350 -- defined in the same module as the rule
351 -- and is not an implicit 'Id' (like a record selector,
352 -- class operation, or data constructor)
354 -- NB: ru_local is *not* used to decide orphan-hood
355 -- c.g. MkIface.coreRuleToIfaceRule
358 -- | Built-in rules are used for constant folding
359 -- and suchlike. They have no free variables.
361 ru_name :: RuleName, -- ^ As above
362 ru_fn :: Name, -- ^ As above
363 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
364 -- if it fires, including type arguments
365 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
366 -- ^ This function does the rewrite. It given too many
367 -- arguments, it simply discards them; the returned 'CoreExpr'
368 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
370 -- See Note [Extra args in rule matching] in Rules.lhs
372 type IdUnfoldingFun = Id -> Unfolding
373 -- A function that embodies how to unfold an Id if you need
374 -- to do that in the Rule. The reason we need to pass this info in
375 -- is that whether an Id is unfoldable depends on the simplifier phase
377 isBuiltinRule :: CoreRule -> Bool
378 isBuiltinRule (BuiltinRule {}) = True
379 isBuiltinRule _ = False
381 -- | The number of arguments the 'ru_fn' must be applied
382 -- to before the rule can match on it
383 ruleArity :: CoreRule -> Int
384 ruleArity (BuiltinRule {ru_nargs = n}) = n
385 ruleArity (Rule {ru_args = args}) = length args
387 ruleName :: CoreRule -> RuleName
390 ruleActivation :: CoreRule -> Activation
391 ruleActivation (BuiltinRule { }) = AlwaysActive
392 ruleActivation (Rule { ru_act = act }) = act
394 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
395 ruleIdName :: CoreRule -> Name
398 isLocalRule :: CoreRule -> Bool
399 isLocalRule = ru_local
401 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
402 setRuleIdName :: Name -> CoreRule -> CoreRule
403 setRuleIdName nm ru = ru { ru_fn = nm }
407 %************************************************************************
409 \subsection{Vectorisation declarations}
411 %************************************************************************
413 Representation of desugared vectorisation declarations that are fed to the vectoriser (via
417 data CoreVect = Vect Id (Maybe CoreExpr)
421 %************************************************************************
425 %************************************************************************
427 The @Unfolding@ type is declared here to avoid numerous loops
430 -- | Records the /unfolding/ of an identifier, which is approximately the form the
431 -- identifier would have if we substituted its definition in for the identifier.
432 -- This type should be treated as abstract everywhere except in "CoreUnfold"
434 = NoUnfolding -- ^ We have no information about the unfolding
436 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
437 -- @OtherCon xs@ also indicates that something has been evaluated
438 -- and hence there's no point in re-evaluating it.
439 -- @OtherCon []@ is used even for non-data-type values
440 -- to indicated evaluated-ness. Notably:
442 -- > data C = C !(Int -> Int)
443 -- > case x of { C f -> ... }
445 -- Here, @f@ gets an @OtherCon []@ unfolding.
447 | DFunUnfolding -- The Unfolding of a DFunId
448 -- See Note [DFun unfoldings]
449 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
450 -- (op2 a1..am d1..dn)
452 Arity -- Arity = m+n, the *total* number of args
453 -- (unusually, both type and value) to the dfun
455 DataCon -- The dictionary data constructor (possibly a newtype datacon)
457 [DFunArg CoreExpr] -- Specification of superclasses and methods, in positional order
459 | CoreUnfolding { -- An unfolding for an Id with no pragma,
460 -- or perhaps a NOINLINE pragma
461 -- (For NOINLINE, the phase, if any, is in the
462 -- InlinePragInfo for this Id.)
463 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
464 uf_src :: UnfoldingSource, -- Where the unfolding came from
465 uf_is_top :: Bool, -- True <=> top level binding
466 uf_arity :: Arity, -- Number of value arguments expected
467 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
468 -- a `seq` on this variable
469 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
470 -- Cached version of exprIsConLike
471 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand
472 -- inside an inlining
473 -- Cached version of exprIsCheap
474 uf_expandable :: Bool, -- True <=> can expand in RULE matching
475 -- Cached version of exprIsExpandable
476 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
478 -- ^ An unfolding with redundant cached information. Parameters:
480 -- uf_tmpl: Template used to perform unfolding;
481 -- NB: Occurrence info is guaranteed correct:
482 -- see Note [OccInfo in unfoldings and rules]
484 -- uf_is_top: Is this a top level binding?
486 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
489 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
490 -- Basically this is a cached version of 'exprIsCheap'
492 -- uf_guidance: Tells us about the /size/ of the unfolding template
494 ------------------------------------------------
495 data DFunArg e -- Given (df a b d1 d2 d3)
496 = DFunPolyArg e -- Arg is (e a b d1 d2 d3)
497 | DFunConstArg e -- Arg is e, which is constant
498 | DFunLamArg Int -- Arg is one of [a,b,d1,d2,d3], zero indexed
501 -- 'e' is often CoreExpr, which are usually variables, but can
502 -- be trivial expressions instead (e.g. a type application).
504 dfunArgExprs :: [DFunArg e] -> [e]
506 dfunArgExprs (DFunPolyArg e : as) = e : dfunArgExprs as
507 dfunArgExprs (DFunConstArg e : as) = e : dfunArgExprs as
508 dfunArgExprs (DFunLamArg {} : as) = dfunArgExprs as
511 ------------------------------------------------
513 = InlineRhs -- The current rhs of the function
514 -- Replace uf_tmpl each time around
516 | InlineStable -- From an INLINE or INLINABLE pragma
517 -- INLINE if guidance is UnfWhen
518 -- INLINABLE if guidance is UnfIfGoodArgs/UnfoldNever
519 -- (well, technically an INLINABLE might be made
520 -- UnfWhen if it was small enough, and then
521 -- it will behave like INLINE outside the current
522 -- module, but that is the way automatic unfoldings
523 -- work so it is consistent with the intended
524 -- meaning of INLINABLE).
526 -- uf_tmpl may change, but only as a result of
527 -- gentle simplification, it doesn't get updated
528 -- to the current RHS during compilation as with
531 -- See Note [InlineRules]
533 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
534 -- Only a few primop-like things have this property
535 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
536 -- Inline absolutely always, however boring the context.
538 | InlineWrapper Id -- This unfolding is a the wrapper in a
539 -- worker/wrapper split from the strictness analyser
540 -- The Id is the worker-id
541 -- Used to abbreviate the uf_tmpl in interface files
542 -- which don't need to contain the RHS;
543 -- it can be derived from the strictness info
547 -- | 'UnfoldingGuidance' says when unfolding should take place
548 data UnfoldingGuidance
549 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
550 -- Used (a) for small *and* cheap unfoldings
551 -- (b) for INLINE functions
552 -- See Note [INLINE for small functions] in CoreUnfold
553 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
554 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
555 -- So True,True means "always"
558 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
559 -- result of a simple analysis of the RHS
561 ug_args :: [Int], -- Discount if the argument is evaluated.
562 -- (i.e., a simplification will definitely
563 -- be possible). One elt of the list per *value* arg.
565 ug_size :: Int, -- The "size" of the unfolding.
567 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
568 } -- a context (case (thing args) of ...),
569 -- (where there are the right number of arguments.)
571 | UnfNever -- The RHS is big, so don't inline it
575 Note [DFun unfoldings]
576 ~~~~~~~~~~~~~~~~~~~~~~
577 The Arity in a DFunUnfolding is total number of args (type and value)
578 that the DFun needs to produce a dictionary. That's not necessarily
579 related to the ordinary arity of the dfun Id, esp if the class has
580 one method, so the dictionary is represented by a newtype. Example
582 class C a where { op :: a -> Int }
583 instance C a -> C [a] where op xs = op (head xs)
585 The instance translates to
587 $dfCList :: forall a. C a => C [a] -- Arity 2!
588 $dfCList = /\a.\d. $copList {a} d |> co
590 $copList :: forall a. C a => [a] -> Int -- Arity 2!
591 $copList = /\a.\d.\xs. op {a} d (head xs)
593 Now we might encounter (op (dfCList {ty} d) a1 a2)
594 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
595 has all its arguments, even though its (value) arity is 2. That's
596 why we record the number of expected arguments in the DFunUnfolding.
598 Note that although it's an Arity, it's most convenient for it to give
599 the *total* number of arguments, both type and value. See the use
600 site in exprIsConApp_maybe.
603 -- Constants for the UnfWhen constructor
604 needSaturated, unSaturatedOk :: Bool
605 needSaturated = False
608 boringCxtNotOk, boringCxtOk :: Bool
610 boringCxtNotOk = False
612 ------------------------------------------------
613 noUnfolding :: Unfolding
614 -- ^ There is no known 'Unfolding'
615 evaldUnfolding :: Unfolding
616 -- ^ This unfolding marks the associated thing as being evaluated
618 noUnfolding = NoUnfolding
619 evaldUnfolding = OtherCon []
621 mkOtherCon :: [AltCon] -> Unfolding
622 mkOtherCon = OtherCon
624 seqUnfolding :: Unfolding -> ()
625 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
626 uf_is_value = b1, uf_is_cheap = b2,
627 uf_expandable = b3, uf_is_conlike = b4,
628 uf_arity = a, uf_guidance = g})
629 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
633 seqGuidance :: UnfoldingGuidance -> ()
634 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
639 isStableSource :: UnfoldingSource -> Bool
640 -- Keep the unfolding template
641 isStableSource InlineCompulsory = True
642 isStableSource InlineStable = True
643 isStableSource (InlineWrapper {}) = True
644 isStableSource InlineRhs = False
646 -- | Retrieves the template of an unfolding: panics if none is known
647 unfoldingTemplate :: Unfolding -> CoreExpr
648 unfoldingTemplate = uf_tmpl
650 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
651 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
653 -- | Retrieves the template of an unfolding if possible
654 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
655 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
656 maybeUnfoldingTemplate _ = Nothing
658 -- | The constructors that the unfolding could never be:
659 -- returns @[]@ if no information is available
660 otherCons :: Unfolding -> [AltCon]
661 otherCons (OtherCon cons) = cons
664 -- | Determines if it is certainly the case that the unfolding will
665 -- yield a value (something in HNF): returns @False@ if unsure
666 isValueUnfolding :: Unfolding -> Bool
667 -- Returns False for OtherCon
668 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
669 isValueUnfolding _ = False
671 -- | Determines if it possibly the case that the unfolding will
672 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
674 isEvaldUnfolding :: Unfolding -> Bool
675 -- Returns True for OtherCon
676 isEvaldUnfolding (OtherCon _) = True
677 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
678 isEvaldUnfolding _ = False
680 -- | @True@ if the unfolding is a constructor application, the application
681 -- of a CONLIKE function or 'OtherCon'
682 isConLikeUnfolding :: Unfolding -> Bool
683 isConLikeUnfolding (OtherCon _) = True
684 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
685 isConLikeUnfolding _ = False
687 -- | Is the thing we will unfold into certainly cheap?
688 isCheapUnfolding :: Unfolding -> Bool
689 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
690 isCheapUnfolding _ = False
692 isExpandableUnfolding :: Unfolding -> Bool
693 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
694 isExpandableUnfolding _ = False
696 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
697 -- Expand an expandable unfolding; this is used in rule matching
698 -- See Note [Expanding variables] in Rules.lhs
699 -- The key point here is that CONLIKE things can be expanded
700 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
701 expandUnfolding_maybe _ = Nothing
703 isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
704 isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
705 | isStableSource src = Just src
706 isStableCoreUnfolding_maybe _ = Nothing
708 isCompulsoryUnfolding :: Unfolding -> Bool
709 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
710 isCompulsoryUnfolding _ = False
712 isStableUnfolding :: Unfolding -> Bool
713 -- True of unfoldings that should not be overwritten
714 -- by a CoreUnfolding for the RHS of a let-binding
715 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
716 isStableUnfolding (DFunUnfolding {}) = True
717 isStableUnfolding _ = False
719 unfoldingArity :: Unfolding -> Arity
720 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
721 unfoldingArity _ = panic "unfoldingArity"
723 isClosedUnfolding :: Unfolding -> Bool -- No free variables
724 isClosedUnfolding (CoreUnfolding {}) = False
725 isClosedUnfolding (DFunUnfolding {}) = False
726 isClosedUnfolding _ = True
728 -- | Only returns False if there is no unfolding information available at all
729 hasSomeUnfolding :: Unfolding -> Bool
730 hasSomeUnfolding NoUnfolding = False
731 hasSomeUnfolding _ = True
733 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
734 neverUnfoldGuidance UnfNever = True
735 neverUnfoldGuidance _ = False
737 canUnfold :: Unfolding -> Bool
738 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
747 you intend that calls (f e) are replaced by <rhs>[e/x] So we
748 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
749 with it. Meanwhile, we can optimise <rhs> to our heart's content,
750 leaving the original unfolding intact in Unfolding of 'f'. For example
751 all xs = foldr (&&) True xs
752 any p = all . map p {-# INLINE any #-}
753 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
754 which deforests well at the call site.
756 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
758 Moreover, it's only used when 'f' is applied to the
759 specified number of arguments; that is, the number of argument on
760 the LHS of the '=' sign in the original source definition.
761 For example, (.) is now defined in the libraries like this
763 (.) f g = \x -> f (g x)
764 so that it'll inline when applied to two arguments. If 'x' appeared
767 it'd only inline when applied to three arguments. This slightly-experimental
768 change was requested by Roman, but it seems to make sense.
770 See also Note [Inlining an InlineRule] in CoreUnfold.
773 Note [OccInfo in unfoldings and rules]
774 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
775 In unfoldings and rules, we guarantee that the template is occ-analysed,
776 so that the occurence info on the binders is correct. This is important,
777 because the Simplifier does not re-analyse the template when using it. If
778 the occurrence info is wrong
779 - We may get more simpifier iterations than necessary, because
780 once-occ info isn't there
781 - More seriously, we may get an infinite loop if there's a Rec
782 without a loop breaker marked
785 %************************************************************************
787 \subsection{The main data type}
789 %************************************************************************
792 -- The Ord is needed for the FiniteMap used in the lookForConstructor
793 -- in SimplEnv. If you declared that lookForConstructor *ignores*
794 -- constructor-applications with LitArg args, then you could get
797 instance Outputable AltCon where
798 ppr (DataAlt dc) = ppr dc
799 ppr (LitAlt lit) = ppr lit
800 ppr DEFAULT = ptext (sLit "__DEFAULT")
802 instance Show AltCon where
803 showsPrec p con = showsPrecSDoc p (ppr con)
805 cmpAlt :: Alt b -> Alt b -> Ordering
806 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
808 ltAlt :: Alt b -> Alt b -> Bool
809 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
811 cmpAltCon :: AltCon -> AltCon -> Ordering
812 -- ^ Compares 'AltCon's within a single list of alternatives
813 cmpAltCon DEFAULT DEFAULT = EQ
814 cmpAltCon DEFAULT _ = LT
816 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
817 cmpAltCon (DataAlt _) DEFAULT = GT
818 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
819 cmpAltCon (LitAlt _) DEFAULT = GT
821 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
822 ppr con1 <+> ppr con2 )
826 %************************************************************************
828 \subsection{Useful synonyms}
830 %************************************************************************
833 -- | The common case for the type of binders and variables when
834 -- we are manipulating the Core language within GHC
836 -- | Expressions where binders are 'CoreBndr's
837 type CoreExpr = Expr CoreBndr
838 -- | Argument expressions where binders are 'CoreBndr's
839 type CoreArg = Arg CoreBndr
840 -- | Binding groups where binders are 'CoreBndr's
841 type CoreBind = Bind CoreBndr
842 -- | Case alternatives where binders are 'CoreBndr's
843 type CoreAlt = Alt CoreBndr
846 %************************************************************************
850 %************************************************************************
853 -- | Binders are /tagged/ with a t
854 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
856 type TaggedBind t = Bind (TaggedBndr t)
857 type TaggedExpr t = Expr (TaggedBndr t)
858 type TaggedArg t = Arg (TaggedBndr t)
859 type TaggedAlt t = Alt (TaggedBndr t)
861 instance Outputable b => Outputable (TaggedBndr b) where
862 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
864 instance Outputable b => OutputableBndr (TaggedBndr b) where
865 pprBndr _ b = ppr b -- Simple
869 %************************************************************************
871 \subsection{Core-constructing functions with checking}
873 %************************************************************************
876 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
877 -- use 'CoreUtils.mkCoreApps' if possible
878 mkApps :: Expr b -> [Arg b] -> Expr b
879 -- | Apply a list of type argument expressions to a function expression in a nested fashion
880 mkTyApps :: Expr b -> [Type] -> Expr b
881 -- | Apply a list of type or value variables to a function expression in a nested fashion
882 mkVarApps :: Expr b -> [Var] -> Expr b
883 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
884 -- use 'MkCore.mkCoreConApps' if possible
885 mkConApp :: DataCon -> [Arg b] -> Expr b
887 mkApps f args = foldl App f args
888 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
889 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
890 mkConApp con args = mkApps (Var (dataConWorkId con)) args
893 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
894 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
895 mkIntLit :: Integer -> Expr b
896 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
897 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
898 mkIntLitInt :: Int -> Expr b
900 mkIntLit n = Lit (mkMachInt n)
901 mkIntLitInt n = Lit (mkMachInt (toInteger n))
903 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
904 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
905 mkWordLit :: Integer -> Expr b
906 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
907 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
908 mkWordLitWord :: Word -> Expr b
910 mkWordLit w = Lit (mkMachWord w)
911 mkWordLitWord w = Lit (mkMachWord (toInteger w))
913 -- | Create a machine character literal expression of type @Char#@.
914 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
915 mkCharLit :: Char -> Expr b
916 -- | Create a machine string literal expression of type @Addr#@.
917 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
918 mkStringLit :: String -> Expr b
920 mkCharLit c = Lit (mkMachChar c)
921 mkStringLit s = Lit (mkMachString s)
923 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
924 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
925 mkFloatLit :: Rational -> Expr b
926 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
927 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
928 mkFloatLitFloat :: Float -> Expr b
930 mkFloatLit f = Lit (mkMachFloat f)
931 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
933 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
934 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
935 mkDoubleLit :: Rational -> Expr b
936 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
937 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
938 mkDoubleLitDouble :: Double -> Expr b
940 mkDoubleLit d = Lit (mkMachDouble d)
941 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
943 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
944 -- use 'CoreUtils.mkCoreLets' if possible
945 mkLets :: [Bind b] -> Expr b -> Expr b
946 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
947 -- use 'CoreUtils.mkCoreLams' if possible
948 mkLams :: [b] -> Expr b -> Expr b
950 mkLams binders body = foldr Lam body binders
951 mkLets binds body = foldr Let body binds
954 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
955 -- this can only be used to bind something in a non-recursive @let@ expression
956 mkTyBind :: TyVar -> Type -> CoreBind
957 mkTyBind tv ty = NonRec tv (Type ty)
959 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
960 varToCoreExpr :: CoreBndr -> Expr b
961 varToCoreExpr v | isId v = Var v
962 | otherwise = Type (mkTyVarTy v)
964 varsToCoreExprs :: [CoreBndr] -> [Expr b]
965 varsToCoreExprs vs = map varToCoreExpr vs
969 %************************************************************************
971 \subsection{Simple access functions}
973 %************************************************************************
976 -- | Extract every variable by this group
977 bindersOf :: Bind b -> [b]
978 bindersOf (NonRec binder _) = [binder]
979 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
981 -- | 'bindersOf' applied to a list of binding groups
982 bindersOfBinds :: [Bind b] -> [b]
983 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
985 rhssOfBind :: Bind b -> [Expr b]
986 rhssOfBind (NonRec _ rhs) = [rhs]
987 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
989 rhssOfAlts :: [Alt b] -> [Expr b]
990 rhssOfAlts alts = [e | (_,_,e) <- alts]
992 -- | Collapse all the bindings in the supplied groups into a single
993 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
994 flattenBinds :: [Bind b] -> [(b, Expr b)]
995 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
996 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
1001 -- | We often want to strip off leading lambdas before getting down to
1002 -- business. This function is your friend.
1003 collectBinders :: Expr b -> ([b], Expr b)
1004 -- | Collect as many type bindings as possible from the front of a nested lambda
1005 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
1006 -- | Collect as many value bindings as possible from the front of a nested lambda
1007 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
1008 -- | Collect type binders from the front of the lambda first,
1009 -- then follow up by collecting as many value bindings as possible
1010 -- from the resulting stripped expression
1011 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
1016 go bs (Lam b e) = go (b:bs) e
1017 go bs e = (reverse bs, e)
1019 collectTyAndValBinders expr
1022 (tvs, body1) = collectTyBinders expr
1023 (ids, body) = collectValBinders body1
1025 collectTyBinders expr
1028 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
1029 go tvs e = (reverse tvs, e)
1031 collectValBinders expr
1034 go ids (Lam b e) | isId b = go (b:ids) e
1035 go ids body = (reverse ids, body)
1039 -- | Takes a nested application expression and returns the the function
1040 -- being applied and the arguments to which it is applied
1041 collectArgs :: Expr b -> (Expr b, [Arg b])
1045 go (App f a) as = go f (a:as)
1050 -- | Gets the cost centre enclosing an expression, if any.
1051 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1052 coreExprCc :: Expr b -> CostCentre
1053 coreExprCc (Note (SCC cc) _) = cc
1054 coreExprCc (Note _ e) = coreExprCc e
1055 coreExprCc (Lam _ e) = coreExprCc e
1056 coreExprCc _ = noCostCentre
1059 %************************************************************************
1061 \subsection{Predicates}
1063 %************************************************************************
1065 At one time we optionally carried type arguments through to runtime.
1066 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1067 i.e. if type applications are actual lambdas because types are kept around
1068 at runtime. Similarly isRuntimeArg.
1071 -- | Will this variable exist at runtime?
1072 isRuntimeVar :: Var -> Bool
1075 -- | Will this argument expression exist at runtime?
1076 isRuntimeArg :: CoreExpr -> Bool
1077 isRuntimeArg = isValArg
1079 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1080 isValArg :: Expr b -> Bool
1081 isValArg (Type _) = False
1084 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1085 isTypeArg :: Expr b -> Bool
1086 isTypeArg (Type _) = True
1089 -- | The number of binders that bind values rather than types
1090 valBndrCount :: [CoreBndr] -> Int
1091 valBndrCount = count isId
1093 -- | The number of argument expressions that are values rather than types at their top level
1094 valArgCount :: [Arg b] -> Int
1095 valArgCount = count isValArg
1097 notSccNote :: Note -> Bool
1098 notSccNote (SCC {}) = False
1103 %************************************************************************
1105 \subsection{Seq stuff}
1107 %************************************************************************
1110 seqExpr :: CoreExpr -> ()
1111 seqExpr (Var v) = v `seq` ()
1112 seqExpr (Lit lit) = lit `seq` ()
1113 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1114 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1115 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1116 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1117 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1118 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1119 seqExpr (Type t) = seqType t
1121 seqExprs :: [CoreExpr] -> ()
1123 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1125 seqNote :: Note -> ()
1126 seqNote (CoreNote s) = s `seq` ()
1129 seqBndr :: CoreBndr -> ()
1130 seqBndr b = b `seq` ()
1132 seqBndrs :: [CoreBndr] -> ()
1134 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1136 seqBind :: Bind CoreBndr -> ()
1137 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1138 seqBind (Rec prs) = seqPairs prs
1140 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1142 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1144 seqAlts :: [CoreAlt] -> ()
1146 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1148 seqRules :: [CoreRule] -> ()
1150 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1151 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1152 seqRules (BuiltinRule {} : rules) = seqRules rules
1155 %************************************************************************
1157 \subsection{Annotated core}
1159 %************************************************************************
1162 -- | Annotated core: allows annotation at every node in the tree
1163 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1165 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1166 data AnnExpr' bndr annot
1169 | AnnLam bndr (AnnExpr bndr annot)
1170 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1171 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1172 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1173 | AnnCast (AnnExpr bndr annot) Coercion
1174 | AnnNote Note (AnnExpr bndr annot)
1177 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1178 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1180 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1181 data AnnBind bndr annot
1182 = AnnNonRec bndr (AnnExpr bndr annot)
1183 | AnnRec [(bndr, AnnExpr bndr annot)]
1187 -- | Takes a nested application expression and returns the the function
1188 -- being applied and the arguments to which it is applied
1189 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1193 go (_, AnnApp f a) as = go f (a:as)
1198 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1199 deAnnotate (_, e) = deAnnotate' e
1201 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1202 deAnnotate' (AnnType t) = Type t
1203 deAnnotate' (AnnVar v) = Var v
1204 deAnnotate' (AnnLit lit) = Lit lit
1205 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1206 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1207 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1208 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1210 deAnnotate' (AnnLet bind body)
1211 = Let (deAnnBind bind) (deAnnotate body)
1213 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1214 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1216 deAnnotate' (AnnCase scrut v t alts)
1217 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1219 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1220 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1224 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1225 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1229 collect bs (_, AnnLam b body) = collect (b:bs) body
1230 collect bs body = (reverse bs, body)