2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
8 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
11 Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
12 CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
13 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
15 -- ** 'Expr' construction
17 mkApps, mkTyApps, mkVarApps,
19 mkIntLit, mkIntLitInt,
20 mkWordLit, mkWordLitWord,
21 mkCharLit, mkStringLit,
22 mkFloatLit, mkFloatLitFloat,
23 mkDoubleLit, mkDoubleLitDouble,
26 varToCoreExpr, varsToCoreExprs,
28 isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
30 -- ** Simple 'Expr' access functions and predicates
31 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
32 collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
33 collectArgs, coreExprCc, flattenBinds,
35 isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
37 -- * Unfolding data types
38 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
39 -- Abstract everywhere but in CoreUnfold.lhs
41 -- ** Constructing 'Unfolding's
42 noUnfolding, evaldUnfolding, mkOtherCon,
43 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
45 -- ** Predicates and deconstruction on 'Unfolding'
46 unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
47 maybeUnfoldingTemplate, otherCons, unfoldingArity,
48 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
49 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
50 isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding,
51 isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource,
54 seqExpr, seqExprs, seqUnfolding,
56 -- * Annotated expression data types
57 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
59 -- ** Operations on annotations
60 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
62 -- * Core rule data types
63 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
64 RuleName, IdUnfoldingFun,
66 -- ** Operations on 'CoreRule's
67 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
69 isBuiltinRule, isLocalRule
72 #include "HsVersions.h"
88 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
89 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
92 %************************************************************************
94 \subsection{The main data types}
96 %************************************************************************
98 These data types are the heart of the compiler
101 infixl 8 `App` -- App brackets to the left
103 -- | This is the data type that represents GHCs core intermediate language. Currently
104 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
105 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
107 -- We get from Haskell source to this Core language in a number of stages:
109 -- 1. The source code is parsed into an abstract syntax tree, which is represented
110 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
112 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
113 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
114 -- For example, this program:
117 -- f x = let f x = x + 1
121 -- Would be renamed by having 'Unique's attached so it looked something like this:
124 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
128 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
129 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
131 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
132 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
133 -- optimization, analysis and code generation on.
135 -- The type parameter @b@ is for the type of binders in the expression tree.
137 = Var Id -- ^ Variables
138 | Lit Literal -- ^ Primitive literals
139 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
141 -- See "CoreSyn#let_app_invariant" for another invariant
142 | Lam b (Expr b) -- ^ Lambda abstraction
143 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
144 -- this corresponds to allocating a thunk for the things
145 -- bound and then executing the sub-expression.
147 -- #top_level_invariant#
148 -- #letrec_invariant#
150 -- The right hand sides of all top-level and recursive @let@s
151 -- /must/ be of lifted type (see "Type#type_classification" for
152 -- the meaning of /lifted/ vs. /unlifted/).
154 -- #let_app_invariant#
155 -- The right hand side of of a non-recursive 'Let' _and_ the argument of an 'App',
156 -- /may/ be of unlifted type, but only if the expression
157 -- is ok-for-speculation. This means that the let can be floated around
158 -- without difficulty. For example, this is OK:
160 -- > y::Int# = x +# 1#
162 -- But this is not, as it may affect termination if the expression is floated out:
164 -- > y::Int# = fac 4#
166 -- In this situation you should use @case@ rather than a @let@. The function
167 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
168 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
169 -- which will generate a @case@ if necessary
172 -- We allow a /non-recursive/ let to bind a type variable, thus:
174 -- > Let (NonRec tv (Type ty)) body
176 -- This can be very convenient for postponing type substitutions until
177 -- the next run of the simplifier.
179 -- At the moment, the rest of the compiler only deals with type-let
180 -- in a Let expression, rather than at top level. We may want to revist
182 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
183 -- the scrutinee (expression examined) to weak head normal form
184 -- and then examining at most one level of resulting constructor (i.e. you
185 -- cannot do nested pattern matching directly with this).
187 -- The binder gets bound to the value of the scrutinee,
188 -- and the 'Type' must be that of all the case alternatives
191 -- This is one of the more complicated elements of the Core language, and comes
192 -- with a number of restrictions:
194 -- The 'DEFAULT' case alternative must be first in the list, if it occurs at all.
196 -- The remaining cases are in order of increasing
197 -- tag (for 'DataAlts') or
198 -- lit (for 'LitAlts').
199 -- This makes finding the relevant constructor easy, and makes comparison easier too.
201 -- The list of alternatives must be exhaustive. An /exhaustive/ case
202 -- does not necessarily mention all constructors:
205 -- data Foo = Red | Green | Blue
208 -- other -> f (case x of
213 -- The inner case does not need a @Red@ alternative, because @x@ can't be @Red@ at
214 -- that program point.
215 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type. This is used to implement @newtype@s
216 -- (a @newtype@ constructor or destructor just becomes a 'Cast' in Core) and GADTs.
217 | Note Note (Expr b) -- ^ Notes. These allow general information to be
218 -- added to expressions in the syntax tree
219 | Type Type -- ^ A type: this should only show up at the top
222 -- | Type synonym for expressions that occur in function argument positions.
223 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
226 -- | A case split alternative. Consists of the constructor leading to the alternative,
227 -- the variables bound from the constructor, and the expression to be executed given that binding.
228 -- The default alternative is @(DEFAULT, [], rhs)@
229 type Alt b = (AltCon, [b], Expr b)
231 -- | A case alternative constructor (i.e. pattern match)
232 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
233 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
234 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
235 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
238 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
239 data Bind b = NonRec b (Expr b)
240 | Rec [(b, (Expr b))]
243 -------------------------- CoreSyn INVARIANTS ---------------------------
245 Note [CoreSyn top-level invariant]
246 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
247 See #toplevel_invariant#
249 Note [CoreSyn letrec invariant]
250 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
251 See #letrec_invariant#
253 Note [CoreSyn let/app invariant]
254 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
255 See #let_app_invariant#
257 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
259 Note [CoreSyn case invariants]
260 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
261 See #case_invariants#
263 Note [CoreSyn let goal]
264 ~~~~~~~~~~~~~~~~~~~~~~~
265 * The simplifier tries to ensure that if the RHS of a let is a constructor
266 application, its arguments are trivial, so that the constructor can be
276 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
278 = SCC CostCentre -- ^ A cost centre annotation for profiling
279 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
283 %************************************************************************
285 \subsection{Transformation rules}
287 %************************************************************************
289 The CoreRule type and its friends are dealt with mainly in CoreRules,
290 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
293 -- | A 'CoreRule' is:
295 -- * \"Local\" if the function it is a rule for is defined in the
296 -- same module as the rule itself.
298 -- * \"Orphan\" if nothing on the LHS is defined in the same module
299 -- as the rule itself
302 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
303 ru_act :: Activation, -- ^ When the rule is active
305 -- Rough-matching stuff
306 -- see comments with InstEnv.Instance( is_cls, is_rough )
307 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
308 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
310 -- Proper-matching stuff
311 -- see comments with InstEnv.Instance( is_tvs, is_tys )
312 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
313 ru_args :: [CoreExpr], -- ^ Left hand side arguments
315 -- And the right-hand side
316 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
317 -- Occurrence info is guaranteed correct
318 -- See Note [OccInfo in unfoldings and rules]
321 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
322 -- defined in the same module as the rule
323 -- and is not an implicit 'Id' (like a record selector,
324 -- class operation, or data constructor)
326 -- NB: ru_local is *not* used to decide orphan-hood
327 -- c.g. MkIface.coreRuleToIfaceRule
330 -- | Built-in rules are used for constant folding
331 -- and suchlike. They have no free variables.
333 ru_name :: RuleName, -- ^ As above
334 ru_fn :: Name, -- ^ As above
335 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
336 -- if it fires, including type arguments
337 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
338 -- ^ This function does the rewrite. It given too many
339 -- arguments, it simply discards them; the returned 'CoreExpr'
340 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
342 -- See Note [Extra args in rule matching] in Rules.lhs
344 type IdUnfoldingFun = Id -> Unfolding
345 -- A function that embodies how to unfold an Id if you need
346 -- to do that in the Rule. The reason we need to pass this info in
347 -- is that whether an Id is unfoldable depends on the simplifier phase
349 isBuiltinRule :: CoreRule -> Bool
350 isBuiltinRule (BuiltinRule {}) = True
351 isBuiltinRule _ = False
353 -- | The number of arguments the 'ru_fn' must be applied
354 -- to before the rule can match on it
355 ruleArity :: CoreRule -> Int
356 ruleArity (BuiltinRule {ru_nargs = n}) = n
357 ruleArity (Rule {ru_args = args}) = length args
359 ruleName :: CoreRule -> RuleName
362 ruleActivation_maybe :: CoreRule -> Maybe Activation
363 ruleActivation_maybe (BuiltinRule { }) = Nothing
364 ruleActivation_maybe (Rule { ru_act = act }) = Just act
366 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
367 ruleIdName :: CoreRule -> Name
370 isLocalRule :: CoreRule -> Bool
371 isLocalRule = ru_local
373 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
374 setRuleIdName :: Name -> CoreRule -> CoreRule
375 setRuleIdName nm ru = ru { ru_fn = nm }
379 %************************************************************************
383 %************************************************************************
385 The @Unfolding@ type is declared here to avoid numerous loops
388 -- | Records the /unfolding/ of an identifier, which is approximately the form the
389 -- identifier would have if we substituted its definition in for the identifier.
390 -- This type should be treated as abstract everywhere except in "CoreUnfold"
392 = NoUnfolding -- ^ We have no information about the unfolding
394 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
395 -- @OtherCon xs@ also indicates that something has been evaluated
396 -- and hence there's no point in re-evaluating it.
397 -- @OtherCon []@ is used even for non-data-type values
398 -- to indicated evaluated-ness. Notably:
400 -- > data C = C !(Int -> Int)
401 -- > case x of { C f -> ... }
403 -- Here, @f@ gets an @OtherCon []@ unfolding.
405 | DFunUnfolding DataCon [CoreExpr]
406 -- The Unfolding of a DFunId
407 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
408 -- (op2 a1..am d1..dn)
409 -- where Arity = n, the number of dict args to the dfun
410 -- The [CoreExpr] are the superclasses and methods [op1,op2],
411 -- in positional order.
412 -- They are usually variables, but can be trivial expressions
413 -- instead (e.g. a type application).
415 | CoreUnfolding { -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
416 -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
417 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
418 uf_src :: UnfoldingSource, -- Where the unfolding came from
419 uf_is_top :: Bool, -- True <=> top level binding
420 uf_arity :: Arity, -- Number of value arguments expected
421 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard a `seq` on
423 uf_is_conlike :: Bool, -- True <=> application of constructor or CONLIKE function
424 -- Cached version of exprIsConLike
425 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining
426 -- Cached version of exprIsCheap
427 uf_expandable :: Bool, -- True <=> can expand in RULE matching
428 -- Cached version of exprIsExpandable
429 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
431 -- ^ An unfolding with redundant cached information. Parameters:
433 -- uf_tmpl: Template used to perform unfolding;
434 -- NB: Occurrence info is guaranteed correct:
435 -- see Note [OccInfo in unfoldings and rules]
437 -- uf_is_top: Is this a top level binding?
439 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
442 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
443 -- Basically this is a cached version of 'exprIsCheap'
445 -- uf_guidance: Tells us about the /size/ of the unfolding template
447 ------------------------------------------------
449 = InlineCompulsory -- Something that *has* no binding, so you *must* inline it
450 -- Only a few primop-like things have this property
451 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
452 -- Inline absolutely always, however boring the context.
454 | InlineRule -- From an {-# INLINE #-} pragma; See Note [InlineRules]
456 | InlineWrapper Id -- This unfolding is a the wrapper in a
457 -- worker/wrapper split from the strictness analyser
458 -- The Id is the worker-id
459 -- Used to abbreviate the uf_tmpl in interface files
460 -- which don't need to contain the RHS;
461 -- it can be derived from the strictness info
463 | InlineRhs -- The current rhs of the function
465 -- For InlineRhs, the uf_tmpl is replaced each time around
466 -- For all the others we leave uf_tmpl alone
469 -- | 'UnfoldingGuidance' says when unfolding should take place
470 data UnfoldingGuidance
471 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
472 -- Used (a) for small *and* cheap unfoldings
473 -- (b) for INLINE functions
474 -- See Note [INLINE for small functions] in CoreUnfold
475 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
476 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
477 -- So True,True means "always"
480 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
481 -- result of a simple analysis of the RHS
483 ug_args :: [Int], -- Discount if the argument is evaluated.
484 -- (i.e., a simplification will definitely
485 -- be possible). One elt of the list per *value* arg.
487 ug_size :: Int, -- The "size" of the unfolding.
489 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
490 } -- a context (case (thing args) of ...),
491 -- (where there are the right number of arguments.)
493 | UnfNever -- The RHS is big, so don't inline it
495 -- Constants for the UnfWhen constructor
496 needSaturated, unSaturatedOk :: Bool
497 needSaturated = False
500 boringCxtNotOk, boringCxtOk :: Bool
502 boringCxtNotOk = False
504 ------------------------------------------------
505 noUnfolding :: Unfolding
506 -- ^ There is no known 'Unfolding'
507 evaldUnfolding :: Unfolding
508 -- ^ This unfolding marks the associated thing as being evaluated
510 noUnfolding = NoUnfolding
511 evaldUnfolding = OtherCon []
513 mkOtherCon :: [AltCon] -> Unfolding
514 mkOtherCon = OtherCon
516 seqUnfolding :: Unfolding -> ()
517 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
518 uf_is_value = b1, uf_is_cheap = b2,
519 uf_expandable = b3, uf_is_conlike = b4,
520 uf_arity = a, uf_guidance = g})
521 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
525 seqGuidance :: UnfoldingGuidance -> ()
526 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
531 isInlineRuleSource :: UnfoldingSource -> Bool
532 isInlineRuleSource InlineCompulsory = True
533 isInlineRuleSource InlineRule = True
534 isInlineRuleSource (InlineWrapper {}) = True
535 isInlineRuleSource InlineRhs = False
537 -- | Retrieves the template of an unfolding: panics if none is known
538 unfoldingTemplate :: Unfolding -> CoreExpr
539 unfoldingTemplate = uf_tmpl
541 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
542 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
544 -- | Retrieves the template of an unfolding if possible
545 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
546 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
547 maybeUnfoldingTemplate _ = Nothing
549 -- | The constructors that the unfolding could never be:
550 -- returns @[]@ if no information is available
551 otherCons :: Unfolding -> [AltCon]
552 otherCons (OtherCon cons) = cons
555 -- | Determines if it is certainly the case that the unfolding will
556 -- yield a value (something in HNF): returns @False@ if unsure
557 isValueUnfolding :: Unfolding -> Bool
558 -- Returns False for OtherCon
559 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
560 isValueUnfolding _ = False
562 -- | Determines if it possibly the case that the unfolding will
563 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
565 isEvaldUnfolding :: Unfolding -> Bool
566 -- Returns True for OtherCon
567 isEvaldUnfolding (OtherCon _) = True
568 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
569 isEvaldUnfolding _ = False
571 -- | @True@ if the unfolding is a constructor application, the application
572 -- of a CONLIKE function or 'OtherCon'
573 isConLikeUnfolding :: Unfolding -> Bool
574 isConLikeUnfolding (OtherCon _) = True
575 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
576 isConLikeUnfolding _ = False
578 -- | Is the thing we will unfold into certainly cheap?
579 isCheapUnfolding :: Unfolding -> Bool
580 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
581 isCheapUnfolding _ = False
583 isExpandableUnfolding :: Unfolding -> Bool
584 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
585 isExpandableUnfolding _ = False
587 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
588 -- Expand an expandable unfolding; this is used in rule matching
589 -- See Note [Expanding variables] in Rules.lhs
590 -- The key point here is that CONLIKE things can be expanded
591 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
592 expandUnfolding_maybe _ = Nothing
594 isInlineRule :: Unfolding -> Bool
595 isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
596 isInlineRule _ = False
598 isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
599 isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
600 | isInlineRuleSource src
601 = Just (src, unsat_ok)
603 unsat_ok = case guide of
604 UnfWhen unsat_ok _ -> unsat_ok
606 isInlineRule_maybe _ = Nothing
608 isCompulsoryUnfolding :: Unfolding -> Bool
609 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
610 isCompulsoryUnfolding _ = False
612 isStableUnfolding :: Unfolding -> Bool
613 -- True of unfoldings that should not be overwritten
614 -- by a CoreUnfolding for the RHS of a let-binding
615 isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
616 isStableUnfolding (DFunUnfolding {}) = True
617 isStableUnfolding _ = False
619 unfoldingArity :: Unfolding -> Arity
620 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
621 unfoldingArity _ = panic "unfoldingArity"
623 isClosedUnfolding :: Unfolding -> Bool -- No free variables
624 isClosedUnfolding (CoreUnfolding {}) = False
625 isClosedUnfolding (DFunUnfolding {}) = False
626 isClosedUnfolding _ = True
628 -- | Only returns False if there is no unfolding information available at all
629 hasSomeUnfolding :: Unfolding -> Bool
630 hasSomeUnfolding NoUnfolding = False
631 hasSomeUnfolding _ = True
633 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
634 neverUnfoldGuidance UnfNever = True
635 neverUnfoldGuidance _ = False
637 canUnfold :: Unfolding -> Bool
638 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
647 you intend that calls (f e) are replaced by <rhs>[e/x] So we
648 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
649 with it. Meanwhile, we can optimise <rhs> to our heart's content,
650 leaving the original unfolding intact in Unfolding of 'f'. For example
651 all xs = foldr (&&) True xs
652 any p = all . map p {-# INLINE any #-}
653 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
654 which deforests well at the call site.
656 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
658 Moreover, it's only used when 'f' is applied to the
659 specified number of arguments; that is, the number of argument on
660 the LHS of the '=' sign in the original source definition.
661 For example, (.) is now defined in the libraries like this
663 (.) f g = \x -> f (g x)
664 so that it'll inline when applied to two arguments. If 'x' appeared
667 it'd only inline when applied to three arguments. This slightly-experimental
668 change was requested by Roman, but it seems to make sense.
670 See also Note [Inlining an InlineRule] in CoreUnfold.
673 Note [OccInfo in unfoldings and rules]
674 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
675 In unfoldings and rules, we guarantee that the template is occ-analysed,
676 so that the occurence info on the binders is correct. This is important,
677 because the Simplifier does not re-analyse the template when using it. If
678 the occurrence info is wrong
679 - We may get more simpifier iterations than necessary, because
680 once-occ info isn't there
681 - More seriously, we may get an infinite loop if there's a Rec
682 without a loop breaker marked
685 %************************************************************************
687 \subsection{The main data type}
689 %************************************************************************
692 -- The Ord is needed for the FiniteMap used in the lookForConstructor
693 -- in SimplEnv. If you declared that lookForConstructor *ignores*
694 -- constructor-applications with LitArg args, then you could get
697 instance Outputable AltCon where
698 ppr (DataAlt dc) = ppr dc
699 ppr (LitAlt lit) = ppr lit
700 ppr DEFAULT = ptext (sLit "__DEFAULT")
702 instance Show AltCon where
703 showsPrec p con = showsPrecSDoc p (ppr con)
705 cmpAlt :: Alt b -> Alt b -> Ordering
706 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
708 ltAlt :: Alt b -> Alt b -> Bool
709 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
711 cmpAltCon :: AltCon -> AltCon -> Ordering
712 -- ^ Compares 'AltCon's within a single list of alternatives
713 cmpAltCon DEFAULT DEFAULT = EQ
714 cmpAltCon DEFAULT _ = LT
716 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
717 cmpAltCon (DataAlt _) DEFAULT = GT
718 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
719 cmpAltCon (LitAlt _) DEFAULT = GT
721 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
722 ppr con1 <+> ppr con2 )
726 %************************************************************************
728 \subsection{Useful synonyms}
730 %************************************************************************
733 -- | The common case for the type of binders and variables when
734 -- we are manipulating the Core language within GHC
736 -- | Expressions where binders are 'CoreBndr's
737 type CoreExpr = Expr CoreBndr
738 -- | Argument expressions where binders are 'CoreBndr's
739 type CoreArg = Arg CoreBndr
740 -- | Binding groups where binders are 'CoreBndr's
741 type CoreBind = Bind CoreBndr
742 -- | Case alternatives where binders are 'CoreBndr's
743 type CoreAlt = Alt CoreBndr
746 %************************************************************************
750 %************************************************************************
753 -- | Binders are /tagged/ with a t
754 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
756 type TaggedBind t = Bind (TaggedBndr t)
757 type TaggedExpr t = Expr (TaggedBndr t)
758 type TaggedArg t = Arg (TaggedBndr t)
759 type TaggedAlt t = Alt (TaggedBndr t)
761 instance Outputable b => Outputable (TaggedBndr b) where
762 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
764 instance Outputable b => OutputableBndr (TaggedBndr b) where
765 pprBndr _ b = ppr b -- Simple
769 %************************************************************************
771 \subsection{Core-constructing functions with checking}
773 %************************************************************************
776 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
777 -- use 'CoreUtils.mkCoreApps' if possible
778 mkApps :: Expr b -> [Arg b] -> Expr b
779 -- | Apply a list of type argument expressions to a function expression in a nested fashion
780 mkTyApps :: Expr b -> [Type] -> Expr b
781 -- | Apply a list of type or value variables to a function expression in a nested fashion
782 mkVarApps :: Expr b -> [Var] -> Expr b
783 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
784 -- use 'MkCore.mkCoreConApps' if possible
785 mkConApp :: DataCon -> [Arg b] -> Expr b
787 mkApps f args = foldl App f args
788 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
789 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
790 mkConApp con args = mkApps (Var (dataConWorkId con)) args
793 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
794 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
795 mkIntLit :: Integer -> Expr b
796 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
797 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
798 mkIntLitInt :: Int -> Expr b
800 mkIntLit n = Lit (mkMachInt n)
801 mkIntLitInt n = Lit (mkMachInt (toInteger n))
803 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
804 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
805 mkWordLit :: Integer -> Expr b
806 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
807 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
808 mkWordLitWord :: Word -> Expr b
810 mkWordLit w = Lit (mkMachWord w)
811 mkWordLitWord w = Lit (mkMachWord (toInteger w))
813 -- | Create a machine character literal expression of type @Char#@.
814 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
815 mkCharLit :: Char -> Expr b
816 -- | Create a machine string literal expression of type @Addr#@.
817 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
818 mkStringLit :: String -> Expr b
820 mkCharLit c = Lit (mkMachChar c)
821 mkStringLit s = Lit (mkMachString s)
823 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
824 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
825 mkFloatLit :: Rational -> Expr b
826 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
827 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
828 mkFloatLitFloat :: Float -> Expr b
830 mkFloatLit f = Lit (mkMachFloat f)
831 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
833 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
834 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
835 mkDoubleLit :: Rational -> Expr b
836 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
837 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
838 mkDoubleLitDouble :: Double -> Expr b
840 mkDoubleLit d = Lit (mkMachDouble d)
841 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
843 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
844 -- use 'CoreUtils.mkCoreLets' if possible
845 mkLets :: [Bind b] -> Expr b -> Expr b
846 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
847 -- use 'CoreUtils.mkCoreLams' if possible
848 mkLams :: [b] -> Expr b -> Expr b
850 mkLams binders body = foldr Lam body binders
851 mkLets binds body = foldr Let body binds
854 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
855 -- this can only be used to bind something in a non-recursive @let@ expression
856 mkTyBind :: TyVar -> Type -> CoreBind
857 mkTyBind tv ty = NonRec tv (Type ty)
859 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
860 varToCoreExpr :: CoreBndr -> Expr b
861 varToCoreExpr v | isId v = Var v
862 | otherwise = Type (mkTyVarTy v)
864 varsToCoreExprs :: [CoreBndr] -> [Expr b]
865 varsToCoreExprs vs = map varToCoreExpr vs
869 %************************************************************************
871 \subsection{Simple access functions}
873 %************************************************************************
876 -- | Extract every variable by this group
877 bindersOf :: Bind b -> [b]
878 bindersOf (NonRec binder _) = [binder]
879 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
881 -- | 'bindersOf' applied to a list of binding groups
882 bindersOfBinds :: [Bind b] -> [b]
883 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
885 rhssOfBind :: Bind b -> [Expr b]
886 rhssOfBind (NonRec _ rhs) = [rhs]
887 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
889 rhssOfAlts :: [Alt b] -> [Expr b]
890 rhssOfAlts alts = [e | (_,_,e) <- alts]
892 -- | Collapse all the bindings in the supplied groups into a single
893 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
894 flattenBinds :: [Bind b] -> [(b, Expr b)]
895 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
896 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
901 -- | We often want to strip off leading lambdas before getting down to
902 -- business. This function is your friend.
903 collectBinders :: Expr b -> ([b], Expr b)
904 -- | Collect as many type bindings as possible from the front of a nested lambda
905 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
906 -- | Collect as many value bindings as possible from the front of a nested lambda
907 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
908 -- | Collect type binders from the front of the lambda first,
909 -- then follow up by collecting as many value bindings as possible
910 -- from the resulting stripped expression
911 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
916 go bs (Lam b e) = go (b:bs) e
917 go bs e = (reverse bs, e)
919 collectTyAndValBinders expr
922 (tvs, body1) = collectTyBinders expr
923 (ids, body) = collectValBinders body1
925 collectTyBinders expr
928 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
929 go tvs e = (reverse tvs, e)
931 collectValBinders expr
934 go ids (Lam b e) | isId b = go (b:ids) e
935 go ids body = (reverse ids, body)
939 -- | Takes a nested application expression and returns the the function
940 -- being applied and the arguments to which it is applied
941 collectArgs :: Expr b -> (Expr b, [Arg b])
945 go (App f a) as = go f (a:as)
950 -- | Gets the cost centre enclosing an expression, if any.
951 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
952 coreExprCc :: Expr b -> CostCentre
953 coreExprCc (Note (SCC cc) _) = cc
954 coreExprCc (Note _ e) = coreExprCc e
955 coreExprCc (Lam _ e) = coreExprCc e
956 coreExprCc _ = noCostCentre
959 %************************************************************************
961 \subsection{Predicates}
963 %************************************************************************
965 At one time we optionally carried type arguments through to runtime.
966 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
967 i.e. if type applications are actual lambdas because types are kept around
968 at runtime. Similarly isRuntimeArg.
971 -- | Will this variable exist at runtime?
972 isRuntimeVar :: Var -> Bool
975 -- | Will this argument expression exist at runtime?
976 isRuntimeArg :: CoreExpr -> Bool
977 isRuntimeArg = isValArg
979 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
980 isValArg :: Expr b -> Bool
981 isValArg (Type _) = False
984 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
985 isTypeArg :: Expr b -> Bool
986 isTypeArg (Type _) = True
989 -- | The number of binders that bind values rather than types
990 valBndrCount :: [CoreBndr] -> Int
991 valBndrCount = count isId
993 -- | The number of argument expressions that are values rather than types at their top level
994 valArgCount :: [Arg b] -> Int
995 valArgCount = count isValArg
999 %************************************************************************
1001 \subsection{Seq stuff}
1003 %************************************************************************
1006 seqExpr :: CoreExpr -> ()
1007 seqExpr (Var v) = v `seq` ()
1008 seqExpr (Lit lit) = lit `seq` ()
1009 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1010 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1011 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1012 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1013 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1014 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1015 seqExpr (Type t) = seqType t
1017 seqExprs :: [CoreExpr] -> ()
1019 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1021 seqNote :: Note -> ()
1022 seqNote (CoreNote s) = s `seq` ()
1025 seqBndr :: CoreBndr -> ()
1026 seqBndr b = b `seq` ()
1028 seqBndrs :: [CoreBndr] -> ()
1030 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1032 seqBind :: Bind CoreBndr -> ()
1033 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1034 seqBind (Rec prs) = seqPairs prs
1036 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1038 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1040 seqAlts :: [CoreAlt] -> ()
1042 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1044 seqRules :: [CoreRule] -> ()
1046 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1047 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1048 seqRules (BuiltinRule {} : rules) = seqRules rules
1051 %************************************************************************
1053 \subsection{Annotated core}
1055 %************************************************************************
1058 -- | Annotated core: allows annotation at every node in the tree
1059 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1061 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1062 data AnnExpr' bndr annot
1065 | AnnLam bndr (AnnExpr bndr annot)
1066 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1067 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1068 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1069 | AnnCast (AnnExpr bndr annot) Coercion
1070 | AnnNote Note (AnnExpr bndr annot)
1073 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1074 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1076 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1077 data AnnBind bndr annot
1078 = AnnNonRec bndr (AnnExpr bndr annot)
1079 | AnnRec [(bndr, AnnExpr bndr annot)]
1083 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1084 deAnnotate (_, e) = deAnnotate' e
1086 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1087 deAnnotate' (AnnType t) = Type t
1088 deAnnotate' (AnnVar v) = Var v
1089 deAnnotate' (AnnLit lit) = Lit lit
1090 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1091 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1092 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1093 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1095 deAnnotate' (AnnLet bind body)
1096 = Let (deAnnBind bind) (deAnnotate body)
1098 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1099 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1101 deAnnotate' (AnnCase scrut v t alts)
1102 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1104 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1105 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1109 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1110 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1114 collect bs (_, AnnLam b body) = collect (b:bs) body
1115 collect bs body = (reverse bs, body)