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 -- Do not replace uf_tmpl; instead, keep it unchanged
487 -- See Note [InlineRules]
489 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
490 -- Only a few primop-like things have this property
491 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
492 -- Inline absolutely always, however boring the context.
494 | InlineWrapper Id -- This unfolding is a the wrapper in a
495 -- worker/wrapper split from the strictness analyser
496 -- The Id is the worker-id
497 -- Used to abbreviate the uf_tmpl in interface files
498 -- which don't need to contain the RHS;
499 -- it can be derived from the strictness info
503 -- | 'UnfoldingGuidance' says when unfolding should take place
504 data UnfoldingGuidance
505 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
506 -- Used (a) for small *and* cheap unfoldings
507 -- (b) for INLINE functions
508 -- See Note [INLINE for small functions] in CoreUnfold
509 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
510 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
511 -- So True,True means "always"
514 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
515 -- result of a simple analysis of the RHS
517 ug_args :: [Int], -- Discount if the argument is evaluated.
518 -- (i.e., a simplification will definitely
519 -- be possible). One elt of the list per *value* arg.
521 ug_size :: Int, -- The "size" of the unfolding.
523 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
524 } -- a context (case (thing args) of ...),
525 -- (where there are the right number of arguments.)
527 | UnfNever -- The RHS is big, so don't inline it
531 Note [DFun unfoldings]
532 ~~~~~~~~~~~~~~~~~~~~~~
533 The Arity in a DFunUnfolding is total number of args (type and value)
534 that the DFun needs to produce a dictionary. That's not necessarily
535 related to the ordinary arity of the dfun Id, esp if the class has
536 one method, so the dictionary is represented by a newtype. Example
538 class C a where { op :: a -> Int }
539 instance C a -> C [a] where op xs = op (head xs)
541 The instance translates to
543 $dfCList :: forall a. C a => C [a] -- Arity 2!
544 $dfCList = /\a.\d. $copList {a} d |> co
546 $copList :: forall a. C a => [a] -> Int -- Arity 2!
547 $copList = /\a.\d.\xs. op {a} d (head xs)
549 Now we might encounter (op (dfCList {ty} d) a1 a2)
550 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
551 has all its arguments, even though its (value) arity is 2. That's
552 why we record the number of expected arguments in the DFunUnfolding.
554 Note that although it's an Arity, it's most convenient for it to give
555 the *total* number of arguments, both type and value. See the use
556 site in exprIsConApp_maybe.
559 -- Constants for the UnfWhen constructor
560 needSaturated, unSaturatedOk :: Bool
561 needSaturated = False
564 boringCxtNotOk, boringCxtOk :: Bool
566 boringCxtNotOk = False
568 ------------------------------------------------
569 noUnfolding :: Unfolding
570 -- ^ There is no known 'Unfolding'
571 evaldUnfolding :: Unfolding
572 -- ^ This unfolding marks the associated thing as being evaluated
574 noUnfolding = NoUnfolding
575 evaldUnfolding = OtherCon []
577 mkOtherCon :: [AltCon] -> Unfolding
578 mkOtherCon = OtherCon
580 seqUnfolding :: Unfolding -> ()
581 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
582 uf_is_value = b1, uf_is_cheap = b2,
583 uf_expandable = b3, uf_is_conlike = b4,
584 uf_arity = a, uf_guidance = g})
585 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
589 seqGuidance :: UnfoldingGuidance -> ()
590 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
595 isStableSource :: UnfoldingSource -> Bool
596 -- Keep the unfolding template
597 isStableSource InlineCompulsory = True
598 isStableSource InlineStable = True
599 isStableSource (InlineWrapper {}) = True
600 isStableSource InlineRhs = False
602 -- | Retrieves the template of an unfolding: panics if none is known
603 unfoldingTemplate :: Unfolding -> CoreExpr
604 unfoldingTemplate = uf_tmpl
606 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
607 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
609 -- | Retrieves the template of an unfolding if possible
610 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
611 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
612 maybeUnfoldingTemplate _ = Nothing
614 -- | The constructors that the unfolding could never be:
615 -- returns @[]@ if no information is available
616 otherCons :: Unfolding -> [AltCon]
617 otherCons (OtherCon cons) = cons
620 -- | Determines if it is certainly the case that the unfolding will
621 -- yield a value (something in HNF): returns @False@ if unsure
622 isValueUnfolding :: Unfolding -> Bool
623 -- Returns False for OtherCon
624 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
625 isValueUnfolding _ = False
627 -- | Determines if it possibly the case that the unfolding will
628 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
630 isEvaldUnfolding :: Unfolding -> Bool
631 -- Returns True for OtherCon
632 isEvaldUnfolding (OtherCon _) = True
633 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
634 isEvaldUnfolding _ = False
636 -- | @True@ if the unfolding is a constructor application, the application
637 -- of a CONLIKE function or 'OtherCon'
638 isConLikeUnfolding :: Unfolding -> Bool
639 isConLikeUnfolding (OtherCon _) = True
640 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
641 isConLikeUnfolding _ = False
643 -- | Is the thing we will unfold into certainly cheap?
644 isCheapUnfolding :: Unfolding -> Bool
645 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
646 isCheapUnfolding _ = False
648 isExpandableUnfolding :: Unfolding -> Bool
649 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
650 isExpandableUnfolding _ = False
652 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
653 -- Expand an expandable unfolding; this is used in rule matching
654 -- See Note [Expanding variables] in Rules.lhs
655 -- The key point here is that CONLIKE things can be expanded
656 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
657 expandUnfolding_maybe _ = Nothing
659 isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
660 isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
662 = Just (src, unsat_ok)
664 unsat_ok = case guide of
665 UnfWhen unsat_ok _ -> unsat_ok
667 isStableUnfolding_maybe _ = Nothing
669 isCompulsoryUnfolding :: Unfolding -> Bool
670 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
671 isCompulsoryUnfolding _ = False
673 isStableUnfolding :: Unfolding -> Bool
674 -- True of unfoldings that should not be overwritten
675 -- by a CoreUnfolding for the RHS of a let-binding
676 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
677 isStableUnfolding (DFunUnfolding {}) = True
678 isStableUnfolding _ = False
680 unfoldingArity :: Unfolding -> Arity
681 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
682 unfoldingArity _ = panic "unfoldingArity"
684 isClosedUnfolding :: Unfolding -> Bool -- No free variables
685 isClosedUnfolding (CoreUnfolding {}) = False
686 isClosedUnfolding (DFunUnfolding {}) = False
687 isClosedUnfolding _ = True
689 -- | Only returns False if there is no unfolding information available at all
690 hasSomeUnfolding :: Unfolding -> Bool
691 hasSomeUnfolding NoUnfolding = False
692 hasSomeUnfolding _ = True
694 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
695 neverUnfoldGuidance UnfNever = True
696 neverUnfoldGuidance _ = False
698 canUnfold :: Unfolding -> Bool
699 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
708 you intend that calls (f e) are replaced by <rhs>[e/x] So we
709 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
710 with it. Meanwhile, we can optimise <rhs> to our heart's content,
711 leaving the original unfolding intact in Unfolding of 'f'. For example
712 all xs = foldr (&&) True xs
713 any p = all . map p {-# INLINE any #-}
714 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
715 which deforests well at the call site.
717 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
719 Moreover, it's only used when 'f' is applied to the
720 specified number of arguments; that is, the number of argument on
721 the LHS of the '=' sign in the original source definition.
722 For example, (.) is now defined in the libraries like this
724 (.) f g = \x -> f (g x)
725 so that it'll inline when applied to two arguments. If 'x' appeared
728 it'd only inline when applied to three arguments. This slightly-experimental
729 change was requested by Roman, but it seems to make sense.
731 See also Note [Inlining an InlineRule] in CoreUnfold.
734 Note [OccInfo in unfoldings and rules]
735 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
736 In unfoldings and rules, we guarantee that the template is occ-analysed,
737 so that the occurence info on the binders is correct. This is important,
738 because the Simplifier does not re-analyse the template when using it. If
739 the occurrence info is wrong
740 - We may get more simpifier iterations than necessary, because
741 once-occ info isn't there
742 - More seriously, we may get an infinite loop if there's a Rec
743 without a loop breaker marked
746 %************************************************************************
748 \subsection{The main data type}
750 %************************************************************************
753 -- The Ord is needed for the FiniteMap used in the lookForConstructor
754 -- in SimplEnv. If you declared that lookForConstructor *ignores*
755 -- constructor-applications with LitArg args, then you could get
758 instance Outputable AltCon where
759 ppr (DataAlt dc) = ppr dc
760 ppr (LitAlt lit) = ppr lit
761 ppr DEFAULT = ptext (sLit "__DEFAULT")
763 instance Show AltCon where
764 showsPrec p con = showsPrecSDoc p (ppr con)
766 cmpAlt :: Alt b -> Alt b -> Ordering
767 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
769 ltAlt :: Alt b -> Alt b -> Bool
770 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
772 cmpAltCon :: AltCon -> AltCon -> Ordering
773 -- ^ Compares 'AltCon's within a single list of alternatives
774 cmpAltCon DEFAULT DEFAULT = EQ
775 cmpAltCon DEFAULT _ = LT
777 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
778 cmpAltCon (DataAlt _) DEFAULT = GT
779 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
780 cmpAltCon (LitAlt _) DEFAULT = GT
782 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
783 ppr con1 <+> ppr con2 )
787 %************************************************************************
789 \subsection{Useful synonyms}
791 %************************************************************************
794 -- | The common case for the type of binders and variables when
795 -- we are manipulating the Core language within GHC
797 -- | Expressions where binders are 'CoreBndr's
798 type CoreExpr = Expr CoreBndr
799 -- | Argument expressions where binders are 'CoreBndr's
800 type CoreArg = Arg CoreBndr
801 -- | Binding groups where binders are 'CoreBndr's
802 type CoreBind = Bind CoreBndr
803 -- | Case alternatives where binders are 'CoreBndr's
804 type CoreAlt = Alt CoreBndr
807 %************************************************************************
811 %************************************************************************
814 -- | Binders are /tagged/ with a t
815 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
817 type TaggedBind t = Bind (TaggedBndr t)
818 type TaggedExpr t = Expr (TaggedBndr t)
819 type TaggedArg t = Arg (TaggedBndr t)
820 type TaggedAlt t = Alt (TaggedBndr t)
822 instance Outputable b => Outputable (TaggedBndr b) where
823 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
825 instance Outputable b => OutputableBndr (TaggedBndr b) where
826 pprBndr _ b = ppr b -- Simple
830 %************************************************************************
832 \subsection{Core-constructing functions with checking}
834 %************************************************************************
837 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
838 -- use 'CoreUtils.mkCoreApps' if possible
839 mkApps :: Expr b -> [Arg b] -> Expr b
840 -- | Apply a list of type argument expressions to a function expression in a nested fashion
841 mkTyApps :: Expr b -> [Type] -> Expr b
842 -- | Apply a list of type or value variables to a function expression in a nested fashion
843 mkVarApps :: Expr b -> [Var] -> Expr b
844 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
845 -- use 'MkCore.mkCoreConApps' if possible
846 mkConApp :: DataCon -> [Arg b] -> Expr b
848 mkApps f args = foldl App f args
849 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
850 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
851 mkConApp con args = mkApps (Var (dataConWorkId con)) args
854 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
855 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
856 mkIntLit :: Integer -> Expr b
857 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
858 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
859 mkIntLitInt :: Int -> Expr b
861 mkIntLit n = Lit (mkMachInt n)
862 mkIntLitInt n = Lit (mkMachInt (toInteger n))
864 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
865 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
866 mkWordLit :: Integer -> Expr b
867 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
868 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
869 mkWordLitWord :: Word -> Expr b
871 mkWordLit w = Lit (mkMachWord w)
872 mkWordLitWord w = Lit (mkMachWord (toInteger w))
874 -- | Create a machine character literal expression of type @Char#@.
875 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
876 mkCharLit :: Char -> Expr b
877 -- | Create a machine string literal expression of type @Addr#@.
878 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
879 mkStringLit :: String -> Expr b
881 mkCharLit c = Lit (mkMachChar c)
882 mkStringLit s = Lit (mkMachString s)
884 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
885 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
886 mkFloatLit :: Rational -> Expr b
887 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
888 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
889 mkFloatLitFloat :: Float -> Expr b
891 mkFloatLit f = Lit (mkMachFloat f)
892 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
894 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
895 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
896 mkDoubleLit :: Rational -> Expr b
897 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
898 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
899 mkDoubleLitDouble :: Double -> Expr b
901 mkDoubleLit d = Lit (mkMachDouble d)
902 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
904 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
905 -- use 'CoreUtils.mkCoreLets' if possible
906 mkLets :: [Bind b] -> Expr b -> Expr b
907 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
908 -- use 'CoreUtils.mkCoreLams' if possible
909 mkLams :: [b] -> Expr b -> Expr b
911 mkLams binders body = foldr Lam body binders
912 mkLets binds body = foldr Let body binds
915 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
916 -- this can only be used to bind something in a non-recursive @let@ expression
917 mkTyBind :: TyVar -> Type -> CoreBind
918 mkTyBind tv ty = NonRec tv (Type ty)
920 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
921 varToCoreExpr :: CoreBndr -> Expr b
922 varToCoreExpr v | isId v = Var v
923 | otherwise = Type (mkTyVarTy v)
925 varsToCoreExprs :: [CoreBndr] -> [Expr b]
926 varsToCoreExprs vs = map varToCoreExpr vs
930 %************************************************************************
932 \subsection{Simple access functions}
934 %************************************************************************
937 -- | Extract every variable by this group
938 bindersOf :: Bind b -> [b]
939 bindersOf (NonRec binder _) = [binder]
940 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
942 -- | 'bindersOf' applied to a list of binding groups
943 bindersOfBinds :: [Bind b] -> [b]
944 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
946 rhssOfBind :: Bind b -> [Expr b]
947 rhssOfBind (NonRec _ rhs) = [rhs]
948 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
950 rhssOfAlts :: [Alt b] -> [Expr b]
951 rhssOfAlts alts = [e | (_,_,e) <- alts]
953 -- | Collapse all the bindings in the supplied groups into a single
954 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
955 flattenBinds :: [Bind b] -> [(b, Expr b)]
956 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
957 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
962 -- | We often want to strip off leading lambdas before getting down to
963 -- business. This function is your friend.
964 collectBinders :: Expr b -> ([b], Expr b)
965 -- | Collect as many type bindings as possible from the front of a nested lambda
966 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
967 -- | Collect as many value bindings as possible from the front of a nested lambda
968 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
969 -- | Collect type binders from the front of the lambda first,
970 -- then follow up by collecting as many value bindings as possible
971 -- from the resulting stripped expression
972 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
977 go bs (Lam b e) = go (b:bs) e
978 go bs e = (reverse bs, e)
980 collectTyAndValBinders expr
983 (tvs, body1) = collectTyBinders expr
984 (ids, body) = collectValBinders body1
986 collectTyBinders expr
989 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
990 go tvs e = (reverse tvs, e)
992 collectValBinders expr
995 go ids (Lam b e) | isId b = go (b:ids) e
996 go ids body = (reverse ids, body)
1000 -- | Takes a nested application expression and returns the the function
1001 -- being applied and the arguments to which it is applied
1002 collectArgs :: Expr b -> (Expr b, [Arg b])
1006 go (App f a) as = go f (a:as)
1011 -- | Gets the cost centre enclosing an expression, if any.
1012 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1013 coreExprCc :: Expr b -> CostCentre
1014 coreExprCc (Note (SCC cc) _) = cc
1015 coreExprCc (Note _ e) = coreExprCc e
1016 coreExprCc (Lam _ e) = coreExprCc e
1017 coreExprCc _ = noCostCentre
1020 %************************************************************************
1022 \subsection{Predicates}
1024 %************************************************************************
1026 At one time we optionally carried type arguments through to runtime.
1027 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1028 i.e. if type applications are actual lambdas because types are kept around
1029 at runtime. Similarly isRuntimeArg.
1032 -- | Will this variable exist at runtime?
1033 isRuntimeVar :: Var -> Bool
1036 -- | Will this argument expression exist at runtime?
1037 isRuntimeArg :: CoreExpr -> Bool
1038 isRuntimeArg = isValArg
1040 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1041 isValArg :: Expr b -> Bool
1042 isValArg (Type _) = False
1045 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1046 isTypeArg :: Expr b -> Bool
1047 isTypeArg (Type _) = True
1050 -- | The number of binders that bind values rather than types
1051 valBndrCount :: [CoreBndr] -> Int
1052 valBndrCount = count isId
1054 -- | The number of argument expressions that are values rather than types at their top level
1055 valArgCount :: [Arg b] -> Int
1056 valArgCount = count isValArg
1058 notSccNote :: Note -> Bool
1059 notSccNote (SCC {}) = False
1064 %************************************************************************
1066 \subsection{Seq stuff}
1068 %************************************************************************
1071 seqExpr :: CoreExpr -> ()
1072 seqExpr (Var v) = v `seq` ()
1073 seqExpr (Lit lit) = lit `seq` ()
1074 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1075 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1076 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1077 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1078 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1079 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1080 seqExpr (Type t) = seqType t
1082 seqExprs :: [CoreExpr] -> ()
1084 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1086 seqNote :: Note -> ()
1087 seqNote (CoreNote s) = s `seq` ()
1090 seqBndr :: CoreBndr -> ()
1091 seqBndr b = b `seq` ()
1093 seqBndrs :: [CoreBndr] -> ()
1095 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1097 seqBind :: Bind CoreBndr -> ()
1098 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1099 seqBind (Rec prs) = seqPairs prs
1101 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1103 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1105 seqAlts :: [CoreAlt] -> ()
1107 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1109 seqRules :: [CoreRule] -> ()
1111 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1112 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1113 seqRules (BuiltinRule {} : rules) = seqRules rules
1116 %************************************************************************
1118 \subsection{Annotated core}
1120 %************************************************************************
1123 -- | Annotated core: allows annotation at every node in the tree
1124 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1126 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1127 data AnnExpr' bndr annot
1130 | AnnLam bndr (AnnExpr bndr annot)
1131 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1132 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1133 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1134 | AnnCast (AnnExpr bndr annot) Coercion
1135 | AnnNote Note (AnnExpr bndr annot)
1138 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1139 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1141 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1142 data AnnBind bndr annot
1143 = AnnNonRec bndr (AnnExpr bndr annot)
1144 | AnnRec [(bndr, AnnExpr bndr annot)]
1148 -- | Takes a nested application expression and returns the the function
1149 -- being applied and the arguments to which it is applied
1150 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1154 go (_, AnnApp f a) as = go f (a:as)
1159 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1160 deAnnotate (_, e) = deAnnotate' e
1162 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1163 deAnnotate' (AnnType t) = Type t
1164 deAnnotate' (AnnVar v) = Var v
1165 deAnnotate' (AnnLit lit) = Lit lit
1166 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1167 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1168 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1169 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1171 deAnnotate' (AnnLet bind body)
1172 = Let (deAnnBind bind) (deAnnotate body)
1174 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1175 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1177 deAnnotate' (AnnCase scrut v t alts)
1178 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1180 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1181 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1185 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1186 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1190 collect bs (_, AnnLam b body) = collect (b:bs) body
1191 collect bs body = (reverse bs, body)