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
78 #include "HsVersions.h"
95 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`
96 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
99 %************************************************************************
101 \subsection{The main data types}
103 %************************************************************************
105 These data types are the heart of the compiler
108 -- | This is the data type that represents GHCs core intermediate language. Currently
109 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
110 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
112 -- We get from Haskell source to this Core language in a number of stages:
114 -- 1. The source code is parsed into an abstract syntax tree, which is represented
115 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
117 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
118 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
119 -- For example, this program:
122 -- f x = let f x = x + 1
126 -- Would be renamed by having 'Unique's attached so it looked something like this:
129 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
133 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
134 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
136 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
137 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
138 -- optimization, analysis and code generation on.
140 -- The type parameter @b@ is for the type of binders in the expression tree.
142 = Var Id -- ^ Variables
144 | Lit Literal -- ^ Primitive literals
146 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
148 -- See "CoreSyn#let_app_invariant" for another invariant
150 | Lam b (Expr b) -- ^ Lambda abstraction
152 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
153 -- this corresponds to allocating a thunk for the things
154 -- bound and then executing the sub-expression.
156 -- #top_level_invariant#
157 -- #letrec_invariant#
159 -- The right hand sides of all top-level and recursive @let@s
160 -- /must/ be of lifted type (see "Type#type_classification" for
161 -- the meaning of /lifted/ vs. /unlifted/).
163 -- #let_app_invariant#
164 -- The right hand side of of a non-recursive 'Let'
165 -- _and_ the argument of an 'App',
166 -- /may/ be of unlifted type, but only if the expression
167 -- is ok-for-speculation. This means that the let can be floated
168 -- around without difficulty. For example, this is OK:
170 -- > y::Int# = x +# 1#
172 -- But this is not, as it may affect termination if the
173 -- expression is floated out:
175 -- > y::Int# = fac 4#
177 -- In this situation you should use @case@ rather than a @let@. The function
178 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
179 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
180 -- which will generate a @case@ if necessary
183 -- We allow a /non-recursive/ let to bind a type variable, thus:
185 -- > Let (NonRec tv (Type ty)) body
187 -- This can be very convenient for postponing type substitutions until
188 -- the next run of the simplifier.
190 -- At the moment, the rest of the compiler only deals with type-let
191 -- in a Let expression, rather than at top level. We may want to revist
194 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
195 -- the scrutinee (expression examined) to weak head normal form
196 -- and then examining at most one level of resulting constructor (i.e. you
197 -- cannot do nested pattern matching directly with this).
199 -- The binder gets bound to the value of the scrutinee,
200 -- and the 'Type' must be that of all the case alternatives
203 -- This is one of the more complicated elements of the Core language,
204 -- and comes with a number of restrictions:
206 -- The 'DEFAULT' case alternative must be first in the list,
207 -- if it occurs at all.
209 -- The remaining cases are in order of increasing
210 -- tag (for 'DataAlts') or
211 -- lit (for 'LitAlts').
212 -- This makes finding the relevant constructor easy,
213 -- and makes comparison easier too.
215 -- The list of alternatives must be exhaustive. An /exhaustive/ case
216 -- does not necessarily mention all constructors:
219 -- data Foo = Red | Green | Blue
222 -- other -> f (case x of
227 -- The inner case does not need a @Red@ alternative, because @x@
228 -- can't be @Red@ at that program point.
230 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type.
231 -- This is used to implement @newtype@s (a @newtype@ constructor or
232 -- destructor just becomes a 'Cast' in Core) and GADTs.
234 | Note Note (Expr b) -- ^ Notes. These allow general information to be
235 -- added to expressions in the syntax tree
237 | Type Type -- ^ A type: this should only show up at the top
239 deriving (Data, Typeable)
241 -- | Type synonym for expressions that occur in function argument positions.
242 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
245 -- | A case split alternative. Consists of the constructor leading to the alternative,
246 -- the variables bound from the constructor, and the expression to be executed given that binding.
247 -- The default alternative is @(DEFAULT, [], rhs)@
248 type Alt b = (AltCon, [b], Expr b)
250 -- | A case alternative constructor (i.e. pattern match)
251 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
252 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
253 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
254 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
255 deriving (Eq, Ord, Data, Typeable)
257 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
258 data Bind b = NonRec b (Expr b)
259 | Rec [(b, (Expr b))]
260 deriving (Data, Typeable)
263 -------------------------- CoreSyn INVARIANTS ---------------------------
265 Note [CoreSyn top-level invariant]
266 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
267 See #toplevel_invariant#
269 Note [CoreSyn letrec invariant]
270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
271 See #letrec_invariant#
273 Note [CoreSyn let/app invariant]
274 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
275 See #let_app_invariant#
277 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
279 Note [CoreSyn case invariants]
280 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281 See #case_invariants#
283 Note [CoreSyn let goal]
284 ~~~~~~~~~~~~~~~~~~~~~~~
285 * The simplifier tries to ensure that if the RHS of a let is a constructor
286 application, its arguments are trivial, so that the constructor can be
296 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
298 = SCC CostCentre -- ^ A cost centre annotation for profiling
299 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
300 deriving (Data, Typeable)
304 %************************************************************************
306 \subsection{Transformation rules}
308 %************************************************************************
310 The CoreRule type and its friends are dealt with mainly in CoreRules,
311 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
314 -- | A 'CoreRule' is:
316 -- * \"Local\" if the function it is a rule for is defined in the
317 -- same module as the rule itself.
319 -- * \"Orphan\" if nothing on the LHS is defined in the same module
320 -- as the rule itself
323 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
324 ru_act :: Activation, -- ^ When the rule is active
326 -- Rough-matching stuff
327 -- see comments with InstEnv.Instance( is_cls, is_rough )
328 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
329 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
331 -- Proper-matching stuff
332 -- see comments with InstEnv.Instance( is_tvs, is_tys )
333 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
334 ru_args :: [CoreExpr], -- ^ Left hand side arguments
336 -- And the right-hand side
337 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
338 -- Occurrence info is guaranteed correct
339 -- See Note [OccInfo in unfoldings and rules]
342 ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
343 -- @False@ <=> generated at the users behest
344 -- Main effect: reporting of orphan-hood
346 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
347 -- defined in the same module as the rule
348 -- and is not an implicit 'Id' (like a record selector,
349 -- class operation, or data constructor)
351 -- NB: ru_local is *not* used to decide orphan-hood
352 -- c.g. MkIface.coreRuleToIfaceRule
355 -- | Built-in rules are used for constant folding
356 -- and suchlike. They have no free variables.
358 ru_name :: RuleName, -- ^ As above
359 ru_fn :: Name, -- ^ As above
360 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
361 -- if it fires, including type arguments
362 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
363 -- ^ This function does the rewrite. It given too many
364 -- arguments, it simply discards them; the returned 'CoreExpr'
365 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
367 -- See Note [Extra args in rule matching] in Rules.lhs
369 type IdUnfoldingFun = Id -> Unfolding
370 -- A function that embodies how to unfold an Id if you need
371 -- to do that in the Rule. The reason we need to pass this info in
372 -- is that whether an Id is unfoldable depends on the simplifier phase
374 isBuiltinRule :: CoreRule -> Bool
375 isBuiltinRule (BuiltinRule {}) = True
376 isBuiltinRule _ = False
378 -- | The number of arguments the 'ru_fn' must be applied
379 -- to before the rule can match on it
380 ruleArity :: CoreRule -> Int
381 ruleArity (BuiltinRule {ru_nargs = n}) = n
382 ruleArity (Rule {ru_args = args}) = length args
384 ruleName :: CoreRule -> RuleName
387 ruleActivation :: CoreRule -> Activation
388 ruleActivation (BuiltinRule { }) = AlwaysActive
389 ruleActivation (Rule { ru_act = act }) = act
391 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
392 ruleIdName :: CoreRule -> Name
395 isLocalRule :: CoreRule -> Bool
396 isLocalRule = ru_local
398 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
399 setRuleIdName :: Name -> CoreRule -> CoreRule
400 setRuleIdName nm ru = ru { ru_fn = nm }
404 %************************************************************************
408 %************************************************************************
410 The @Unfolding@ type is declared here to avoid numerous loops
413 -- | Records the /unfolding/ of an identifier, which is approximately the form the
414 -- identifier would have if we substituted its definition in for the identifier.
415 -- This type should be treated as abstract everywhere except in "CoreUnfold"
417 = NoUnfolding -- ^ We have no information about the unfolding
419 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
420 -- @OtherCon xs@ also indicates that something has been evaluated
421 -- and hence there's no point in re-evaluating it.
422 -- @OtherCon []@ is used even for non-data-type values
423 -- to indicated evaluated-ness. Notably:
425 -- > data C = C !(Int -> Int)
426 -- > case x of { C f -> ... }
428 -- Here, @f@ gets an @OtherCon []@ unfolding.
430 | DFunUnfolding -- The Unfolding of a DFunId
431 -- See Note [DFun unfoldings]
432 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
433 -- (op2 a1..am d1..dn)
435 Arity -- Arity = m+n, the *total* number of args
436 -- (unusually, both type and value) to the dfun
438 DataCon -- The dictionary data constructor (possibly a newtype datacon)
440 [DFunArg CoreExpr] -- Specification of superclasses and methods, in positional order
442 | CoreUnfolding { -- An unfolding for an Id with no pragma,
443 -- or perhaps a NOINLINE pragma
444 -- (For NOINLINE, the phase, if any, is in the
445 -- InlinePragInfo for this Id.)
446 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
447 uf_src :: UnfoldingSource, -- Where the unfolding came from
448 uf_is_top :: Bool, -- True <=> top level binding
449 uf_arity :: Arity, -- Number of value arguments expected
450 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
451 -- a `seq` on this variable
452 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
453 -- Cached version of exprIsConLike
454 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand
455 -- inside an inlining
456 -- Cached version of exprIsCheap
457 uf_expandable :: Bool, -- True <=> can expand in RULE matching
458 -- Cached version of exprIsExpandable
459 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
461 -- ^ An unfolding with redundant cached information. Parameters:
463 -- uf_tmpl: Template used to perform unfolding;
464 -- NB: Occurrence info is guaranteed correct:
465 -- see Note [OccInfo in unfoldings and rules]
467 -- uf_is_top: Is this a top level binding?
469 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
472 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
473 -- Basically this is a cached version of 'exprIsCheap'
475 -- uf_guidance: Tells us about the /size/ of the unfolding template
477 ------------------------------------------------
478 data DFunArg e -- Given (df a b d1 d2 d3)
479 = DFunPolyArg e -- Arg is (e a b d1 d2 d3)
480 | DFunConstArg e -- Arg is e, which is constant
481 | DFunLamArg Int -- Arg is one of [a,b,d1,d2,d3], zero indexed
484 -- 'e' is often CoreExpr, which are usually variables, but can
485 -- be trivial expressions instead (e.g. a type application).
487 dfunArgExprs :: [DFunArg e] -> [e]
489 dfunArgExprs (DFunPolyArg e : as) = e : dfunArgExprs as
490 dfunArgExprs (DFunConstArg e : as) = e : dfunArgExprs as
491 dfunArgExprs (DFunLamArg {} : as) = dfunArgExprs as
494 ------------------------------------------------
496 = InlineRhs -- The current rhs of the function
497 -- Replace uf_tmpl each time around
499 | InlineStable -- From an INLINE or INLINABLE pragma
500 -- INLINE if guidance is UnfWhen
501 -- INLINABLE if guidance is UnfIfGoodArgs/UnfoldNever
502 -- (well, technically an INLINABLE might be made
503 -- UnfWhen if it was small enough, and then
504 -- it will behave like INLINE outside the current
505 -- module, but that is the way automatic unfoldings
506 -- work so it is consistent with the intended
507 -- meaning of INLINABLE).
509 -- uf_tmpl may change, but only as a result of
510 -- gentle simplification, it doesn't get updated
511 -- to the current RHS during compilation as with
514 -- See Note [InlineRules]
516 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
517 -- Only a few primop-like things have this property
518 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
519 -- Inline absolutely always, however boring the context.
521 | InlineWrapper Id -- This unfolding is a the wrapper in a
522 -- worker/wrapper split from the strictness analyser
523 -- The Id is the worker-id
524 -- Used to abbreviate the uf_tmpl in interface files
525 -- which don't need to contain the RHS;
526 -- it can be derived from the strictness info
530 -- | 'UnfoldingGuidance' says when unfolding should take place
531 data UnfoldingGuidance
532 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
533 -- Used (a) for small *and* cheap unfoldings
534 -- (b) for INLINE functions
535 -- See Note [INLINE for small functions] in CoreUnfold
536 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
537 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
538 -- So True,True means "always"
541 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
542 -- result of a simple analysis of the RHS
544 ug_args :: [Int], -- Discount if the argument is evaluated.
545 -- (i.e., a simplification will definitely
546 -- be possible). One elt of the list per *value* arg.
548 ug_size :: Int, -- The "size" of the unfolding.
550 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
551 } -- a context (case (thing args) of ...),
552 -- (where there are the right number of arguments.)
554 | UnfNever -- The RHS is big, so don't inline it
558 Note [DFun unfoldings]
559 ~~~~~~~~~~~~~~~~~~~~~~
560 The Arity in a DFunUnfolding is total number of args (type and value)
561 that the DFun needs to produce a dictionary. That's not necessarily
562 related to the ordinary arity of the dfun Id, esp if the class has
563 one method, so the dictionary is represented by a newtype. Example
565 class C a where { op :: a -> Int }
566 instance C a -> C [a] where op xs = op (head xs)
568 The instance translates to
570 $dfCList :: forall a. C a => C [a] -- Arity 2!
571 $dfCList = /\a.\d. $copList {a} d |> co
573 $copList :: forall a. C a => [a] -> Int -- Arity 2!
574 $copList = /\a.\d.\xs. op {a} d (head xs)
576 Now we might encounter (op (dfCList {ty} d) a1 a2)
577 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
578 has all its arguments, even though its (value) arity is 2. That's
579 why we record the number of expected arguments in the DFunUnfolding.
581 Note that although it's an Arity, it's most convenient for it to give
582 the *total* number of arguments, both type and value. See the use
583 site in exprIsConApp_maybe.
586 -- Constants for the UnfWhen constructor
587 needSaturated, unSaturatedOk :: Bool
588 needSaturated = False
591 boringCxtNotOk, boringCxtOk :: Bool
593 boringCxtNotOk = False
595 ------------------------------------------------
596 noUnfolding :: Unfolding
597 -- ^ There is no known 'Unfolding'
598 evaldUnfolding :: Unfolding
599 -- ^ This unfolding marks the associated thing as being evaluated
601 noUnfolding = NoUnfolding
602 evaldUnfolding = OtherCon []
604 mkOtherCon :: [AltCon] -> Unfolding
605 mkOtherCon = OtherCon
607 seqUnfolding :: Unfolding -> ()
608 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
609 uf_is_value = b1, uf_is_cheap = b2,
610 uf_expandable = b3, uf_is_conlike = b4,
611 uf_arity = a, uf_guidance = g})
612 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
616 seqGuidance :: UnfoldingGuidance -> ()
617 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
622 isStableSource :: UnfoldingSource -> Bool
623 -- Keep the unfolding template
624 isStableSource InlineCompulsory = True
625 isStableSource InlineStable = True
626 isStableSource (InlineWrapper {}) = True
627 isStableSource InlineRhs = False
629 -- | Retrieves the template of an unfolding: panics if none is known
630 unfoldingTemplate :: Unfolding -> CoreExpr
631 unfoldingTemplate = uf_tmpl
633 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
634 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
636 -- | Retrieves the template of an unfolding if possible
637 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
638 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
639 maybeUnfoldingTemplate _ = Nothing
641 -- | The constructors that the unfolding could never be:
642 -- returns @[]@ if no information is available
643 otherCons :: Unfolding -> [AltCon]
644 otherCons (OtherCon cons) = cons
647 -- | Determines if it is certainly the case that the unfolding will
648 -- yield a value (something in HNF): returns @False@ if unsure
649 isValueUnfolding :: Unfolding -> Bool
650 -- Returns False for OtherCon
651 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
652 isValueUnfolding _ = False
654 -- | Determines if it possibly the case that the unfolding will
655 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
657 isEvaldUnfolding :: Unfolding -> Bool
658 -- Returns True for OtherCon
659 isEvaldUnfolding (OtherCon _) = True
660 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
661 isEvaldUnfolding _ = False
663 -- | @True@ if the unfolding is a constructor application, the application
664 -- of a CONLIKE function or 'OtherCon'
665 isConLikeUnfolding :: Unfolding -> Bool
666 isConLikeUnfolding (OtherCon _) = True
667 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
668 isConLikeUnfolding _ = False
670 -- | Is the thing we will unfold into certainly cheap?
671 isCheapUnfolding :: Unfolding -> Bool
672 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
673 isCheapUnfolding _ = False
675 isExpandableUnfolding :: Unfolding -> Bool
676 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
677 isExpandableUnfolding _ = False
679 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
680 -- Expand an expandable unfolding; this is used in rule matching
681 -- See Note [Expanding variables] in Rules.lhs
682 -- The key point here is that CONLIKE things can be expanded
683 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
684 expandUnfolding_maybe _ = Nothing
686 isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
687 isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
688 | isStableSource src = Just src
689 isStableCoreUnfolding_maybe _ = Nothing
691 isCompulsoryUnfolding :: Unfolding -> Bool
692 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
693 isCompulsoryUnfolding _ = False
695 isStableUnfolding :: Unfolding -> Bool
696 -- True of unfoldings that should not be overwritten
697 -- by a CoreUnfolding for the RHS of a let-binding
698 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
699 isStableUnfolding (DFunUnfolding {}) = True
700 isStableUnfolding _ = False
702 unfoldingArity :: Unfolding -> Arity
703 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
704 unfoldingArity _ = panic "unfoldingArity"
706 isClosedUnfolding :: Unfolding -> Bool -- No free variables
707 isClosedUnfolding (CoreUnfolding {}) = False
708 isClosedUnfolding (DFunUnfolding {}) = False
709 isClosedUnfolding _ = True
711 -- | Only returns False if there is no unfolding information available at all
712 hasSomeUnfolding :: Unfolding -> Bool
713 hasSomeUnfolding NoUnfolding = False
714 hasSomeUnfolding _ = True
716 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
717 neverUnfoldGuidance UnfNever = True
718 neverUnfoldGuidance _ = False
720 canUnfold :: Unfolding -> Bool
721 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
730 you intend that calls (f e) are replaced by <rhs>[e/x] So we
731 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
732 with it. Meanwhile, we can optimise <rhs> to our heart's content,
733 leaving the original unfolding intact in Unfolding of 'f'. For example
734 all xs = foldr (&&) True xs
735 any p = all . map p {-# INLINE any #-}
736 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
737 which deforests well at the call site.
739 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
741 Moreover, it's only used when 'f' is applied to the
742 specified number of arguments; that is, the number of argument on
743 the LHS of the '=' sign in the original source definition.
744 For example, (.) is now defined in the libraries like this
746 (.) f g = \x -> f (g x)
747 so that it'll inline when applied to two arguments. If 'x' appeared
750 it'd only inline when applied to three arguments. This slightly-experimental
751 change was requested by Roman, but it seems to make sense.
753 See also Note [Inlining an InlineRule] in CoreUnfold.
756 Note [OccInfo in unfoldings and rules]
757 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
758 In unfoldings and rules, we guarantee that the template is occ-analysed,
759 so that the occurence info on the binders is correct. This is important,
760 because the Simplifier does not re-analyse the template when using it. If
761 the occurrence info is wrong
762 - We may get more simpifier iterations than necessary, because
763 once-occ info isn't there
764 - More seriously, we may get an infinite loop if there's a Rec
765 without a loop breaker marked
768 %************************************************************************
770 \subsection{The main data type}
772 %************************************************************************
775 -- The Ord is needed for the FiniteMap used in the lookForConstructor
776 -- in SimplEnv. If you declared that lookForConstructor *ignores*
777 -- constructor-applications with LitArg args, then you could get
780 instance Outputable AltCon where
781 ppr (DataAlt dc) = ppr dc
782 ppr (LitAlt lit) = ppr lit
783 ppr DEFAULT = ptext (sLit "__DEFAULT")
785 instance Show AltCon where
786 showsPrec p con = showsPrecSDoc p (ppr con)
788 cmpAlt :: Alt b -> Alt b -> Ordering
789 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
791 ltAlt :: Alt b -> Alt b -> Bool
792 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
794 cmpAltCon :: AltCon -> AltCon -> Ordering
795 -- ^ Compares 'AltCon's within a single list of alternatives
796 cmpAltCon DEFAULT DEFAULT = EQ
797 cmpAltCon DEFAULT _ = LT
799 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
800 cmpAltCon (DataAlt _) DEFAULT = GT
801 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
802 cmpAltCon (LitAlt _) DEFAULT = GT
804 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
805 ppr con1 <+> ppr con2 )
809 %************************************************************************
811 \subsection{Useful synonyms}
813 %************************************************************************
816 -- | The common case for the type of binders and variables when
817 -- we are manipulating the Core language within GHC
819 -- | Expressions where binders are 'CoreBndr's
820 type CoreExpr = Expr CoreBndr
821 -- | Argument expressions where binders are 'CoreBndr's
822 type CoreArg = Arg CoreBndr
823 -- | Binding groups where binders are 'CoreBndr's
824 type CoreBind = Bind CoreBndr
825 -- | Case alternatives where binders are 'CoreBndr's
826 type CoreAlt = Alt CoreBndr
829 %************************************************************************
833 %************************************************************************
836 -- | Binders are /tagged/ with a t
837 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
839 type TaggedBind t = Bind (TaggedBndr t)
840 type TaggedExpr t = Expr (TaggedBndr t)
841 type TaggedArg t = Arg (TaggedBndr t)
842 type TaggedAlt t = Alt (TaggedBndr t)
844 instance Outputable b => Outputable (TaggedBndr b) where
845 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
847 instance Outputable b => OutputableBndr (TaggedBndr b) where
848 pprBndr _ b = ppr b -- Simple
852 %************************************************************************
854 \subsection{Core-constructing functions with checking}
856 %************************************************************************
859 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
860 -- use 'CoreUtils.mkCoreApps' if possible
861 mkApps :: Expr b -> [Arg b] -> Expr b
862 -- | Apply a list of type argument expressions to a function expression in a nested fashion
863 mkTyApps :: Expr b -> [Type] -> Expr b
864 -- | Apply a list of type or value variables to a function expression in a nested fashion
865 mkVarApps :: Expr b -> [Var] -> Expr b
866 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
867 -- use 'MkCore.mkCoreConApps' if possible
868 mkConApp :: DataCon -> [Arg b] -> Expr b
870 mkApps f args = foldl App f args
871 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
872 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
873 mkConApp con args = mkApps (Var (dataConWorkId con)) args
876 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
877 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
878 mkIntLit :: Integer -> Expr b
879 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
880 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
881 mkIntLitInt :: Int -> Expr b
883 mkIntLit n = Lit (mkMachInt n)
884 mkIntLitInt n = Lit (mkMachInt (toInteger n))
886 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
887 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
888 mkWordLit :: Integer -> Expr b
889 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
890 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
891 mkWordLitWord :: Word -> Expr b
893 mkWordLit w = Lit (mkMachWord w)
894 mkWordLitWord w = Lit (mkMachWord (toInteger w))
896 -- | Create a machine character literal expression of type @Char#@.
897 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
898 mkCharLit :: Char -> Expr b
899 -- | Create a machine string literal expression of type @Addr#@.
900 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
901 mkStringLit :: String -> Expr b
903 mkCharLit c = Lit (mkMachChar c)
904 mkStringLit s = Lit (mkMachString s)
906 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
907 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
908 mkFloatLit :: Rational -> Expr b
909 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
910 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
911 mkFloatLitFloat :: Float -> Expr b
913 mkFloatLit f = Lit (mkMachFloat f)
914 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
916 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
917 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
918 mkDoubleLit :: Rational -> Expr b
919 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
920 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
921 mkDoubleLitDouble :: Double -> Expr b
923 mkDoubleLit d = Lit (mkMachDouble d)
924 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
926 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
927 -- use 'CoreUtils.mkCoreLets' if possible
928 mkLets :: [Bind b] -> Expr b -> Expr b
929 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
930 -- use 'CoreUtils.mkCoreLams' if possible
931 mkLams :: [b] -> Expr b -> Expr b
933 mkLams binders body = foldr Lam body binders
934 mkLets binds body = foldr Let body binds
937 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
938 -- this can only be used to bind something in a non-recursive @let@ expression
939 mkTyBind :: TyVar -> Type -> CoreBind
940 mkTyBind tv ty = NonRec tv (Type ty)
942 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
943 varToCoreExpr :: CoreBndr -> Expr b
944 varToCoreExpr v | isId v = Var v
945 | otherwise = Type (mkTyVarTy v)
947 varsToCoreExprs :: [CoreBndr] -> [Expr b]
948 varsToCoreExprs vs = map varToCoreExpr vs
952 %************************************************************************
954 \subsection{Simple access functions}
956 %************************************************************************
959 -- | Extract every variable by this group
960 bindersOf :: Bind b -> [b]
961 bindersOf (NonRec binder _) = [binder]
962 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
964 -- | 'bindersOf' applied to a list of binding groups
965 bindersOfBinds :: [Bind b] -> [b]
966 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
968 rhssOfBind :: Bind b -> [Expr b]
969 rhssOfBind (NonRec _ rhs) = [rhs]
970 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
972 rhssOfAlts :: [Alt b] -> [Expr b]
973 rhssOfAlts alts = [e | (_,_,e) <- alts]
975 -- | Collapse all the bindings in the supplied groups into a single
976 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
977 flattenBinds :: [Bind b] -> [(b, Expr b)]
978 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
979 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
984 -- | We often want to strip off leading lambdas before getting down to
985 -- business. This function is your friend.
986 collectBinders :: Expr b -> ([b], Expr b)
987 -- | Collect as many type bindings as possible from the front of a nested lambda
988 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
989 -- | Collect as many value bindings as possible from the front of a nested lambda
990 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
991 -- | Collect type binders from the front of the lambda first,
992 -- then follow up by collecting as many value bindings as possible
993 -- from the resulting stripped expression
994 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
999 go bs (Lam b e) = go (b:bs) e
1000 go bs e = (reverse bs, e)
1002 collectTyAndValBinders expr
1005 (tvs, body1) = collectTyBinders expr
1006 (ids, body) = collectValBinders body1
1008 collectTyBinders expr
1011 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
1012 go tvs e = (reverse tvs, e)
1014 collectValBinders expr
1017 go ids (Lam b e) | isId b = go (b:ids) e
1018 go ids body = (reverse ids, body)
1022 -- | Takes a nested application expression and returns the the function
1023 -- being applied and the arguments to which it is applied
1024 collectArgs :: Expr b -> (Expr b, [Arg b])
1028 go (App f a) as = go f (a:as)
1033 -- | Gets the cost centre enclosing an expression, if any.
1034 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1035 coreExprCc :: Expr b -> CostCentre
1036 coreExprCc (Note (SCC cc) _) = cc
1037 coreExprCc (Note _ e) = coreExprCc e
1038 coreExprCc (Lam _ e) = coreExprCc e
1039 coreExprCc _ = noCostCentre
1042 %************************************************************************
1044 \subsection{Predicates}
1046 %************************************************************************
1048 At one time we optionally carried type arguments through to runtime.
1049 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1050 i.e. if type applications are actual lambdas because types are kept around
1051 at runtime. Similarly isRuntimeArg.
1054 -- | Will this variable exist at runtime?
1055 isRuntimeVar :: Var -> Bool
1058 -- | Will this argument expression exist at runtime?
1059 isRuntimeArg :: CoreExpr -> Bool
1060 isRuntimeArg = isValArg
1062 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1063 isValArg :: Expr b -> Bool
1064 isValArg (Type _) = False
1067 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1068 isTypeArg :: Expr b -> Bool
1069 isTypeArg (Type _) = True
1072 -- | The number of binders that bind values rather than types
1073 valBndrCount :: [CoreBndr] -> Int
1074 valBndrCount = count isId
1076 -- | The number of argument expressions that are values rather than types at their top level
1077 valArgCount :: [Arg b] -> Int
1078 valArgCount = count isValArg
1080 notSccNote :: Note -> Bool
1081 notSccNote (SCC {}) = False
1086 %************************************************************************
1088 \subsection{Seq stuff}
1090 %************************************************************************
1093 seqExpr :: CoreExpr -> ()
1094 seqExpr (Var v) = v `seq` ()
1095 seqExpr (Lit lit) = lit `seq` ()
1096 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1097 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1098 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1099 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1100 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1101 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1102 seqExpr (Type t) = seqType t
1104 seqExprs :: [CoreExpr] -> ()
1106 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1108 seqNote :: Note -> ()
1109 seqNote (CoreNote s) = s `seq` ()
1112 seqBndr :: CoreBndr -> ()
1113 seqBndr b = b `seq` ()
1115 seqBndrs :: [CoreBndr] -> ()
1117 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1119 seqBind :: Bind CoreBndr -> ()
1120 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1121 seqBind (Rec prs) = seqPairs prs
1123 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1125 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1127 seqAlts :: [CoreAlt] -> ()
1129 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1131 seqRules :: [CoreRule] -> ()
1133 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1134 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1135 seqRules (BuiltinRule {} : rules) = seqRules rules
1138 %************************************************************************
1140 \subsection{Annotated core}
1142 %************************************************************************
1145 -- | Annotated core: allows annotation at every node in the tree
1146 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1148 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1149 data AnnExpr' bndr annot
1152 | AnnLam bndr (AnnExpr bndr annot)
1153 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1154 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1155 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1156 | AnnCast (AnnExpr bndr annot) Coercion
1157 | AnnNote Note (AnnExpr bndr annot)
1160 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1161 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1163 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1164 data AnnBind bndr annot
1165 = AnnNonRec bndr (AnnExpr bndr annot)
1166 | AnnRec [(bndr, AnnExpr bndr annot)]
1170 -- | Takes a nested application expression and returns the the function
1171 -- being applied and the arguments to which it is applied
1172 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1176 go (_, AnnApp f a) as = go f (a:as)
1181 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1182 deAnnotate (_, e) = deAnnotate' e
1184 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1185 deAnnotate' (AnnType t) = Type t
1186 deAnnotate' (AnnVar v) = Var v
1187 deAnnotate' (AnnLit lit) = Lit lit
1188 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1189 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1190 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1191 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1193 deAnnotate' (AnnLet bind body)
1194 = Let (deAnnBind bind) (deAnnotate body)
1196 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1197 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1199 deAnnotate' (AnnCase scrut v t alts)
1200 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1202 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1203 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1207 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1208 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1212 collect bs (_, AnnLam b body) = collect (b:bs) body
1213 collect bs body = (reverse bs, body)