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,
39 -- * Unfolding data types
40 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
41 -- Abstract everywhere but in CoreUnfold.lhs
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 [CoreExpr] -- The [CoreExpr] are the superclasses and methods [op1,op2],
441 -- in positional order.
442 -- They are usually variables, but can be trivial expressions
443 -- instead (e.g. a type application).
445 | CoreUnfolding { -- An unfolding for an Id with no pragma,
446 -- or perhaps a NOINLINE pragma
447 -- (For NOINLINE, the phase, if any, is in the
448 -- InlinePragInfo for this Id.)
449 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
450 uf_src :: UnfoldingSource, -- Where the unfolding came from
451 uf_is_top :: Bool, -- True <=> top level binding
452 uf_arity :: Arity, -- Number of value arguments expected
453 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
454 -- a `seq` on this variable
455 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
456 -- Cached version of exprIsConLike
457 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand
458 -- inside an inlining
459 -- Cached version of exprIsCheap
460 uf_expandable :: Bool, -- True <=> can expand in RULE matching
461 -- Cached version of exprIsExpandable
462 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
464 -- ^ An unfolding with redundant cached information. Parameters:
466 -- uf_tmpl: Template used to perform unfolding;
467 -- NB: Occurrence info is guaranteed correct:
468 -- see Note [OccInfo in unfoldings and rules]
470 -- uf_is_top: Is this a top level binding?
472 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
475 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
476 -- Basically this is a cached version of 'exprIsCheap'
478 -- uf_guidance: Tells us about the /size/ of the unfolding template
480 ------------------------------------------------
482 = InlineRhs -- The current rhs of the function
483 -- Replace uf_tmpl each time around
485 | InlineStable -- From an INLINE or INLINABLE pragma
486 -- INLINE if guidance is UnfWhen
487 -- INLINABLE if guidance is UnfIfGoodArgs
488 -- (well, technically an INLINABLE might be made
489 -- UnfWhen if it was small enough, and then
490 -- it will behave like INLINE outside the current
491 -- module, but that is the way automatic unfoldings
492 -- work so it is consistent with the intended
493 -- meaning of INLINABLE).
495 -- uf_tmpl may change, but only as a result of
496 -- gentle simplification, it doesn't get updated
497 -- to the current RHS during compilation as with
500 -- See Note [InlineRules]
502 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
503 -- Only a few primop-like things have this property
504 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
505 -- Inline absolutely always, however boring the context.
507 | InlineWrapper Id -- This unfolding is a the wrapper in a
508 -- worker/wrapper split from the strictness analyser
509 -- The Id is the worker-id
510 -- Used to abbreviate the uf_tmpl in interface files
511 -- which don't need to contain the RHS;
512 -- it can be derived from the strictness info
516 -- | 'UnfoldingGuidance' says when unfolding should take place
517 data UnfoldingGuidance
518 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
519 -- Used (a) for small *and* cheap unfoldings
520 -- (b) for INLINE functions
521 -- See Note [INLINE for small functions] in CoreUnfold
522 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
523 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
524 -- So True,True means "always"
527 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
528 -- result of a simple analysis of the RHS
530 ug_args :: [Int], -- Discount if the argument is evaluated.
531 -- (i.e., a simplification will definitely
532 -- be possible). One elt of the list per *value* arg.
534 ug_size :: Int, -- The "size" of the unfolding.
536 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
537 } -- a context (case (thing args) of ...),
538 -- (where there are the right number of arguments.)
540 | UnfNever -- The RHS is big, so don't inline it
544 Note [DFun unfoldings]
545 ~~~~~~~~~~~~~~~~~~~~~~
546 The Arity in a DFunUnfolding is total number of args (type and value)
547 that the DFun needs to produce a dictionary. That's not necessarily
548 related to the ordinary arity of the dfun Id, esp if the class has
549 one method, so the dictionary is represented by a newtype. Example
551 class C a where { op :: a -> Int }
552 instance C a -> C [a] where op xs = op (head xs)
554 The instance translates to
556 $dfCList :: forall a. C a => C [a] -- Arity 2!
557 $dfCList = /\a.\d. $copList {a} d |> co
559 $copList :: forall a. C a => [a] -> Int -- Arity 2!
560 $copList = /\a.\d.\xs. op {a} d (head xs)
562 Now we might encounter (op (dfCList {ty} d) a1 a2)
563 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
564 has all its arguments, even though its (value) arity is 2. That's
565 why we record the number of expected arguments in the DFunUnfolding.
567 Note that although it's an Arity, it's most convenient for it to give
568 the *total* number of arguments, both type and value. See the use
569 site in exprIsConApp_maybe.
572 -- Constants for the UnfWhen constructor
573 needSaturated, unSaturatedOk :: Bool
574 needSaturated = False
577 boringCxtNotOk, boringCxtOk :: Bool
579 boringCxtNotOk = False
581 ------------------------------------------------
582 noUnfolding :: Unfolding
583 -- ^ There is no known 'Unfolding'
584 evaldUnfolding :: Unfolding
585 -- ^ This unfolding marks the associated thing as being evaluated
587 noUnfolding = NoUnfolding
588 evaldUnfolding = OtherCon []
590 mkOtherCon :: [AltCon] -> Unfolding
591 mkOtherCon = OtherCon
593 seqUnfolding :: Unfolding -> ()
594 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
595 uf_is_value = b1, uf_is_cheap = b2,
596 uf_expandable = b3, uf_is_conlike = b4,
597 uf_arity = a, uf_guidance = g})
598 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
602 seqGuidance :: UnfoldingGuidance -> ()
603 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
608 isStableSource :: UnfoldingSource -> Bool
609 -- Keep the unfolding template
610 isStableSource InlineCompulsory = True
611 isStableSource InlineStable = True
612 isStableSource (InlineWrapper {}) = True
613 isStableSource InlineRhs = False
615 -- | Retrieves the template of an unfolding: panics if none is known
616 unfoldingTemplate :: Unfolding -> CoreExpr
617 unfoldingTemplate = uf_tmpl
619 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
620 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
622 -- | Retrieves the template of an unfolding if possible
623 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
624 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
625 maybeUnfoldingTemplate _ = Nothing
627 -- | The constructors that the unfolding could never be:
628 -- returns @[]@ if no information is available
629 otherCons :: Unfolding -> [AltCon]
630 otherCons (OtherCon cons) = cons
633 -- | Determines if it is certainly the case that the unfolding will
634 -- yield a value (something in HNF): returns @False@ if unsure
635 isValueUnfolding :: Unfolding -> Bool
636 -- Returns False for OtherCon
637 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
638 isValueUnfolding _ = False
640 -- | Determines if it possibly the case that the unfolding will
641 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
643 isEvaldUnfolding :: Unfolding -> Bool
644 -- Returns True for OtherCon
645 isEvaldUnfolding (OtherCon _) = True
646 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
647 isEvaldUnfolding _ = False
649 -- | @True@ if the unfolding is a constructor application, the application
650 -- of a CONLIKE function or 'OtherCon'
651 isConLikeUnfolding :: Unfolding -> Bool
652 isConLikeUnfolding (OtherCon _) = True
653 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
654 isConLikeUnfolding _ = False
656 -- | Is the thing we will unfold into certainly cheap?
657 isCheapUnfolding :: Unfolding -> Bool
658 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
659 isCheapUnfolding _ = False
661 isExpandableUnfolding :: Unfolding -> Bool
662 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
663 isExpandableUnfolding _ = False
665 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
666 -- Expand an expandable unfolding; this is used in rule matching
667 -- See Note [Expanding variables] in Rules.lhs
668 -- The key point here is that CONLIKE things can be expanded
669 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
670 expandUnfolding_maybe _ = Nothing
672 isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
673 isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
674 | isStableSource src = Just src
675 isStableCoreUnfolding_maybe _ = Nothing
677 isCompulsoryUnfolding :: Unfolding -> Bool
678 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
679 isCompulsoryUnfolding _ = False
681 isStableUnfolding :: Unfolding -> Bool
682 -- True of unfoldings that should not be overwritten
683 -- by a CoreUnfolding for the RHS of a let-binding
684 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
685 isStableUnfolding (DFunUnfolding {}) = True
686 isStableUnfolding _ = False
688 unfoldingArity :: Unfolding -> Arity
689 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
690 unfoldingArity _ = panic "unfoldingArity"
692 isClosedUnfolding :: Unfolding -> Bool -- No free variables
693 isClosedUnfolding (CoreUnfolding {}) = False
694 isClosedUnfolding (DFunUnfolding {}) = False
695 isClosedUnfolding _ = True
697 -- | Only returns False if there is no unfolding information available at all
698 hasSomeUnfolding :: Unfolding -> Bool
699 hasSomeUnfolding NoUnfolding = False
700 hasSomeUnfolding _ = True
702 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
703 neverUnfoldGuidance UnfNever = True
704 neverUnfoldGuidance _ = False
706 canUnfold :: Unfolding -> Bool
707 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
716 you intend that calls (f e) are replaced by <rhs>[e/x] So we
717 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
718 with it. Meanwhile, we can optimise <rhs> to our heart's content,
719 leaving the original unfolding intact in Unfolding of 'f'. For example
720 all xs = foldr (&&) True xs
721 any p = all . map p {-# INLINE any #-}
722 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
723 which deforests well at the call site.
725 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
727 Moreover, it's only used when 'f' is applied to the
728 specified number of arguments; that is, the number of argument on
729 the LHS of the '=' sign in the original source definition.
730 For example, (.) is now defined in the libraries like this
732 (.) f g = \x -> f (g x)
733 so that it'll inline when applied to two arguments. If 'x' appeared
736 it'd only inline when applied to three arguments. This slightly-experimental
737 change was requested by Roman, but it seems to make sense.
739 See also Note [Inlining an InlineRule] in CoreUnfold.
742 Note [OccInfo in unfoldings and rules]
743 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
744 In unfoldings and rules, we guarantee that the template is occ-analysed,
745 so that the occurence info on the binders is correct. This is important,
746 because the Simplifier does not re-analyse the template when using it. If
747 the occurrence info is wrong
748 - We may get more simpifier iterations than necessary, because
749 once-occ info isn't there
750 - More seriously, we may get an infinite loop if there's a Rec
751 without a loop breaker marked
754 %************************************************************************
756 \subsection{The main data type}
758 %************************************************************************
761 -- The Ord is needed for the FiniteMap used in the lookForConstructor
762 -- in SimplEnv. If you declared that lookForConstructor *ignores*
763 -- constructor-applications with LitArg args, then you could get
766 instance Outputable AltCon where
767 ppr (DataAlt dc) = ppr dc
768 ppr (LitAlt lit) = ppr lit
769 ppr DEFAULT = ptext (sLit "__DEFAULT")
771 instance Show AltCon where
772 showsPrec p con = showsPrecSDoc p (ppr con)
774 cmpAlt :: Alt b -> Alt b -> Ordering
775 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
777 ltAlt :: Alt b -> Alt b -> Bool
778 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
780 cmpAltCon :: AltCon -> AltCon -> Ordering
781 -- ^ Compares 'AltCon's within a single list of alternatives
782 cmpAltCon DEFAULT DEFAULT = EQ
783 cmpAltCon DEFAULT _ = LT
785 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
786 cmpAltCon (DataAlt _) DEFAULT = GT
787 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
788 cmpAltCon (LitAlt _) DEFAULT = GT
790 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
791 ppr con1 <+> ppr con2 )
795 %************************************************************************
797 \subsection{Useful synonyms}
799 %************************************************************************
802 -- | The common case for the type of binders and variables when
803 -- we are manipulating the Core language within GHC
805 -- | Expressions where binders are 'CoreBndr's
806 type CoreExpr = Expr CoreBndr
807 -- | Argument expressions where binders are 'CoreBndr's
808 type CoreArg = Arg CoreBndr
809 -- | Binding groups where binders are 'CoreBndr's
810 type CoreBind = Bind CoreBndr
811 -- | Case alternatives where binders are 'CoreBndr's
812 type CoreAlt = Alt CoreBndr
815 %************************************************************************
819 %************************************************************************
822 -- | Binders are /tagged/ with a t
823 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
825 type TaggedBind t = Bind (TaggedBndr t)
826 type TaggedExpr t = Expr (TaggedBndr t)
827 type TaggedArg t = Arg (TaggedBndr t)
828 type TaggedAlt t = Alt (TaggedBndr t)
830 instance Outputable b => Outputable (TaggedBndr b) where
831 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
833 instance Outputable b => OutputableBndr (TaggedBndr b) where
834 pprBndr _ b = ppr b -- Simple
838 %************************************************************************
840 \subsection{Core-constructing functions with checking}
842 %************************************************************************
845 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
846 -- use 'CoreUtils.mkCoreApps' if possible
847 mkApps :: Expr b -> [Arg b] -> Expr b
848 -- | Apply a list of type argument expressions to a function expression in a nested fashion
849 mkTyApps :: Expr b -> [Type] -> Expr b
850 -- | Apply a list of type or value variables to a function expression in a nested fashion
851 mkVarApps :: Expr b -> [Var] -> Expr b
852 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
853 -- use 'MkCore.mkCoreConApps' if possible
854 mkConApp :: DataCon -> [Arg b] -> Expr b
856 mkApps f args = foldl App f args
857 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
858 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
859 mkConApp con args = mkApps (Var (dataConWorkId con)) args
862 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
863 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
864 mkIntLit :: Integer -> Expr b
865 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
866 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
867 mkIntLitInt :: Int -> Expr b
869 mkIntLit n = Lit (mkMachInt n)
870 mkIntLitInt n = Lit (mkMachInt (toInteger n))
872 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
873 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
874 mkWordLit :: Integer -> Expr b
875 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
876 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
877 mkWordLitWord :: Word -> Expr b
879 mkWordLit w = Lit (mkMachWord w)
880 mkWordLitWord w = Lit (mkMachWord (toInteger w))
882 -- | Create a machine character literal expression of type @Char#@.
883 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
884 mkCharLit :: Char -> Expr b
885 -- | Create a machine string literal expression of type @Addr#@.
886 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
887 mkStringLit :: String -> Expr b
889 mkCharLit c = Lit (mkMachChar c)
890 mkStringLit s = Lit (mkMachString s)
892 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
893 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
894 mkFloatLit :: Rational -> Expr b
895 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
896 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
897 mkFloatLitFloat :: Float -> Expr b
899 mkFloatLit f = Lit (mkMachFloat f)
900 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
902 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
903 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
904 mkDoubleLit :: Rational -> Expr b
905 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
906 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
907 mkDoubleLitDouble :: Double -> Expr b
909 mkDoubleLit d = Lit (mkMachDouble d)
910 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
912 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
913 -- use 'CoreUtils.mkCoreLets' if possible
914 mkLets :: [Bind b] -> Expr b -> Expr b
915 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
916 -- use 'CoreUtils.mkCoreLams' if possible
917 mkLams :: [b] -> Expr b -> Expr b
919 mkLams binders body = foldr Lam body binders
920 mkLets binds body = foldr Let body binds
923 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
924 -- this can only be used to bind something in a non-recursive @let@ expression
925 mkTyBind :: TyVar -> Type -> CoreBind
926 mkTyBind tv ty = NonRec tv (Type ty)
928 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
929 varToCoreExpr :: CoreBndr -> Expr b
930 varToCoreExpr v | isId v = Var v
931 | otherwise = Type (mkTyVarTy v)
933 varsToCoreExprs :: [CoreBndr] -> [Expr b]
934 varsToCoreExprs vs = map varToCoreExpr vs
938 %************************************************************************
940 \subsection{Simple access functions}
942 %************************************************************************
945 -- | Extract every variable by this group
946 bindersOf :: Bind b -> [b]
947 bindersOf (NonRec binder _) = [binder]
948 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
950 -- | 'bindersOf' applied to a list of binding groups
951 bindersOfBinds :: [Bind b] -> [b]
952 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
954 rhssOfBind :: Bind b -> [Expr b]
955 rhssOfBind (NonRec _ rhs) = [rhs]
956 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
958 rhssOfAlts :: [Alt b] -> [Expr b]
959 rhssOfAlts alts = [e | (_,_,e) <- alts]
961 -- | Collapse all the bindings in the supplied groups into a single
962 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
963 flattenBinds :: [Bind b] -> [(b, Expr b)]
964 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
965 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
970 -- | We often want to strip off leading lambdas before getting down to
971 -- business. This function is your friend.
972 collectBinders :: Expr b -> ([b], Expr b)
973 -- | Collect as many type bindings as possible from the front of a nested lambda
974 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
975 -- | Collect as many value bindings as possible from the front of a nested lambda
976 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
977 -- | Collect type binders from the front of the lambda first,
978 -- then follow up by collecting as many value bindings as possible
979 -- from the resulting stripped expression
980 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
985 go bs (Lam b e) = go (b:bs) e
986 go bs e = (reverse bs, e)
988 collectTyAndValBinders expr
991 (tvs, body1) = collectTyBinders expr
992 (ids, body) = collectValBinders body1
994 collectTyBinders expr
997 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
998 go tvs e = (reverse tvs, e)
1000 collectValBinders expr
1003 go ids (Lam b e) | isId b = go (b:ids) e
1004 go ids body = (reverse ids, body)
1008 -- | Takes a nested application expression and returns the the function
1009 -- being applied and the arguments to which it is applied
1010 collectArgs :: Expr b -> (Expr b, [Arg b])
1014 go (App f a) as = go f (a:as)
1019 -- | Gets the cost centre enclosing an expression, if any.
1020 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1021 coreExprCc :: Expr b -> CostCentre
1022 coreExprCc (Note (SCC cc) _) = cc
1023 coreExprCc (Note _ e) = coreExprCc e
1024 coreExprCc (Lam _ e) = coreExprCc e
1025 coreExprCc _ = noCostCentre
1028 %************************************************************************
1030 \subsection{Predicates}
1032 %************************************************************************
1034 At one time we optionally carried type arguments through to runtime.
1035 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1036 i.e. if type applications are actual lambdas because types are kept around
1037 at runtime. Similarly isRuntimeArg.
1040 -- | Will this variable exist at runtime?
1041 isRuntimeVar :: Var -> Bool
1044 -- | Will this argument expression exist at runtime?
1045 isRuntimeArg :: CoreExpr -> Bool
1046 isRuntimeArg = isValArg
1048 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1049 isValArg :: Expr b -> Bool
1050 isValArg (Type _) = False
1053 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1054 isTypeArg :: Expr b -> Bool
1055 isTypeArg (Type _) = True
1058 -- | The number of binders that bind values rather than types
1059 valBndrCount :: [CoreBndr] -> Int
1060 valBndrCount = count isId
1062 -- | The number of argument expressions that are values rather than types at their top level
1063 valArgCount :: [Arg b] -> Int
1064 valArgCount = count isValArg
1066 notSccNote :: Note -> Bool
1067 notSccNote (SCC {}) = False
1072 %************************************************************************
1074 \subsection{Seq stuff}
1076 %************************************************************************
1079 seqExpr :: CoreExpr -> ()
1080 seqExpr (Var v) = v `seq` ()
1081 seqExpr (Lit lit) = lit `seq` ()
1082 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1083 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1084 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1085 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1086 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1087 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1088 seqExpr (Type t) = seqType t
1090 seqExprs :: [CoreExpr] -> ()
1092 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1094 seqNote :: Note -> ()
1095 seqNote (CoreNote s) = s `seq` ()
1098 seqBndr :: CoreBndr -> ()
1099 seqBndr b = b `seq` ()
1101 seqBndrs :: [CoreBndr] -> ()
1103 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1105 seqBind :: Bind CoreBndr -> ()
1106 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1107 seqBind (Rec prs) = seqPairs prs
1109 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1111 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1113 seqAlts :: [CoreAlt] -> ()
1115 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1117 seqRules :: [CoreRule] -> ()
1119 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1120 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1121 seqRules (BuiltinRule {} : rules) = seqRules rules
1124 %************************************************************************
1126 \subsection{Annotated core}
1128 %************************************************************************
1131 -- | Annotated core: allows annotation at every node in the tree
1132 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1134 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1135 data AnnExpr' bndr annot
1138 | AnnLam bndr (AnnExpr bndr annot)
1139 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1140 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1141 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1142 | AnnCast (AnnExpr bndr annot) Coercion
1143 | AnnNote Note (AnnExpr bndr annot)
1146 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1147 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1149 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1150 data AnnBind bndr annot
1151 = AnnNonRec bndr (AnnExpr bndr annot)
1152 | AnnRec [(bndr, AnnExpr bndr annot)]
1156 -- | Takes a nested application expression and returns the the function
1157 -- being applied and the arguments to which it is applied
1158 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1162 go (_, AnnApp f a) as = go f (a:as)
1167 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1168 deAnnotate (_, e) = deAnnotate' e
1170 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1171 deAnnotate' (AnnType t) = Type t
1172 deAnnotate' (AnnVar v) = Var v
1173 deAnnotate' (AnnLit lit) = Lit lit
1174 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1175 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1176 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1177 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1179 deAnnotate' (AnnLet bind body)
1180 = Let (deAnnBind bind) (deAnnotate body)
1182 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1183 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1185 deAnnotate' (AnnCase scrut v t alts)
1186 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1188 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1189 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1193 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1194 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1198 collect bs (_, AnnLam b body) = collect (b:bs) body
1199 collect bs body = (reverse bs, body)