2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
7 {-# LANGUAGE DeriveDataTypeable #-}
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,
38 -- * Unfolding data types
39 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
40 -- Abstract everywhere but in CoreUnfold.lhs
42 -- ** Constructing 'Unfolding's
43 noUnfolding, evaldUnfolding, mkOtherCon,
44 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
46 -- ** Predicates and deconstruction on 'Unfolding'
47 unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
48 maybeUnfoldingTemplate, otherCons, unfoldingArity,
49 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
50 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
51 isStableUnfolding, isStableUnfolding_maybe,
52 isClosedUnfolding, hasSomeUnfolding,
53 canUnfold, neverUnfoldGuidance, isStableSource,
56 seqExpr, seqExprs, seqUnfolding,
58 -- * Annotated expression data types
59 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
61 -- ** Operations on annotations
62 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
64 -- * Core rule data types
65 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
66 RuleName, IdUnfoldingFun,
68 -- ** Operations on 'CoreRule's
69 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
71 isBuiltinRule, isLocalRule
74 #include "HsVersions.h"
91 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`
92 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
95 %************************************************************************
97 \subsection{The main data types}
99 %************************************************************************
101 These data types are the heart of the compiler
104 -- | This is the data type that represents GHCs core intermediate language. Currently
105 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
106 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
108 -- We get from Haskell source to this Core language in a number of stages:
110 -- 1. The source code is parsed into an abstract syntax tree, which is represented
111 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
113 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
114 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
115 -- For example, this program:
118 -- f x = let f x = x + 1
122 -- Would be renamed by having 'Unique's attached so it looked something like this:
125 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
129 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
130 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
132 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
133 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
134 -- optimization, analysis and code generation on.
136 -- The type parameter @b@ is for the type of binders in the expression tree.
138 = Var Id -- ^ Variables
140 | Lit Literal -- ^ Primitive literals
142 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
144 -- See "CoreSyn#let_app_invariant" for another invariant
146 | Lam b (Expr b) -- ^ Lambda abstraction
148 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
149 -- this corresponds to allocating a thunk for the things
150 -- bound and then executing the sub-expression.
152 -- #top_level_invariant#
153 -- #letrec_invariant#
155 -- The right hand sides of all top-level and recursive @let@s
156 -- /must/ be of lifted type (see "Type#type_classification" for
157 -- the meaning of /lifted/ vs. /unlifted/).
159 -- #let_app_invariant#
160 -- The right hand side of of a non-recursive 'Let'
161 -- _and_ the argument of an 'App',
162 -- /may/ be of unlifted type, but only if the expression
163 -- is ok-for-speculation. This means that the let can be floated
164 -- around without difficulty. For example, this is OK:
166 -- > y::Int# = x +# 1#
168 -- But this is not, as it may affect termination if the
169 -- expression is floated out:
171 -- > y::Int# = fac 4#
173 -- In this situation you should use @case@ rather than a @let@. The function
174 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
175 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
176 -- which will generate a @case@ if necessary
179 -- We allow a /non-recursive/ let to bind a type variable, thus:
181 -- > Let (NonRec tv (Type ty)) body
183 -- This can be very convenient for postponing type substitutions until
184 -- the next run of the simplifier.
186 -- At the moment, the rest of the compiler only deals with type-let
187 -- in a Let expression, rather than at top level. We may want to revist
190 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
191 -- the scrutinee (expression examined) to weak head normal form
192 -- and then examining at most one level of resulting constructor (i.e. you
193 -- cannot do nested pattern matching directly with this).
195 -- The binder gets bound to the value of the scrutinee,
196 -- and the 'Type' must be that of all the case alternatives
199 -- This is one of the more complicated elements of the Core language,
200 -- and comes with a number of restrictions:
202 -- The 'DEFAULT' case alternative must be first in the list,
203 -- if it occurs at all.
205 -- The remaining cases are in order of increasing
206 -- tag (for 'DataAlts') or
207 -- lit (for 'LitAlts').
208 -- This makes finding the relevant constructor easy,
209 -- and makes comparison easier too.
211 -- The list of alternatives must be exhaustive. An /exhaustive/ case
212 -- does not necessarily mention all constructors:
215 -- data Foo = Red | Green | Blue
218 -- other -> f (case x of
223 -- The inner case does not need a @Red@ alternative, because @x@
224 -- can't be @Red@ at that program point.
226 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type.
227 -- This is used to implement @newtype@s (a @newtype@ constructor or
228 -- destructor just becomes a 'Cast' in Core) and GADTs.
230 | Note Note (Expr b) -- ^ Notes. These allow general information to be
231 -- added to expressions in the syntax tree
233 | Type Type -- ^ A type: this should only show up at the top
235 deriving (Data, Typeable)
237 -- | Type synonym for expressions that occur in function argument positions.
238 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
241 -- | A case split alternative. Consists of the constructor leading to the alternative,
242 -- the variables bound from the constructor, and the expression to be executed given that binding.
243 -- The default alternative is @(DEFAULT, [], rhs)@
244 type Alt b = (AltCon, [b], Expr b)
246 -- | A case alternative constructor (i.e. pattern match)
247 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
248 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
249 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
250 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
251 deriving (Eq, Ord, Data, Typeable)
253 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
254 data Bind b = NonRec b (Expr b)
255 | Rec [(b, (Expr b))]
256 deriving (Data, Typeable)
259 -------------------------- CoreSyn INVARIANTS ---------------------------
261 Note [CoreSyn top-level invariant]
262 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
263 See #toplevel_invariant#
265 Note [CoreSyn letrec invariant]
266 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
267 See #letrec_invariant#
269 Note [CoreSyn let/app invariant]
270 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
271 See #let_app_invariant#
273 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
275 Note [CoreSyn case invariants]
276 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
277 See #case_invariants#
279 Note [CoreSyn let goal]
280 ~~~~~~~~~~~~~~~~~~~~~~~
281 * The simplifier tries to ensure that if the RHS of a let is a constructor
282 application, its arguments are trivial, so that the constructor can be
292 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
294 = SCC CostCentre -- ^ A cost centre annotation for profiling
295 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
296 deriving (Data, Typeable)
300 %************************************************************************
302 \subsection{Transformation rules}
304 %************************************************************************
306 The CoreRule type and its friends are dealt with mainly in CoreRules,
307 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
310 -- | A 'CoreRule' is:
312 -- * \"Local\" if the function it is a rule for is defined in the
313 -- same module as the rule itself.
315 -- * \"Orphan\" if nothing on the LHS is defined in the same module
316 -- as the rule itself
319 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
320 ru_act :: Activation, -- ^ When the rule is active
322 -- Rough-matching stuff
323 -- see comments with InstEnv.Instance( is_cls, is_rough )
324 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
325 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
327 -- Proper-matching stuff
328 -- see comments with InstEnv.Instance( is_tvs, is_tys )
329 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
330 ru_args :: [CoreExpr], -- ^ Left hand side arguments
332 -- And the right-hand side
333 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
334 -- Occurrence info is guaranteed correct
335 -- See Note [OccInfo in unfoldings and rules]
338 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
339 -- defined in the same module as the rule
340 -- and is not an implicit 'Id' (like a record selector,
341 -- class operation, or data constructor)
343 -- NB: ru_local is *not* used to decide orphan-hood
344 -- c.g. MkIface.coreRuleToIfaceRule
347 -- | Built-in rules are used for constant folding
348 -- and suchlike. They have no free variables.
350 ru_name :: RuleName, -- ^ As above
351 ru_fn :: Name, -- ^ As above
352 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
353 -- if it fires, including type arguments
354 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
355 -- ^ This function does the rewrite. It given too many
356 -- arguments, it simply discards them; the returned 'CoreExpr'
357 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
359 -- See Note [Extra args in rule matching] in Rules.lhs
361 type IdUnfoldingFun = Id -> Unfolding
362 -- A function that embodies how to unfold an Id if you need
363 -- to do that in the Rule. The reason we need to pass this info in
364 -- is that whether an Id is unfoldable depends on the simplifier phase
366 isBuiltinRule :: CoreRule -> Bool
367 isBuiltinRule (BuiltinRule {}) = True
368 isBuiltinRule _ = False
370 -- | The number of arguments the 'ru_fn' must be applied
371 -- to before the rule can match on it
372 ruleArity :: CoreRule -> Int
373 ruleArity (BuiltinRule {ru_nargs = n}) = n
374 ruleArity (Rule {ru_args = args}) = length args
376 ruleName :: CoreRule -> RuleName
379 ruleActivation_maybe :: CoreRule -> Maybe Activation
380 ruleActivation_maybe (BuiltinRule { }) = Nothing
381 ruleActivation_maybe (Rule { ru_act = act }) = Just act
383 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
384 ruleIdName :: CoreRule -> Name
387 isLocalRule :: CoreRule -> Bool
388 isLocalRule = ru_local
390 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
391 setRuleIdName :: Name -> CoreRule -> CoreRule
392 setRuleIdName nm ru = ru { ru_fn = nm }
396 %************************************************************************
400 %************************************************************************
402 The @Unfolding@ type is declared here to avoid numerous loops
405 -- | Records the /unfolding/ of an identifier, which is approximately the form the
406 -- identifier would have if we substituted its definition in for the identifier.
407 -- This type should be treated as abstract everywhere except in "CoreUnfold"
409 = NoUnfolding -- ^ We have no information about the unfolding
411 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
412 -- @OtherCon xs@ also indicates that something has been evaluated
413 -- and hence there's no point in re-evaluating it.
414 -- @OtherCon []@ is used even for non-data-type values
415 -- to indicated evaluated-ness. Notably:
417 -- > data C = C !(Int -> Int)
418 -- > case x of { C f -> ... }
420 -- Here, @f@ gets an @OtherCon []@ unfolding.
422 | DFunUnfolding -- The Unfolding of a DFunId
423 -- See Note [DFun unfoldings]
424 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
425 -- (op2 a1..am d1..dn)
427 Arity -- Arity = m+n, the *total* number of args
428 -- (unusually, both type and value) to the dfun
430 DataCon -- The dictionary data constructor (possibly a newtype datacon)
432 [CoreExpr] -- The [CoreExpr] are the superclasses and methods [op1,op2],
433 -- in positional order.
434 -- They are usually variables, but can be trivial expressions
435 -- instead (e.g. a type application).
437 | CoreUnfolding { -- An unfolding for an Id with no pragma,
438 -- or perhaps a NOINLINE pragma
439 -- (For NOINLINE, the phase, if any, is in the
440 -- InlinePragInfo for this Id.)
441 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
442 uf_src :: UnfoldingSource, -- Where the unfolding came from
443 uf_is_top :: Bool, -- True <=> top level binding
444 uf_arity :: Arity, -- Number of value arguments expected
445 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
446 -- a `seq` on this variable
447 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
448 -- Cached version of exprIsConLike
449 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand
450 -- inside an inlining
451 -- Cached version of exprIsCheap
452 uf_expandable :: Bool, -- True <=> can expand in RULE matching
453 -- Cached version of exprIsExpandable
454 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
456 -- ^ An unfolding with redundant cached information. Parameters:
458 -- uf_tmpl: Template used to perform unfolding;
459 -- NB: Occurrence info is guaranteed correct:
460 -- see Note [OccInfo in unfoldings and rules]
462 -- uf_is_top: Is this a top level binding?
464 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
467 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
468 -- Basically this is a cached version of 'exprIsCheap'
470 -- uf_guidance: Tells us about the /size/ of the unfolding template
472 ------------------------------------------------
474 = InlineRhs -- The current rhs of the function
475 -- Replace uf_tmpl each time around
477 | InlineStable -- From an INLINE or INLINABLE pragma
478 -- Do not replace uf_tmpl; instead, keep it unchanged
479 -- See Note [InlineRules]
481 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
482 -- Only a few primop-like things have this property
483 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
484 -- Inline absolutely always, however boring the context.
486 | InlineWrapper Id -- This unfolding is a the wrapper in a
487 -- worker/wrapper split from the strictness analyser
488 -- The Id is the worker-id
489 -- Used to abbreviate the uf_tmpl in interface files
490 -- which don't need to contain the RHS;
491 -- it can be derived from the strictness info
495 -- | 'UnfoldingGuidance' says when unfolding should take place
496 data UnfoldingGuidance
497 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
498 -- Used (a) for small *and* cheap unfoldings
499 -- (b) for INLINE functions
500 -- See Note [INLINE for small functions] in CoreUnfold
501 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
502 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
503 -- So True,True means "always"
506 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
507 -- result of a simple analysis of the RHS
509 ug_args :: [Int], -- Discount if the argument is evaluated.
510 -- (i.e., a simplification will definitely
511 -- be possible). One elt of the list per *value* arg.
513 ug_size :: Int, -- The "size" of the unfolding.
515 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
516 } -- a context (case (thing args) of ...),
517 -- (where there are the right number of arguments.)
519 | UnfNever -- The RHS is big, so don't inline it
523 Note [DFun unfoldings]
524 ~~~~~~~~~~~~~~~~~~~~~~
525 The Arity in a DFunUnfolding is total number of args (type and value)
526 that the DFun needs to produce a dictionary. That's not necessarily
527 related to the ordinary arity of the dfun Id, esp if the class has
528 one method, so the dictionary is represented by a newtype. Example
530 class C a where { op :: a -> Int }
531 instance C a -> C [a] where op xs = op (head xs)
533 The instance translates to
535 $dfCList :: forall a. C a => C [a] -- Arity 2!
536 $dfCList = /\a.\d. $copList {a} d |> co
538 $copList :: forall a. C a => [a] -> Int -- Arity 2!
539 $copList = /\a.\d.\xs. op {a} d (head xs)
541 Now we might encounter (op (dfCList {ty} d) a1 a2)
542 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
543 has all its arguments, even though its (value) arity is 2. That's
544 why we record the number of expected arguments in the DFunUnfolding.
546 Note that although it's an Arity, it's most convenient for it to give
547 the *total* number of arguments, both type and value. See the use
548 site in exprIsConApp_maybe.
551 -- Constants for the UnfWhen constructor
552 needSaturated, unSaturatedOk :: Bool
553 needSaturated = False
556 boringCxtNotOk, boringCxtOk :: Bool
558 boringCxtNotOk = False
560 ------------------------------------------------
561 noUnfolding :: Unfolding
562 -- ^ There is no known 'Unfolding'
563 evaldUnfolding :: Unfolding
564 -- ^ This unfolding marks the associated thing as being evaluated
566 noUnfolding = NoUnfolding
567 evaldUnfolding = OtherCon []
569 mkOtherCon :: [AltCon] -> Unfolding
570 mkOtherCon = OtherCon
572 seqUnfolding :: Unfolding -> ()
573 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
574 uf_is_value = b1, uf_is_cheap = b2,
575 uf_expandable = b3, uf_is_conlike = b4,
576 uf_arity = a, uf_guidance = g})
577 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
581 seqGuidance :: UnfoldingGuidance -> ()
582 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
587 isStableSource :: UnfoldingSource -> Bool
588 -- Keep the unfolding template
589 isStableSource InlineCompulsory = True
590 isStableSource InlineStable = True
591 isStableSource (InlineWrapper {}) = True
592 isStableSource InlineRhs = False
594 -- | Retrieves the template of an unfolding: panics if none is known
595 unfoldingTemplate :: Unfolding -> CoreExpr
596 unfoldingTemplate = uf_tmpl
598 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
599 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
601 -- | Retrieves the template of an unfolding if possible
602 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
603 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
604 maybeUnfoldingTemplate _ = Nothing
606 -- | The constructors that the unfolding could never be:
607 -- returns @[]@ if no information is available
608 otherCons :: Unfolding -> [AltCon]
609 otherCons (OtherCon cons) = cons
612 -- | Determines if it is certainly the case that the unfolding will
613 -- yield a value (something in HNF): returns @False@ if unsure
614 isValueUnfolding :: Unfolding -> Bool
615 -- Returns False for OtherCon
616 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
617 isValueUnfolding _ = False
619 -- | Determines if it possibly the case that the unfolding will
620 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
622 isEvaldUnfolding :: Unfolding -> Bool
623 -- Returns True for OtherCon
624 isEvaldUnfolding (OtherCon _) = True
625 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
626 isEvaldUnfolding _ = False
628 -- | @True@ if the unfolding is a constructor application, the application
629 -- of a CONLIKE function or 'OtherCon'
630 isConLikeUnfolding :: Unfolding -> Bool
631 isConLikeUnfolding (OtherCon _) = True
632 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
633 isConLikeUnfolding _ = False
635 -- | Is the thing we will unfold into certainly cheap?
636 isCheapUnfolding :: Unfolding -> Bool
637 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
638 isCheapUnfolding _ = False
640 isExpandableUnfolding :: Unfolding -> Bool
641 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
642 isExpandableUnfolding _ = False
644 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
645 -- Expand an expandable unfolding; this is used in rule matching
646 -- See Note [Expanding variables] in Rules.lhs
647 -- The key point here is that CONLIKE things can be expanded
648 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
649 expandUnfolding_maybe _ = Nothing
651 isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
652 isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
654 = Just (src, unsat_ok)
656 unsat_ok = case guide of
657 UnfWhen unsat_ok _ -> unsat_ok
659 isStableUnfolding_maybe _ = Nothing
661 isCompulsoryUnfolding :: Unfolding -> Bool
662 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
663 isCompulsoryUnfolding _ = False
665 isStableUnfolding :: Unfolding -> Bool
666 -- True of unfoldings that should not be overwritten
667 -- by a CoreUnfolding for the RHS of a let-binding
668 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
669 isStableUnfolding (DFunUnfolding {}) = True
670 isStableUnfolding _ = False
672 unfoldingArity :: Unfolding -> Arity
673 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
674 unfoldingArity _ = panic "unfoldingArity"
676 isClosedUnfolding :: Unfolding -> Bool -- No free variables
677 isClosedUnfolding (CoreUnfolding {}) = False
678 isClosedUnfolding (DFunUnfolding {}) = False
679 isClosedUnfolding _ = True
681 -- | Only returns False if there is no unfolding information available at all
682 hasSomeUnfolding :: Unfolding -> Bool
683 hasSomeUnfolding NoUnfolding = False
684 hasSomeUnfolding _ = True
686 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
687 neverUnfoldGuidance UnfNever = True
688 neverUnfoldGuidance _ = False
690 canUnfold :: Unfolding -> Bool
691 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
700 you intend that calls (f e) are replaced by <rhs>[e/x] So we
701 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
702 with it. Meanwhile, we can optimise <rhs> to our heart's content,
703 leaving the original unfolding intact in Unfolding of 'f'. For example
704 all xs = foldr (&&) True xs
705 any p = all . map p {-# INLINE any #-}
706 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
707 which deforests well at the call site.
709 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
711 Moreover, it's only used when 'f' is applied to the
712 specified number of arguments; that is, the number of argument on
713 the LHS of the '=' sign in the original source definition.
714 For example, (.) is now defined in the libraries like this
716 (.) f g = \x -> f (g x)
717 so that it'll inline when applied to two arguments. If 'x' appeared
720 it'd only inline when applied to three arguments. This slightly-experimental
721 change was requested by Roman, but it seems to make sense.
723 See also Note [Inlining an InlineRule] in CoreUnfold.
726 Note [OccInfo in unfoldings and rules]
727 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
728 In unfoldings and rules, we guarantee that the template is occ-analysed,
729 so that the occurence info on the binders is correct. This is important,
730 because the Simplifier does not re-analyse the template when using it. If
731 the occurrence info is wrong
732 - We may get more simpifier iterations than necessary, because
733 once-occ info isn't there
734 - More seriously, we may get an infinite loop if there's a Rec
735 without a loop breaker marked
738 %************************************************************************
740 \subsection{The main data type}
742 %************************************************************************
745 -- The Ord is needed for the FiniteMap used in the lookForConstructor
746 -- in SimplEnv. If you declared that lookForConstructor *ignores*
747 -- constructor-applications with LitArg args, then you could get
750 instance Outputable AltCon where
751 ppr (DataAlt dc) = ppr dc
752 ppr (LitAlt lit) = ppr lit
753 ppr DEFAULT = ptext (sLit "__DEFAULT")
755 instance Show AltCon where
756 showsPrec p con = showsPrecSDoc p (ppr con)
758 cmpAlt :: Alt b -> Alt b -> Ordering
759 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
761 ltAlt :: Alt b -> Alt b -> Bool
762 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
764 cmpAltCon :: AltCon -> AltCon -> Ordering
765 -- ^ Compares 'AltCon's within a single list of alternatives
766 cmpAltCon DEFAULT DEFAULT = EQ
767 cmpAltCon DEFAULT _ = LT
769 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
770 cmpAltCon (DataAlt _) DEFAULT = GT
771 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
772 cmpAltCon (LitAlt _) DEFAULT = GT
774 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
775 ppr con1 <+> ppr con2 )
779 %************************************************************************
781 \subsection{Useful synonyms}
783 %************************************************************************
786 -- | The common case for the type of binders and variables when
787 -- we are manipulating the Core language within GHC
789 -- | Expressions where binders are 'CoreBndr's
790 type CoreExpr = Expr CoreBndr
791 -- | Argument expressions where binders are 'CoreBndr's
792 type CoreArg = Arg CoreBndr
793 -- | Binding groups where binders are 'CoreBndr's
794 type CoreBind = Bind CoreBndr
795 -- | Case alternatives where binders are 'CoreBndr's
796 type CoreAlt = Alt CoreBndr
799 %************************************************************************
803 %************************************************************************
806 -- | Binders are /tagged/ with a t
807 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
809 type TaggedBind t = Bind (TaggedBndr t)
810 type TaggedExpr t = Expr (TaggedBndr t)
811 type TaggedArg t = Arg (TaggedBndr t)
812 type TaggedAlt t = Alt (TaggedBndr t)
814 instance Outputable b => Outputable (TaggedBndr b) where
815 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
817 instance Outputable b => OutputableBndr (TaggedBndr b) where
818 pprBndr _ b = ppr b -- Simple
822 %************************************************************************
824 \subsection{Core-constructing functions with checking}
826 %************************************************************************
829 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
830 -- use 'CoreUtils.mkCoreApps' if possible
831 mkApps :: Expr b -> [Arg b] -> Expr b
832 -- | Apply a list of type argument expressions to a function expression in a nested fashion
833 mkTyApps :: Expr b -> [Type] -> Expr b
834 -- | Apply a list of type or value variables to a function expression in a nested fashion
835 mkVarApps :: Expr b -> [Var] -> Expr b
836 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
837 -- use 'MkCore.mkCoreConApps' if possible
838 mkConApp :: DataCon -> [Arg b] -> Expr b
840 mkApps f args = foldl App f args
841 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
842 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
843 mkConApp con args = mkApps (Var (dataConWorkId con)) args
846 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
847 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
848 mkIntLit :: Integer -> Expr b
849 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
850 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
851 mkIntLitInt :: Int -> Expr b
853 mkIntLit n = Lit (mkMachInt n)
854 mkIntLitInt n = Lit (mkMachInt (toInteger n))
856 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
857 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
858 mkWordLit :: Integer -> Expr b
859 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
860 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
861 mkWordLitWord :: Word -> Expr b
863 mkWordLit w = Lit (mkMachWord w)
864 mkWordLitWord w = Lit (mkMachWord (toInteger w))
866 -- | Create a machine character literal expression of type @Char#@.
867 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
868 mkCharLit :: Char -> Expr b
869 -- | Create a machine string literal expression of type @Addr#@.
870 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
871 mkStringLit :: String -> Expr b
873 mkCharLit c = Lit (mkMachChar c)
874 mkStringLit s = Lit (mkMachString s)
876 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
877 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
878 mkFloatLit :: Rational -> Expr b
879 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
880 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
881 mkFloatLitFloat :: Float -> Expr b
883 mkFloatLit f = Lit (mkMachFloat f)
884 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
886 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
887 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
888 mkDoubleLit :: Rational -> Expr b
889 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
890 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
891 mkDoubleLitDouble :: Double -> Expr b
893 mkDoubleLit d = Lit (mkMachDouble d)
894 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
896 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
897 -- use 'CoreUtils.mkCoreLets' if possible
898 mkLets :: [Bind b] -> Expr b -> Expr b
899 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
900 -- use 'CoreUtils.mkCoreLams' if possible
901 mkLams :: [b] -> Expr b -> Expr b
903 mkLams binders body = foldr Lam body binders
904 mkLets binds body = foldr Let body binds
907 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
908 -- this can only be used to bind something in a non-recursive @let@ expression
909 mkTyBind :: TyVar -> Type -> CoreBind
910 mkTyBind tv ty = NonRec tv (Type ty)
912 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
913 varToCoreExpr :: CoreBndr -> Expr b
914 varToCoreExpr v | isId v = Var v
915 | otherwise = Type (mkTyVarTy v)
917 varsToCoreExprs :: [CoreBndr] -> [Expr b]
918 varsToCoreExprs vs = map varToCoreExpr vs
922 %************************************************************************
924 \subsection{Simple access functions}
926 %************************************************************************
929 -- | Extract every variable by this group
930 bindersOf :: Bind b -> [b]
931 bindersOf (NonRec binder _) = [binder]
932 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
934 -- | 'bindersOf' applied to a list of binding groups
935 bindersOfBinds :: [Bind b] -> [b]
936 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
938 rhssOfBind :: Bind b -> [Expr b]
939 rhssOfBind (NonRec _ rhs) = [rhs]
940 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
942 rhssOfAlts :: [Alt b] -> [Expr b]
943 rhssOfAlts alts = [e | (_,_,e) <- alts]
945 -- | Collapse all the bindings in the supplied groups into a single
946 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
947 flattenBinds :: [Bind b] -> [(b, Expr b)]
948 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
949 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
954 -- | We often want to strip off leading lambdas before getting down to
955 -- business. This function is your friend.
956 collectBinders :: Expr b -> ([b], Expr b)
957 -- | Collect as many type bindings as possible from the front of a nested lambda
958 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
959 -- | Collect as many value bindings as possible from the front of a nested lambda
960 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
961 -- | Collect type binders from the front of the lambda first,
962 -- then follow up by collecting as many value bindings as possible
963 -- from the resulting stripped expression
964 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
969 go bs (Lam b e) = go (b:bs) e
970 go bs e = (reverse bs, e)
972 collectTyAndValBinders expr
975 (tvs, body1) = collectTyBinders expr
976 (ids, body) = collectValBinders body1
978 collectTyBinders expr
981 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
982 go tvs e = (reverse tvs, e)
984 collectValBinders expr
987 go ids (Lam b e) | isId b = go (b:ids) e
988 go ids body = (reverse ids, body)
992 -- | Takes a nested application expression and returns the the function
993 -- being applied and the arguments to which it is applied
994 collectArgs :: Expr b -> (Expr b, [Arg b])
998 go (App f a) as = go f (a:as)
1003 -- | Gets the cost centre enclosing an expression, if any.
1004 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1005 coreExprCc :: Expr b -> CostCentre
1006 coreExprCc (Note (SCC cc) _) = cc
1007 coreExprCc (Note _ e) = coreExprCc e
1008 coreExprCc (Lam _ e) = coreExprCc e
1009 coreExprCc _ = noCostCentre
1012 %************************************************************************
1014 \subsection{Predicates}
1016 %************************************************************************
1018 At one time we optionally carried type arguments through to runtime.
1019 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1020 i.e. if type applications are actual lambdas because types are kept around
1021 at runtime. Similarly isRuntimeArg.
1024 -- | Will this variable exist at runtime?
1025 isRuntimeVar :: Var -> Bool
1028 -- | Will this argument expression exist at runtime?
1029 isRuntimeArg :: CoreExpr -> Bool
1030 isRuntimeArg = isValArg
1032 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1033 isValArg :: Expr b -> Bool
1034 isValArg (Type _) = False
1037 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1038 isTypeArg :: Expr b -> Bool
1039 isTypeArg (Type _) = True
1042 -- | The number of binders that bind values rather than types
1043 valBndrCount :: [CoreBndr] -> Int
1044 valBndrCount = count isId
1046 -- | The number of argument expressions that are values rather than types at their top level
1047 valArgCount :: [Arg b] -> Int
1048 valArgCount = count isValArg
1052 %************************************************************************
1054 \subsection{Seq stuff}
1056 %************************************************************************
1059 seqExpr :: CoreExpr -> ()
1060 seqExpr (Var v) = v `seq` ()
1061 seqExpr (Lit lit) = lit `seq` ()
1062 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1063 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1064 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1065 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1066 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1067 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1068 seqExpr (Type t) = seqType t
1070 seqExprs :: [CoreExpr] -> ()
1072 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1074 seqNote :: Note -> ()
1075 seqNote (CoreNote s) = s `seq` ()
1078 seqBndr :: CoreBndr -> ()
1079 seqBndr b = b `seq` ()
1081 seqBndrs :: [CoreBndr] -> ()
1083 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1085 seqBind :: Bind CoreBndr -> ()
1086 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1087 seqBind (Rec prs) = seqPairs prs
1089 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1091 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1093 seqAlts :: [CoreAlt] -> ()
1095 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1097 seqRules :: [CoreRule] -> ()
1099 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1100 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1101 seqRules (BuiltinRule {} : rules) = seqRules rules
1104 %************************************************************************
1106 \subsection{Annotated core}
1108 %************************************************************************
1111 -- | Annotated core: allows annotation at every node in the tree
1112 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1114 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1115 data AnnExpr' bndr annot
1118 | AnnLam bndr (AnnExpr bndr annot)
1119 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1120 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1121 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1122 | AnnCast (AnnExpr bndr annot) Coercion
1123 | AnnNote Note (AnnExpr bndr annot)
1126 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1127 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1129 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1130 data AnnBind bndr annot
1131 = AnnNonRec bndr (AnnExpr bndr annot)
1132 | AnnRec [(bndr, AnnExpr bndr annot)]
1136 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1137 deAnnotate (_, e) = deAnnotate' e
1139 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1140 deAnnotate' (AnnType t) = Type t
1141 deAnnotate' (AnnVar v) = Var v
1142 deAnnotate' (AnnLit lit) = Lit lit
1143 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1144 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1145 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1146 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1148 deAnnotate' (AnnLet bind body)
1149 = Let (deAnnBind bind) (deAnnotate body)
1151 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1152 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1154 deAnnotate' (AnnCase scrut v t alts)
1155 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1157 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1158 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1162 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1163 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1167 collect bs (_, AnnLam b body) = collect (b:bs) body
1168 collect bs body = (reverse bs, body)