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, isStableUnfolding_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_maybe,
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_maybe :: CoreRule -> Maybe Activation
388 ruleActivation_maybe (BuiltinRule { }) = Nothing
389 ruleActivation_maybe (Rule { ru_act = act }) = Just 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 isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
673 isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
675 = Just (src, unsat_ok)
677 unsat_ok = case guide of
678 UnfWhen unsat_ok _ -> unsat_ok
680 isStableUnfolding_maybe _ = Nothing
682 isCompulsoryUnfolding :: Unfolding -> Bool
683 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
684 isCompulsoryUnfolding _ = False
686 isStableUnfolding :: Unfolding -> Bool
687 -- True of unfoldings that should not be overwritten
688 -- by a CoreUnfolding for the RHS of a let-binding
689 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
690 isStableUnfolding (DFunUnfolding {}) = True
691 isStableUnfolding _ = False
693 unfoldingArity :: Unfolding -> Arity
694 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
695 unfoldingArity _ = panic "unfoldingArity"
697 isClosedUnfolding :: Unfolding -> Bool -- No free variables
698 isClosedUnfolding (CoreUnfolding {}) = False
699 isClosedUnfolding (DFunUnfolding {}) = False
700 isClosedUnfolding _ = True
702 -- | Only returns False if there is no unfolding information available at all
703 hasSomeUnfolding :: Unfolding -> Bool
704 hasSomeUnfolding NoUnfolding = False
705 hasSomeUnfolding _ = True
707 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
708 neverUnfoldGuidance UnfNever = True
709 neverUnfoldGuidance _ = False
711 canUnfold :: Unfolding -> Bool
712 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
721 you intend that calls (f e) are replaced by <rhs>[e/x] So we
722 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
723 with it. Meanwhile, we can optimise <rhs> to our heart's content,
724 leaving the original unfolding intact in Unfolding of 'f'. For example
725 all xs = foldr (&&) True xs
726 any p = all . map p {-# INLINE any #-}
727 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
728 which deforests well at the call site.
730 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
732 Moreover, it's only used when 'f' is applied to the
733 specified number of arguments; that is, the number of argument on
734 the LHS of the '=' sign in the original source definition.
735 For example, (.) is now defined in the libraries like this
737 (.) f g = \x -> f (g x)
738 so that it'll inline when applied to two arguments. If 'x' appeared
741 it'd only inline when applied to three arguments. This slightly-experimental
742 change was requested by Roman, but it seems to make sense.
744 See also Note [Inlining an InlineRule] in CoreUnfold.
747 Note [OccInfo in unfoldings and rules]
748 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
749 In unfoldings and rules, we guarantee that the template is occ-analysed,
750 so that the occurence info on the binders is correct. This is important,
751 because the Simplifier does not re-analyse the template when using it. If
752 the occurrence info is wrong
753 - We may get more simpifier iterations than necessary, because
754 once-occ info isn't there
755 - More seriously, we may get an infinite loop if there's a Rec
756 without a loop breaker marked
759 %************************************************************************
761 \subsection{The main data type}
763 %************************************************************************
766 -- The Ord is needed for the FiniteMap used in the lookForConstructor
767 -- in SimplEnv. If you declared that lookForConstructor *ignores*
768 -- constructor-applications with LitArg args, then you could get
771 instance Outputable AltCon where
772 ppr (DataAlt dc) = ppr dc
773 ppr (LitAlt lit) = ppr lit
774 ppr DEFAULT = ptext (sLit "__DEFAULT")
776 instance Show AltCon where
777 showsPrec p con = showsPrecSDoc p (ppr con)
779 cmpAlt :: Alt b -> Alt b -> Ordering
780 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
782 ltAlt :: Alt b -> Alt b -> Bool
783 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
785 cmpAltCon :: AltCon -> AltCon -> Ordering
786 -- ^ Compares 'AltCon's within a single list of alternatives
787 cmpAltCon DEFAULT DEFAULT = EQ
788 cmpAltCon DEFAULT _ = LT
790 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
791 cmpAltCon (DataAlt _) DEFAULT = GT
792 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
793 cmpAltCon (LitAlt _) DEFAULT = GT
795 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
796 ppr con1 <+> ppr con2 )
800 %************************************************************************
802 \subsection{Useful synonyms}
804 %************************************************************************
807 -- | The common case for the type of binders and variables when
808 -- we are manipulating the Core language within GHC
810 -- | Expressions where binders are 'CoreBndr's
811 type CoreExpr = Expr CoreBndr
812 -- | Argument expressions where binders are 'CoreBndr's
813 type CoreArg = Arg CoreBndr
814 -- | Binding groups where binders are 'CoreBndr's
815 type CoreBind = Bind CoreBndr
816 -- | Case alternatives where binders are 'CoreBndr's
817 type CoreAlt = Alt CoreBndr
820 %************************************************************************
824 %************************************************************************
827 -- | Binders are /tagged/ with a t
828 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
830 type TaggedBind t = Bind (TaggedBndr t)
831 type TaggedExpr t = Expr (TaggedBndr t)
832 type TaggedArg t = Arg (TaggedBndr t)
833 type TaggedAlt t = Alt (TaggedBndr t)
835 instance Outputable b => Outputable (TaggedBndr b) where
836 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
838 instance Outputable b => OutputableBndr (TaggedBndr b) where
839 pprBndr _ b = ppr b -- Simple
843 %************************************************************************
845 \subsection{Core-constructing functions with checking}
847 %************************************************************************
850 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
851 -- use 'CoreUtils.mkCoreApps' if possible
852 mkApps :: Expr b -> [Arg b] -> Expr b
853 -- | Apply a list of type argument expressions to a function expression in a nested fashion
854 mkTyApps :: Expr b -> [Type] -> Expr b
855 -- | Apply a list of type or value variables to a function expression in a nested fashion
856 mkVarApps :: Expr b -> [Var] -> Expr b
857 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
858 -- use 'MkCore.mkCoreConApps' if possible
859 mkConApp :: DataCon -> [Arg b] -> Expr b
861 mkApps f args = foldl App f args
862 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
863 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
864 mkConApp con args = mkApps (Var (dataConWorkId con)) args
867 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
868 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
869 mkIntLit :: Integer -> Expr b
870 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
871 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
872 mkIntLitInt :: Int -> Expr b
874 mkIntLit n = Lit (mkMachInt n)
875 mkIntLitInt n = Lit (mkMachInt (toInteger n))
877 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
878 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
879 mkWordLit :: Integer -> Expr b
880 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
881 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
882 mkWordLitWord :: Word -> Expr b
884 mkWordLit w = Lit (mkMachWord w)
885 mkWordLitWord w = Lit (mkMachWord (toInteger w))
887 -- | Create a machine character literal expression of type @Char#@.
888 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
889 mkCharLit :: Char -> Expr b
890 -- | Create a machine string literal expression of type @Addr#@.
891 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
892 mkStringLit :: String -> Expr b
894 mkCharLit c = Lit (mkMachChar c)
895 mkStringLit s = Lit (mkMachString s)
897 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
898 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
899 mkFloatLit :: Rational -> Expr b
900 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
901 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
902 mkFloatLitFloat :: Float -> Expr b
904 mkFloatLit f = Lit (mkMachFloat f)
905 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
907 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
908 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
909 mkDoubleLit :: Rational -> Expr b
910 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
911 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
912 mkDoubleLitDouble :: Double -> Expr b
914 mkDoubleLit d = Lit (mkMachDouble d)
915 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
917 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
918 -- use 'CoreUtils.mkCoreLets' if possible
919 mkLets :: [Bind b] -> Expr b -> Expr b
920 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
921 -- use 'CoreUtils.mkCoreLams' if possible
922 mkLams :: [b] -> Expr b -> Expr b
924 mkLams binders body = foldr Lam body binders
925 mkLets binds body = foldr Let body binds
928 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
929 -- this can only be used to bind something in a non-recursive @let@ expression
930 mkTyBind :: TyVar -> Type -> CoreBind
931 mkTyBind tv ty = NonRec tv (Type ty)
933 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
934 varToCoreExpr :: CoreBndr -> Expr b
935 varToCoreExpr v | isId v = Var v
936 | otherwise = Type (mkTyVarTy v)
938 varsToCoreExprs :: [CoreBndr] -> [Expr b]
939 varsToCoreExprs vs = map varToCoreExpr vs
943 %************************************************************************
945 \subsection{Simple access functions}
947 %************************************************************************
950 -- | Extract every variable by this group
951 bindersOf :: Bind b -> [b]
952 bindersOf (NonRec binder _) = [binder]
953 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
955 -- | 'bindersOf' applied to a list of binding groups
956 bindersOfBinds :: [Bind b] -> [b]
957 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
959 rhssOfBind :: Bind b -> [Expr b]
960 rhssOfBind (NonRec _ rhs) = [rhs]
961 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
963 rhssOfAlts :: [Alt b] -> [Expr b]
964 rhssOfAlts alts = [e | (_,_,e) <- alts]
966 -- | Collapse all the bindings in the supplied groups into a single
967 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
968 flattenBinds :: [Bind b] -> [(b, Expr b)]
969 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
970 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
975 -- | We often want to strip off leading lambdas before getting down to
976 -- business. This function is your friend.
977 collectBinders :: Expr b -> ([b], Expr b)
978 -- | Collect as many type bindings as possible from the front of a nested lambda
979 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
980 -- | Collect as many value bindings as possible from the front of a nested lambda
981 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
982 -- | Collect type binders from the front of the lambda first,
983 -- then follow up by collecting as many value bindings as possible
984 -- from the resulting stripped expression
985 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
990 go bs (Lam b e) = go (b:bs) e
991 go bs e = (reverse bs, e)
993 collectTyAndValBinders expr
996 (tvs, body1) = collectTyBinders expr
997 (ids, body) = collectValBinders body1
999 collectTyBinders expr
1002 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
1003 go tvs e = (reverse tvs, e)
1005 collectValBinders expr
1008 go ids (Lam b e) | isId b = go (b:ids) e
1009 go ids body = (reverse ids, body)
1013 -- | Takes a nested application expression and returns the the function
1014 -- being applied and the arguments to which it is applied
1015 collectArgs :: Expr b -> (Expr b, [Arg b])
1019 go (App f a) as = go f (a:as)
1024 -- | Gets the cost centre enclosing an expression, if any.
1025 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1026 coreExprCc :: Expr b -> CostCentre
1027 coreExprCc (Note (SCC cc) _) = cc
1028 coreExprCc (Note _ e) = coreExprCc e
1029 coreExprCc (Lam _ e) = coreExprCc e
1030 coreExprCc _ = noCostCentre
1033 %************************************************************************
1035 \subsection{Predicates}
1037 %************************************************************************
1039 At one time we optionally carried type arguments through to runtime.
1040 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1041 i.e. if type applications are actual lambdas because types are kept around
1042 at runtime. Similarly isRuntimeArg.
1045 -- | Will this variable exist at runtime?
1046 isRuntimeVar :: Var -> Bool
1049 -- | Will this argument expression exist at runtime?
1050 isRuntimeArg :: CoreExpr -> Bool
1051 isRuntimeArg = isValArg
1053 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1054 isValArg :: Expr b -> Bool
1055 isValArg (Type _) = False
1058 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1059 isTypeArg :: Expr b -> Bool
1060 isTypeArg (Type _) = True
1063 -- | The number of binders that bind values rather than types
1064 valBndrCount :: [CoreBndr] -> Int
1065 valBndrCount = count isId
1067 -- | The number of argument expressions that are values rather than types at their top level
1068 valArgCount :: [Arg b] -> Int
1069 valArgCount = count isValArg
1071 notSccNote :: Note -> Bool
1072 notSccNote (SCC {}) = False
1077 %************************************************************************
1079 \subsection{Seq stuff}
1081 %************************************************************************
1084 seqExpr :: CoreExpr -> ()
1085 seqExpr (Var v) = v `seq` ()
1086 seqExpr (Lit lit) = lit `seq` ()
1087 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1088 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1089 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1090 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1091 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1092 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1093 seqExpr (Type t) = seqType t
1095 seqExprs :: [CoreExpr] -> ()
1097 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1099 seqNote :: Note -> ()
1100 seqNote (CoreNote s) = s `seq` ()
1103 seqBndr :: CoreBndr -> ()
1104 seqBndr b = b `seq` ()
1106 seqBndrs :: [CoreBndr] -> ()
1108 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1110 seqBind :: Bind CoreBndr -> ()
1111 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1112 seqBind (Rec prs) = seqPairs prs
1114 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1116 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1118 seqAlts :: [CoreAlt] -> ()
1120 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1122 seqRules :: [CoreRule] -> ()
1124 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1125 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1126 seqRules (BuiltinRule {} : rules) = seqRules rules
1129 %************************************************************************
1131 \subsection{Annotated core}
1133 %************************************************************************
1136 -- | Annotated core: allows annotation at every node in the tree
1137 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1139 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1140 data AnnExpr' bndr annot
1143 | AnnLam bndr (AnnExpr bndr annot)
1144 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1145 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1146 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1147 | AnnCast (AnnExpr bndr annot) Coercion
1148 | AnnNote Note (AnnExpr bndr annot)
1151 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1152 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1154 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1155 data AnnBind bndr annot
1156 = AnnNonRec bndr (AnnExpr bndr annot)
1157 | AnnRec [(bndr, AnnExpr bndr annot)]
1161 -- | Takes a nested application expression and returns the the function
1162 -- being applied and the arguments to which it is applied
1163 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1167 go (_, AnnApp f a) as = go f (a:as)
1172 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1173 deAnnotate (_, e) = deAnnotate' e
1175 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1176 deAnnotate' (AnnType t) = Type t
1177 deAnnotate' (AnnVar v) = Var v
1178 deAnnotate' (AnnLit lit) = Lit lit
1179 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1180 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1181 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1182 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1184 deAnnotate' (AnnLet bind body)
1185 = Let (deAnnBind bind) (deAnnotate body)
1187 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1188 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1190 deAnnotate' (AnnCase scrut v t alts)
1191 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1193 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1194 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1198 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1199 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1203 collect bs (_, AnnLam b body) = collect (b:bs) body
1204 collect bs body = (reverse bs, body)