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 isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
31 -- ** Simple 'Expr' access functions and predicates
32 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
33 collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
34 collectArgs, coreExprCc, flattenBinds,
36 isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
38 -- * Unfolding data types
39 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
40 -- Abstract everywhere but in CoreUnfold.lhs
42 -- ** Constructing 'Unfolding's
43 noUnfolding, evaldUnfolding, mkOtherCon,
44 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
46 -- ** Predicates and deconstruction on 'Unfolding'
47 unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
48 maybeUnfoldingTemplate, otherCons, unfoldingArity,
49 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
50 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
51 isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding,
52 isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource,
55 seqExpr, seqExprs, seqUnfolding,
57 -- * Annotated expression data types
58 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
60 -- ** Operations on annotations
61 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
63 -- * Core rule data types
64 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
65 RuleName, IdUnfoldingFun,
67 -- ** Operations on 'CoreRule's
68 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
70 isBuiltinRule, isLocalRule
73 #include "HsVersions.h"
90 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
91 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
94 %************************************************************************
96 \subsection{The main data types}
98 %************************************************************************
100 These data types are the heart of the compiler
103 infixl 8 `App` -- App brackets to the left
105 -- | This is the data type that represents GHCs core intermediate language. Currently
106 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
107 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
109 -- We get from Haskell source to this Core language in a number of stages:
111 -- 1. The source code is parsed into an abstract syntax tree, which is represented
112 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
114 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
115 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
116 -- For example, this program:
119 -- f x = let f x = x + 1
123 -- Would be renamed by having 'Unique's attached so it looked something like this:
126 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
130 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
131 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
133 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
134 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
135 -- optimization, analysis and code generation on.
137 -- The type parameter @b@ is for the type of binders in the expression tree.
139 = Var Id -- ^ Variables
140 | Lit Literal -- ^ Primitive literals
141 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
143 -- See "CoreSyn#let_app_invariant" for another invariant
144 | Lam b (Expr b) -- ^ Lambda abstraction
145 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
146 -- this corresponds to allocating a thunk for the things
147 -- bound and then executing the sub-expression.
149 -- #top_level_invariant#
150 -- #letrec_invariant#
152 -- The right hand sides of all top-level and recursive @let@s
153 -- /must/ be of lifted type (see "Type#type_classification" for
154 -- the meaning of /lifted/ vs. /unlifted/).
156 -- #let_app_invariant#
157 -- The right hand side of of a non-recursive 'Let' _and_ the argument of an 'App',
158 -- /may/ be of unlifted type, but only if the expression
159 -- is ok-for-speculation. This means that the let can be floated around
160 -- without difficulty. For example, this is OK:
162 -- > y::Int# = x +# 1#
164 -- But this is not, as it may affect termination if the expression is floated out:
166 -- > y::Int# = fac 4#
168 -- In this situation you should use @case@ rather than a @let@. The function
169 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
170 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
171 -- which will generate a @case@ if necessary
174 -- We allow a /non-recursive/ let to bind a type variable, thus:
176 -- > Let (NonRec tv (Type ty)) body
178 -- This can be very convenient for postponing type substitutions until
179 -- the next run of the simplifier.
181 -- At the moment, the rest of the compiler only deals with type-let
182 -- in a Let expression, rather than at top level. We may want to revist
184 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
185 -- the scrutinee (expression examined) to weak head normal form
186 -- and then examining at most one level of resulting constructor (i.e. you
187 -- cannot do nested pattern matching directly with this).
189 -- The binder gets bound to the value of the scrutinee,
190 -- and the 'Type' must be that of all the case alternatives
193 -- This is one of the more complicated elements of the Core language, and comes
194 -- with a number of restrictions:
196 -- The 'DEFAULT' case alternative must be first in the list, if it occurs at all.
198 -- The remaining cases are in order of increasing
199 -- tag (for 'DataAlts') or
200 -- lit (for 'LitAlts').
201 -- This makes finding the relevant constructor easy, and makes comparison easier too.
203 -- The list of alternatives must be exhaustive. An /exhaustive/ case
204 -- does not necessarily mention all constructors:
207 -- data Foo = Red | Green | Blue
210 -- other -> f (case x of
215 -- The inner case does not need a @Red@ alternative, because @x@ can't be @Red@ at
216 -- that program point.
217 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type. This is used to implement @newtype@s
218 -- (a @newtype@ constructor or destructor just becomes a 'Cast' in Core) and GADTs.
219 | Note Note (Expr b) -- ^ Notes. These allow general information to be
220 -- added to expressions in the syntax tree
221 | Type Type -- ^ A type: this should only show up at the top
223 deriving (Data, Typeable)
225 -- | Type synonym for expressions that occur in function argument positions.
226 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
229 -- | A case split alternative. Consists of the constructor leading to the alternative,
230 -- the variables bound from the constructor, and the expression to be executed given that binding.
231 -- The default alternative is @(DEFAULT, [], rhs)@
232 type Alt b = (AltCon, [b], Expr b)
234 -- | A case alternative constructor (i.e. pattern match)
235 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
236 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
237 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
238 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
239 deriving (Eq, Ord, Data, Typeable)
241 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
242 data Bind b = NonRec b (Expr b)
243 | Rec [(b, (Expr b))]
244 deriving (Data, Typeable)
247 -------------------------- CoreSyn INVARIANTS ---------------------------
249 Note [CoreSyn top-level invariant]
250 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
251 See #toplevel_invariant#
253 Note [CoreSyn letrec invariant]
254 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
255 See #letrec_invariant#
257 Note [CoreSyn let/app invariant]
258 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
259 See #let_app_invariant#
261 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
263 Note [CoreSyn case invariants]
264 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
265 See #case_invariants#
267 Note [CoreSyn let goal]
268 ~~~~~~~~~~~~~~~~~~~~~~~
269 * The simplifier tries to ensure that if the RHS of a let is a constructor
270 application, its arguments are trivial, so that the constructor can be
280 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
282 = SCC CostCentre -- ^ A cost centre annotation for profiling
283 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
284 deriving (Data, Typeable)
288 %************************************************************************
290 \subsection{Transformation rules}
292 %************************************************************************
294 The CoreRule type and its friends are dealt with mainly in CoreRules,
295 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
298 -- | A 'CoreRule' is:
300 -- * \"Local\" if the function it is a rule for is defined in the
301 -- same module as the rule itself.
303 -- * \"Orphan\" if nothing on the LHS is defined in the same module
304 -- as the rule itself
307 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
308 ru_act :: Activation, -- ^ When the rule is active
310 -- Rough-matching stuff
311 -- see comments with InstEnv.Instance( is_cls, is_rough )
312 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
313 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
315 -- Proper-matching stuff
316 -- see comments with InstEnv.Instance( is_tvs, is_tys )
317 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
318 ru_args :: [CoreExpr], -- ^ Left hand side arguments
320 -- And the right-hand side
321 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
322 -- Occurrence info is guaranteed correct
323 -- See Note [OccInfo in unfoldings and rules]
326 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
327 -- defined in the same module as the rule
328 -- and is not an implicit 'Id' (like a record selector,
329 -- class operation, or data constructor)
331 -- NB: ru_local is *not* used to decide orphan-hood
332 -- c.g. MkIface.coreRuleToIfaceRule
335 -- | Built-in rules are used for constant folding
336 -- and suchlike. They have no free variables.
338 ru_name :: RuleName, -- ^ As above
339 ru_fn :: Name, -- ^ As above
340 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
341 -- if it fires, including type arguments
342 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
343 -- ^ This function does the rewrite. It given too many
344 -- arguments, it simply discards them; the returned 'CoreExpr'
345 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
347 -- See Note [Extra args in rule matching] in Rules.lhs
349 type IdUnfoldingFun = Id -> Unfolding
350 -- A function that embodies how to unfold an Id if you need
351 -- to do that in the Rule. The reason we need to pass this info in
352 -- is that whether an Id is unfoldable depends on the simplifier phase
354 isBuiltinRule :: CoreRule -> Bool
355 isBuiltinRule (BuiltinRule {}) = True
356 isBuiltinRule _ = False
358 -- | The number of arguments the 'ru_fn' must be applied
359 -- to before the rule can match on it
360 ruleArity :: CoreRule -> Int
361 ruleArity (BuiltinRule {ru_nargs = n}) = n
362 ruleArity (Rule {ru_args = args}) = length args
364 ruleName :: CoreRule -> RuleName
367 ruleActivation_maybe :: CoreRule -> Maybe Activation
368 ruleActivation_maybe (BuiltinRule { }) = Nothing
369 ruleActivation_maybe (Rule { ru_act = act }) = Just act
371 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
372 ruleIdName :: CoreRule -> Name
375 isLocalRule :: CoreRule -> Bool
376 isLocalRule = ru_local
378 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
379 setRuleIdName :: Name -> CoreRule -> CoreRule
380 setRuleIdName nm ru = ru { ru_fn = nm }
384 %************************************************************************
388 %************************************************************************
390 The @Unfolding@ type is declared here to avoid numerous loops
393 -- | Records the /unfolding/ of an identifier, which is approximately the form the
394 -- identifier would have if we substituted its definition in for the identifier.
395 -- This type should be treated as abstract everywhere except in "CoreUnfold"
397 = NoUnfolding -- ^ We have no information about the unfolding
399 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
400 -- @OtherCon xs@ also indicates that something has been evaluated
401 -- and hence there's no point in re-evaluating it.
402 -- @OtherCon []@ is used even for non-data-type values
403 -- to indicated evaluated-ness. Notably:
405 -- > data C = C !(Int -> Int)
406 -- > case x of { C f -> ... }
408 -- Here, @f@ gets an @OtherCon []@ unfolding.
410 | DFunUnfolding DataCon [CoreExpr]
411 -- The Unfolding of a DFunId
412 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
413 -- (op2 a1..am d1..dn)
414 -- where Arity = n, the number of dict args to the dfun
415 -- The [CoreExpr] are the superclasses and methods [op1,op2],
416 -- in positional order.
417 -- They are usually variables, but can be trivial expressions
418 -- instead (e.g. a type application).
420 | CoreUnfolding { -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
421 -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
422 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
423 uf_src :: UnfoldingSource, -- Where the unfolding came from
424 uf_is_top :: Bool, -- True <=> top level binding
425 uf_arity :: Arity, -- Number of value arguments expected
426 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard a `seq` on
428 uf_is_conlike :: Bool, -- True <=> application of constructor or CONLIKE function
429 -- Cached version of exprIsConLike
430 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining
431 -- Cached version of exprIsCheap
432 uf_expandable :: Bool, -- True <=> can expand in RULE matching
433 -- Cached version of exprIsExpandable
434 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
436 -- ^ An unfolding with redundant cached information. Parameters:
438 -- uf_tmpl: Template used to perform unfolding;
439 -- NB: Occurrence info is guaranteed correct:
440 -- see Note [OccInfo in unfoldings and rules]
442 -- uf_is_top: Is this a top level binding?
444 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
447 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
448 -- Basically this is a cached version of 'exprIsCheap'
450 -- uf_guidance: Tells us about the /size/ of the unfolding template
452 ------------------------------------------------
454 = InlineCompulsory -- Something that *has* no binding, so you *must* inline it
455 -- Only a few primop-like things have this property
456 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
457 -- Inline absolutely always, however boring the context.
459 | InlineRule -- From an {-# INLINE #-} pragma; See Note [InlineRules]
461 | InlineWrapper Id -- This unfolding is a the wrapper in a
462 -- worker/wrapper split from the strictness analyser
463 -- The Id is the worker-id
464 -- Used to abbreviate the uf_tmpl in interface files
465 -- which don't need to contain the RHS;
466 -- it can be derived from the strictness info
468 | InlineRhs -- The current rhs of the function
470 -- For InlineRhs, the uf_tmpl is replaced each time around
471 -- For all the others we leave uf_tmpl alone
474 -- | 'UnfoldingGuidance' says when unfolding should take place
475 data UnfoldingGuidance
476 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
477 -- Used (a) for small *and* cheap unfoldings
478 -- (b) for INLINE functions
479 -- See Note [INLINE for small functions] in CoreUnfold
480 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
481 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
482 -- So True,True means "always"
485 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
486 -- result of a simple analysis of the RHS
488 ug_args :: [Int], -- Discount if the argument is evaluated.
489 -- (i.e., a simplification will definitely
490 -- be possible). One elt of the list per *value* arg.
492 ug_size :: Int, -- The "size" of the unfolding.
494 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
495 } -- a context (case (thing args) of ...),
496 -- (where there are the right number of arguments.)
498 | UnfNever -- The RHS is big, so don't inline it
500 -- Constants for the UnfWhen constructor
501 needSaturated, unSaturatedOk :: Bool
502 needSaturated = False
505 boringCxtNotOk, boringCxtOk :: Bool
507 boringCxtNotOk = False
509 ------------------------------------------------
510 noUnfolding :: Unfolding
511 -- ^ There is no known 'Unfolding'
512 evaldUnfolding :: Unfolding
513 -- ^ This unfolding marks the associated thing as being evaluated
515 noUnfolding = NoUnfolding
516 evaldUnfolding = OtherCon []
518 mkOtherCon :: [AltCon] -> Unfolding
519 mkOtherCon = OtherCon
521 seqUnfolding :: Unfolding -> ()
522 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
523 uf_is_value = b1, uf_is_cheap = b2,
524 uf_expandable = b3, uf_is_conlike = b4,
525 uf_arity = a, uf_guidance = g})
526 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
530 seqGuidance :: UnfoldingGuidance -> ()
531 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
536 isInlineRuleSource :: UnfoldingSource -> Bool
537 isInlineRuleSource InlineCompulsory = True
538 isInlineRuleSource InlineRule = True
539 isInlineRuleSource (InlineWrapper {}) = True
540 isInlineRuleSource InlineRhs = False
542 -- | Retrieves the template of an unfolding: panics if none is known
543 unfoldingTemplate :: Unfolding -> CoreExpr
544 unfoldingTemplate = uf_tmpl
546 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
547 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
549 -- | Retrieves the template of an unfolding if possible
550 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
551 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
552 maybeUnfoldingTemplate _ = Nothing
554 -- | The constructors that the unfolding could never be:
555 -- returns @[]@ if no information is available
556 otherCons :: Unfolding -> [AltCon]
557 otherCons (OtherCon cons) = cons
560 -- | Determines if it is certainly the case that the unfolding will
561 -- yield a value (something in HNF): returns @False@ if unsure
562 isValueUnfolding :: Unfolding -> Bool
563 -- Returns False for OtherCon
564 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
565 isValueUnfolding _ = False
567 -- | Determines if it possibly the case that the unfolding will
568 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
570 isEvaldUnfolding :: Unfolding -> Bool
571 -- Returns True for OtherCon
572 isEvaldUnfolding (OtherCon _) = True
573 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
574 isEvaldUnfolding _ = False
576 -- | @True@ if the unfolding is a constructor application, the application
577 -- of a CONLIKE function or 'OtherCon'
578 isConLikeUnfolding :: Unfolding -> Bool
579 isConLikeUnfolding (OtherCon _) = True
580 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
581 isConLikeUnfolding _ = False
583 -- | Is the thing we will unfold into certainly cheap?
584 isCheapUnfolding :: Unfolding -> Bool
585 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
586 isCheapUnfolding _ = False
588 isExpandableUnfolding :: Unfolding -> Bool
589 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
590 isExpandableUnfolding _ = False
592 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
593 -- Expand an expandable unfolding; this is used in rule matching
594 -- See Note [Expanding variables] in Rules.lhs
595 -- The key point here is that CONLIKE things can be expanded
596 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
597 expandUnfolding_maybe _ = Nothing
599 isInlineRule :: Unfolding -> Bool
600 isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
601 isInlineRule _ = False
603 isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
604 isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
605 | isInlineRuleSource src
606 = Just (src, unsat_ok)
608 unsat_ok = case guide of
609 UnfWhen unsat_ok _ -> unsat_ok
611 isInlineRule_maybe _ = Nothing
613 isCompulsoryUnfolding :: Unfolding -> Bool
614 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
615 isCompulsoryUnfolding _ = False
617 isStableUnfolding :: Unfolding -> Bool
618 -- True of unfoldings that should not be overwritten
619 -- by a CoreUnfolding for the RHS of a let-binding
620 isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
621 isStableUnfolding (DFunUnfolding {}) = True
622 isStableUnfolding _ = False
624 unfoldingArity :: Unfolding -> Arity
625 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
626 unfoldingArity _ = panic "unfoldingArity"
628 isClosedUnfolding :: Unfolding -> Bool -- No free variables
629 isClosedUnfolding (CoreUnfolding {}) = False
630 isClosedUnfolding (DFunUnfolding {}) = False
631 isClosedUnfolding _ = True
633 -- | Only returns False if there is no unfolding information available at all
634 hasSomeUnfolding :: Unfolding -> Bool
635 hasSomeUnfolding NoUnfolding = False
636 hasSomeUnfolding _ = True
638 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
639 neverUnfoldGuidance UnfNever = True
640 neverUnfoldGuidance _ = False
642 canUnfold :: Unfolding -> Bool
643 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
652 you intend that calls (f e) are replaced by <rhs>[e/x] So we
653 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
654 with it. Meanwhile, we can optimise <rhs> to our heart's content,
655 leaving the original unfolding intact in Unfolding of 'f'. For example
656 all xs = foldr (&&) True xs
657 any p = all . map p {-# INLINE any #-}
658 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
659 which deforests well at the call site.
661 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
663 Moreover, it's only used when 'f' is applied to the
664 specified number of arguments; that is, the number of argument on
665 the LHS of the '=' sign in the original source definition.
666 For example, (.) is now defined in the libraries like this
668 (.) f g = \x -> f (g x)
669 so that it'll inline when applied to two arguments. If 'x' appeared
672 it'd only inline when applied to three arguments. This slightly-experimental
673 change was requested by Roman, but it seems to make sense.
675 See also Note [Inlining an InlineRule] in CoreUnfold.
678 Note [OccInfo in unfoldings and rules]
679 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
680 In unfoldings and rules, we guarantee that the template is occ-analysed,
681 so that the occurence info on the binders is correct. This is important,
682 because the Simplifier does not re-analyse the template when using it. If
683 the occurrence info is wrong
684 - We may get more simpifier iterations than necessary, because
685 once-occ info isn't there
686 - More seriously, we may get an infinite loop if there's a Rec
687 without a loop breaker marked
690 %************************************************************************
692 \subsection{The main data type}
694 %************************************************************************
697 -- The Ord is needed for the FiniteMap used in the lookForConstructor
698 -- in SimplEnv. If you declared that lookForConstructor *ignores*
699 -- constructor-applications with LitArg args, then you could get
702 instance Outputable AltCon where
703 ppr (DataAlt dc) = ppr dc
704 ppr (LitAlt lit) = ppr lit
705 ppr DEFAULT = ptext (sLit "__DEFAULT")
707 instance Show AltCon where
708 showsPrec p con = showsPrecSDoc p (ppr con)
710 cmpAlt :: Alt b -> Alt b -> Ordering
711 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
713 ltAlt :: Alt b -> Alt b -> Bool
714 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
716 cmpAltCon :: AltCon -> AltCon -> Ordering
717 -- ^ Compares 'AltCon's within a single list of alternatives
718 cmpAltCon DEFAULT DEFAULT = EQ
719 cmpAltCon DEFAULT _ = LT
721 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
722 cmpAltCon (DataAlt _) DEFAULT = GT
723 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
724 cmpAltCon (LitAlt _) DEFAULT = GT
726 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
727 ppr con1 <+> ppr con2 )
731 %************************************************************************
733 \subsection{Useful synonyms}
735 %************************************************************************
738 -- | The common case for the type of binders and variables when
739 -- we are manipulating the Core language within GHC
741 -- | Expressions where binders are 'CoreBndr's
742 type CoreExpr = Expr CoreBndr
743 -- | Argument expressions where binders are 'CoreBndr's
744 type CoreArg = Arg CoreBndr
745 -- | Binding groups where binders are 'CoreBndr's
746 type CoreBind = Bind CoreBndr
747 -- | Case alternatives where binders are 'CoreBndr's
748 type CoreAlt = Alt CoreBndr
751 %************************************************************************
755 %************************************************************************
758 -- | Binders are /tagged/ with a t
759 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
761 type TaggedBind t = Bind (TaggedBndr t)
762 type TaggedExpr t = Expr (TaggedBndr t)
763 type TaggedArg t = Arg (TaggedBndr t)
764 type TaggedAlt t = Alt (TaggedBndr t)
766 instance Outputable b => Outputable (TaggedBndr b) where
767 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
769 instance Outputable b => OutputableBndr (TaggedBndr b) where
770 pprBndr _ b = ppr b -- Simple
774 %************************************************************************
776 \subsection{Core-constructing functions with checking}
778 %************************************************************************
781 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
782 -- use 'CoreUtils.mkCoreApps' if possible
783 mkApps :: Expr b -> [Arg b] -> Expr b
784 -- | Apply a list of type argument expressions to a function expression in a nested fashion
785 mkTyApps :: Expr b -> [Type] -> Expr b
786 -- | Apply a list of type or value variables to a function expression in a nested fashion
787 mkVarApps :: Expr b -> [Var] -> Expr b
788 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
789 -- use 'MkCore.mkCoreConApps' if possible
790 mkConApp :: DataCon -> [Arg b] -> Expr b
792 mkApps f args = foldl App f args
793 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
794 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
795 mkConApp con args = mkApps (Var (dataConWorkId con)) args
798 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
799 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
800 mkIntLit :: Integer -> Expr b
801 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
802 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
803 mkIntLitInt :: Int -> Expr b
805 mkIntLit n = Lit (mkMachInt n)
806 mkIntLitInt n = Lit (mkMachInt (toInteger n))
808 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
809 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
810 mkWordLit :: Integer -> Expr b
811 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
812 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
813 mkWordLitWord :: Word -> Expr b
815 mkWordLit w = Lit (mkMachWord w)
816 mkWordLitWord w = Lit (mkMachWord (toInteger w))
818 -- | Create a machine character literal expression of type @Char#@.
819 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
820 mkCharLit :: Char -> Expr b
821 -- | Create a machine string literal expression of type @Addr#@.
822 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
823 mkStringLit :: String -> Expr b
825 mkCharLit c = Lit (mkMachChar c)
826 mkStringLit s = Lit (mkMachString s)
828 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
829 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
830 mkFloatLit :: Rational -> Expr b
831 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
832 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
833 mkFloatLitFloat :: Float -> Expr b
835 mkFloatLit f = Lit (mkMachFloat f)
836 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
838 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
839 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
840 mkDoubleLit :: Rational -> Expr b
841 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
842 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
843 mkDoubleLitDouble :: Double -> Expr b
845 mkDoubleLit d = Lit (mkMachDouble d)
846 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
848 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
849 -- use 'CoreUtils.mkCoreLets' if possible
850 mkLets :: [Bind b] -> Expr b -> Expr b
851 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
852 -- use 'CoreUtils.mkCoreLams' if possible
853 mkLams :: [b] -> Expr b -> Expr b
855 mkLams binders body = foldr Lam body binders
856 mkLets binds body = foldr Let body binds
859 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
860 -- this can only be used to bind something in a non-recursive @let@ expression
861 mkTyBind :: TyVar -> Type -> CoreBind
862 mkTyBind tv ty = NonRec tv (Type ty)
864 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
865 varToCoreExpr :: CoreBndr -> Expr b
866 varToCoreExpr v | isId v = Var v
867 | otherwise = Type (mkTyVarTy v)
869 varsToCoreExprs :: [CoreBndr] -> [Expr b]
870 varsToCoreExprs vs = map varToCoreExpr vs
874 %************************************************************************
876 \subsection{Simple access functions}
878 %************************************************************************
881 -- | Extract every variable by this group
882 bindersOf :: Bind b -> [b]
883 bindersOf (NonRec binder _) = [binder]
884 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
886 -- | 'bindersOf' applied to a list of binding groups
887 bindersOfBinds :: [Bind b] -> [b]
888 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
890 rhssOfBind :: Bind b -> [Expr b]
891 rhssOfBind (NonRec _ rhs) = [rhs]
892 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
894 rhssOfAlts :: [Alt b] -> [Expr b]
895 rhssOfAlts alts = [e | (_,_,e) <- alts]
897 -- | Collapse all the bindings in the supplied groups into a single
898 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
899 flattenBinds :: [Bind b] -> [(b, Expr b)]
900 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
901 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
906 -- | We often want to strip off leading lambdas before getting down to
907 -- business. This function is your friend.
908 collectBinders :: Expr b -> ([b], Expr b)
909 -- | Collect as many type bindings as possible from the front of a nested lambda
910 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
911 -- | Collect as many value bindings as possible from the front of a nested lambda
912 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
913 -- | Collect type binders from the front of the lambda first,
914 -- then follow up by collecting as many value bindings as possible
915 -- from the resulting stripped expression
916 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
921 go bs (Lam b e) = go (b:bs) e
922 go bs e = (reverse bs, e)
924 collectTyAndValBinders expr
927 (tvs, body1) = collectTyBinders expr
928 (ids, body) = collectValBinders body1
930 collectTyBinders expr
933 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
934 go tvs e = (reverse tvs, e)
936 collectValBinders expr
939 go ids (Lam b e) | isId b = go (b:ids) e
940 go ids body = (reverse ids, body)
944 -- | Takes a nested application expression and returns the the function
945 -- being applied and the arguments to which it is applied
946 collectArgs :: Expr b -> (Expr b, [Arg b])
950 go (App f a) as = go f (a:as)
955 -- | Gets the cost centre enclosing an expression, if any.
956 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
957 coreExprCc :: Expr b -> CostCentre
958 coreExprCc (Note (SCC cc) _) = cc
959 coreExprCc (Note _ e) = coreExprCc e
960 coreExprCc (Lam _ e) = coreExprCc e
961 coreExprCc _ = noCostCentre
964 %************************************************************************
966 \subsection{Predicates}
968 %************************************************************************
970 At one time we optionally carried type arguments through to runtime.
971 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
972 i.e. if type applications are actual lambdas because types are kept around
973 at runtime. Similarly isRuntimeArg.
976 -- | Will this variable exist at runtime?
977 isRuntimeVar :: Var -> Bool
980 -- | Will this argument expression exist at runtime?
981 isRuntimeArg :: CoreExpr -> Bool
982 isRuntimeArg = isValArg
984 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
985 isValArg :: Expr b -> Bool
986 isValArg (Type _) = False
989 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
990 isTypeArg :: Expr b -> Bool
991 isTypeArg (Type _) = True
994 -- | The number of binders that bind values rather than types
995 valBndrCount :: [CoreBndr] -> Int
996 valBndrCount = count isId
998 -- | The number of argument expressions that are values rather than types at their top level
999 valArgCount :: [Arg b] -> Int
1000 valArgCount = count isValArg
1004 %************************************************************************
1006 \subsection{Seq stuff}
1008 %************************************************************************
1011 seqExpr :: CoreExpr -> ()
1012 seqExpr (Var v) = v `seq` ()
1013 seqExpr (Lit lit) = lit `seq` ()
1014 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1015 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1016 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1017 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1018 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1019 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1020 seqExpr (Type t) = seqType t
1022 seqExprs :: [CoreExpr] -> ()
1024 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1026 seqNote :: Note -> ()
1027 seqNote (CoreNote s) = s `seq` ()
1030 seqBndr :: CoreBndr -> ()
1031 seqBndr b = b `seq` ()
1033 seqBndrs :: [CoreBndr] -> ()
1035 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1037 seqBind :: Bind CoreBndr -> ()
1038 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1039 seqBind (Rec prs) = seqPairs prs
1041 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1043 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1045 seqAlts :: [CoreAlt] -> ()
1047 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1049 seqRules :: [CoreRule] -> ()
1051 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1052 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1053 seqRules (BuiltinRule {} : rules) = seqRules rules
1056 %************************************************************************
1058 \subsection{Annotated core}
1060 %************************************************************************
1063 -- | Annotated core: allows annotation at every node in the tree
1064 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1066 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1067 data AnnExpr' bndr annot
1070 | AnnLam bndr (AnnExpr bndr annot)
1071 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1072 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1073 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1074 | AnnCast (AnnExpr bndr annot) Coercion
1075 | AnnNote Note (AnnExpr bndr annot)
1078 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1079 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1081 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1082 data AnnBind bndr annot
1083 = AnnNonRec bndr (AnnExpr bndr annot)
1084 | AnnRec [(bndr, AnnExpr bndr annot)]
1088 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1089 deAnnotate (_, e) = deAnnotate' e
1091 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1092 deAnnotate' (AnnType t) = Type t
1093 deAnnotate' (AnnVar v) = Var v
1094 deAnnotate' (AnnLit lit) = Lit lit
1095 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1096 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1097 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1098 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1100 deAnnotate' (AnnLet bind body)
1101 = Let (deAnnBind bind) (deAnnotate body)
1103 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1104 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1106 deAnnotate' (AnnCase scrut v t alts)
1107 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1109 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1110 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1114 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1115 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1119 collect bs (_, AnnLam b body) = collect (b:bs) body
1120 collect bs body = (reverse bs, body)