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
141 | Lit Literal -- ^ Primitive literals
143 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
145 -- See "CoreSyn#let_app_invariant" for another invariant
147 | Lam b (Expr b) -- ^ Lambda abstraction
149 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
150 -- this corresponds to allocating a thunk for the things
151 -- bound and then executing the sub-expression.
153 -- #top_level_invariant#
154 -- #letrec_invariant#
156 -- The right hand sides of all top-level and recursive @let@s
157 -- /must/ be of lifted type (see "Type#type_classification" for
158 -- the meaning of /lifted/ vs. /unlifted/).
160 -- #let_app_invariant#
161 -- The right hand side of of a non-recursive 'Let'
162 -- _and_ the argument of an 'App',
163 -- /may/ be of unlifted type, but only if the expression
164 -- is ok-for-speculation. This means that the let can be floated
165 -- around without difficulty. For example, this is OK:
167 -- > y::Int# = x +# 1#
169 -- But this is not, as it may affect termination if the
170 -- expression is floated out:
172 -- > y::Int# = fac 4#
174 -- In this situation you should use @case@ rather than a @let@. The function
175 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
176 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
177 -- which will generate a @case@ if necessary
180 -- We allow a /non-recursive/ let to bind a type variable, thus:
182 -- > Let (NonRec tv (Type ty)) body
184 -- This can be very convenient for postponing type substitutions until
185 -- the next run of the simplifier.
187 -- At the moment, the rest of the compiler only deals with type-let
188 -- in a Let expression, rather than at top level. We may want to revist
191 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
192 -- the scrutinee (expression examined) to weak head normal form
193 -- and then examining at most one level of resulting constructor (i.e. you
194 -- cannot do nested pattern matching directly with this).
196 -- The binder gets bound to the value of the scrutinee,
197 -- and the 'Type' must be that of all the case alternatives
200 -- This is one of the more complicated elements of the Core language,
201 -- and comes with a number of restrictions:
203 -- The 'DEFAULT' case alternative must be first in the list,
204 -- if it occurs at all.
206 -- The remaining cases are in order of increasing
207 -- tag (for 'DataAlts') or
208 -- lit (for 'LitAlts').
209 -- This makes finding the relevant constructor easy,
210 -- and makes comparison easier too.
212 -- The list of alternatives must be exhaustive. An /exhaustive/ case
213 -- does not necessarily mention all constructors:
216 -- data Foo = Red | Green | Blue
219 -- other -> f (case x of
224 -- The inner case does not need a @Red@ alternative, because @x@
225 -- can't be @Red@ at that program point.
227 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type.
228 -- This is used to implement @newtype@s (a @newtype@ constructor or
229 -- destructor just becomes a 'Cast' in Core) and GADTs.
231 | Note Note (Expr b) -- ^ Notes. These allow general information to be
232 -- added to expressions in the syntax tree
234 | Type Type -- ^ A type: this should only show up at the top
236 deriving (Data, Typeable)
238 -- | Type synonym for expressions that occur in function argument positions.
239 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
242 -- | A case split alternative. Consists of the constructor leading to the alternative,
243 -- the variables bound from the constructor, and the expression to be executed given that binding.
244 -- The default alternative is @(DEFAULT, [], rhs)@
245 type Alt b = (AltCon, [b], Expr b)
247 -- | A case alternative constructor (i.e. pattern match)
248 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
249 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
250 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
251 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
252 deriving (Eq, Ord, Data, Typeable)
254 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
255 data Bind b = NonRec b (Expr b)
256 | Rec [(b, (Expr b))]
257 deriving (Data, Typeable)
260 -------------------------- CoreSyn INVARIANTS ---------------------------
262 Note [CoreSyn top-level invariant]
263 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
264 See #toplevel_invariant#
266 Note [CoreSyn letrec invariant]
267 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
268 See #letrec_invariant#
270 Note [CoreSyn let/app invariant]
271 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
272 See #let_app_invariant#
274 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
276 Note [CoreSyn case invariants]
277 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278 See #case_invariants#
280 Note [CoreSyn let goal]
281 ~~~~~~~~~~~~~~~~~~~~~~~
282 * The simplifier tries to ensure that if the RHS of a let is a constructor
283 application, its arguments are trivial, so that the constructor can be
293 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
295 = SCC CostCentre -- ^ A cost centre annotation for profiling
296 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
297 deriving (Data, Typeable)
301 %************************************************************************
303 \subsection{Transformation rules}
305 %************************************************************************
307 The CoreRule type and its friends are dealt with mainly in CoreRules,
308 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
311 -- | A 'CoreRule' is:
313 -- * \"Local\" if the function it is a rule for is defined in the
314 -- same module as the rule itself.
316 -- * \"Orphan\" if nothing on the LHS is defined in the same module
317 -- as the rule itself
320 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
321 ru_act :: Activation, -- ^ When the rule is active
323 -- Rough-matching stuff
324 -- see comments with InstEnv.Instance( is_cls, is_rough )
325 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
326 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
328 -- Proper-matching stuff
329 -- see comments with InstEnv.Instance( is_tvs, is_tys )
330 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
331 ru_args :: [CoreExpr], -- ^ Left hand side arguments
333 -- And the right-hand side
334 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
335 -- Occurrence info is guaranteed correct
336 -- See Note [OccInfo in unfoldings and rules]
339 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
340 -- defined in the same module as the rule
341 -- and is not an implicit 'Id' (like a record selector,
342 -- class operation, or data constructor)
344 -- NB: ru_local is *not* used to decide orphan-hood
345 -- c.g. MkIface.coreRuleToIfaceRule
348 -- | Built-in rules are used for constant folding
349 -- and suchlike. They have no free variables.
351 ru_name :: RuleName, -- ^ As above
352 ru_fn :: Name, -- ^ As above
353 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
354 -- if it fires, including type arguments
355 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
356 -- ^ This function does the rewrite. It given too many
357 -- arguments, it simply discards them; the returned 'CoreExpr'
358 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
360 -- See Note [Extra args in rule matching] in Rules.lhs
362 type IdUnfoldingFun = Id -> Unfolding
363 -- A function that embodies how to unfold an Id if you need
364 -- to do that in the Rule. The reason we need to pass this info in
365 -- is that whether an Id is unfoldable depends on the simplifier phase
367 isBuiltinRule :: CoreRule -> Bool
368 isBuiltinRule (BuiltinRule {}) = True
369 isBuiltinRule _ = False
371 -- | The number of arguments the 'ru_fn' must be applied
372 -- to before the rule can match on it
373 ruleArity :: CoreRule -> Int
374 ruleArity (BuiltinRule {ru_nargs = n}) = n
375 ruleArity (Rule {ru_args = args}) = length args
377 ruleName :: CoreRule -> RuleName
380 ruleActivation_maybe :: CoreRule -> Maybe Activation
381 ruleActivation_maybe (BuiltinRule { }) = Nothing
382 ruleActivation_maybe (Rule { ru_act = act }) = Just act
384 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
385 ruleIdName :: CoreRule -> Name
388 isLocalRule :: CoreRule -> Bool
389 isLocalRule = ru_local
391 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
392 setRuleIdName :: Name -> CoreRule -> CoreRule
393 setRuleIdName nm ru = ru { ru_fn = nm }
397 %************************************************************************
401 %************************************************************************
403 The @Unfolding@ type is declared here to avoid numerous loops
406 -- | Records the /unfolding/ of an identifier, which is approximately the form the
407 -- identifier would have if we substituted its definition in for the identifier.
408 -- This type should be treated as abstract everywhere except in "CoreUnfold"
410 = NoUnfolding -- ^ We have no information about the unfolding
412 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
413 -- @OtherCon xs@ also indicates that something has been evaluated
414 -- and hence there's no point in re-evaluating it.
415 -- @OtherCon []@ is used even for non-data-type values
416 -- to indicated evaluated-ness. Notably:
418 -- > data C = C !(Int -> Int)
419 -- > case x of { C f -> ... }
421 -- Here, @f@ gets an @OtherCon []@ unfolding.
423 | DFunUnfolding -- The Unfolding of a DFunId
424 -- See Note [DFun unfoldings]
425 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
426 -- (op2 a1..am d1..dn)
428 Arity -- Arity = m+n, the *total* number of args
429 -- (unusually, both type and value) to the dfun
431 DataCon -- The dictionary data constructor (possibly a newtype datacon)
433 [CoreExpr] -- The [CoreExpr] are the superclasses and methods [op1,op2],
434 -- in positional order.
435 -- They are usually variables, but can be trivial expressions
436 -- instead (e.g. a type application).
438 | CoreUnfolding { -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
439 -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
440 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
441 uf_src :: UnfoldingSource, -- Where the unfolding came from
442 uf_is_top :: Bool, -- True <=> top level binding
443 uf_arity :: Arity, -- Number of value arguments expected
444 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard a `seq` on
446 uf_is_conlike :: Bool, -- True <=> application of constructor or CONLIKE function
447 -- Cached version of exprIsConLike
448 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining
449 -- Cached version of exprIsCheap
450 uf_expandable :: Bool, -- True <=> can expand in RULE matching
451 -- Cached version of exprIsExpandable
452 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
454 -- ^ An unfolding with redundant cached information. Parameters:
456 -- uf_tmpl: Template used to perform unfolding;
457 -- NB: Occurrence info is guaranteed correct:
458 -- see Note [OccInfo in unfoldings and rules]
460 -- uf_is_top: Is this a top level binding?
462 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
465 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
466 -- Basically this is a cached version of 'exprIsCheap'
468 -- uf_guidance: Tells us about the /size/ of the unfolding template
470 ------------------------------------------------
472 = InlineCompulsory -- Something that *has* no binding, so you *must* inline it
473 -- Only a few primop-like things have this property
474 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
475 -- Inline absolutely always, however boring the context.
477 | InlineRule -- From an {-# INLINE #-} pragma; See Note [InlineRules]
479 | InlineWrapper Id -- This unfolding is a the wrapper in a
480 -- worker/wrapper split from the strictness analyser
481 -- The Id is the worker-id
482 -- Used to abbreviate the uf_tmpl in interface files
483 -- which don't need to contain the RHS;
484 -- it can be derived from the strictness info
486 | InlineRhs -- The current rhs of the function
488 -- For InlineRhs, the uf_tmpl is replaced each time around
489 -- For all the others we leave uf_tmpl alone
492 -- | 'UnfoldingGuidance' says when unfolding should take place
493 data UnfoldingGuidance
494 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
495 -- Used (a) for small *and* cheap unfoldings
496 -- (b) for INLINE functions
497 -- See Note [INLINE for small functions] in CoreUnfold
498 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
499 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
500 -- So True,True means "always"
503 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
504 -- result of a simple analysis of the RHS
506 ug_args :: [Int], -- Discount if the argument is evaluated.
507 -- (i.e., a simplification will definitely
508 -- be possible). One elt of the list per *value* arg.
510 ug_size :: Int, -- The "size" of the unfolding.
512 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
513 } -- a context (case (thing args) of ...),
514 -- (where there are the right number of arguments.)
516 | UnfNever -- The RHS is big, so don't inline it
520 Note [DFun unfoldings]
521 ~~~~~~~~~~~~~~~~~~~~~~
522 The Arity in a DFunUnfolding is total number of args (type and value)
523 that the DFun needs to produce a dictionary. That's not necessarily
524 related to the ordinary arity of the dfun Id, esp if the class has
525 one method, so the dictionary is represented by a newtype. Example
527 class C a where { op :: a -> Int }
528 instance C a -> C [a] where op xs = op (head xs)
530 The instance translates to
532 $dfCList :: forall a. C a => C [a] -- Arity 2!
533 $dfCList = /\a.\d. $copList {a} d |> co
535 $copList :: forall a. C a => [a] -> Int -- Arity 2!
536 $copList = /\a.\d.\xs. op {a} d (head xs)
538 Now we might encounter (op (dfCList {ty} d) a1 a2)
539 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
540 has all its arguments, even though its (value) arity is 2. That's
541 why we cache the number of expected
545 -- Constants for the UnfWhen constructor
546 needSaturated, unSaturatedOk :: Bool
547 needSaturated = False
550 boringCxtNotOk, boringCxtOk :: Bool
552 boringCxtNotOk = False
554 ------------------------------------------------
555 noUnfolding :: Unfolding
556 -- ^ There is no known 'Unfolding'
557 evaldUnfolding :: Unfolding
558 -- ^ This unfolding marks the associated thing as being evaluated
560 noUnfolding = NoUnfolding
561 evaldUnfolding = OtherCon []
563 mkOtherCon :: [AltCon] -> Unfolding
564 mkOtherCon = OtherCon
566 seqUnfolding :: Unfolding -> ()
567 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
568 uf_is_value = b1, uf_is_cheap = b2,
569 uf_expandable = b3, uf_is_conlike = b4,
570 uf_arity = a, uf_guidance = g})
571 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
575 seqGuidance :: UnfoldingGuidance -> ()
576 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
581 isInlineRuleSource :: UnfoldingSource -> Bool
582 isInlineRuleSource InlineCompulsory = True
583 isInlineRuleSource InlineRule = True
584 isInlineRuleSource (InlineWrapper {}) = True
585 isInlineRuleSource InlineRhs = False
587 -- | Retrieves the template of an unfolding: panics if none is known
588 unfoldingTemplate :: Unfolding -> CoreExpr
589 unfoldingTemplate = uf_tmpl
591 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
592 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
594 -- | Retrieves the template of an unfolding if possible
595 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
596 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
597 maybeUnfoldingTemplate _ = Nothing
599 -- | The constructors that the unfolding could never be:
600 -- returns @[]@ if no information is available
601 otherCons :: Unfolding -> [AltCon]
602 otherCons (OtherCon cons) = cons
605 -- | Determines if it is certainly the case that the unfolding will
606 -- yield a value (something in HNF): returns @False@ if unsure
607 isValueUnfolding :: Unfolding -> Bool
608 -- Returns False for OtherCon
609 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
610 isValueUnfolding _ = False
612 -- | Determines if it possibly the case that the unfolding will
613 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
615 isEvaldUnfolding :: Unfolding -> Bool
616 -- Returns True for OtherCon
617 isEvaldUnfolding (OtherCon _) = True
618 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
619 isEvaldUnfolding _ = False
621 -- | @True@ if the unfolding is a constructor application, the application
622 -- of a CONLIKE function or 'OtherCon'
623 isConLikeUnfolding :: Unfolding -> Bool
624 isConLikeUnfolding (OtherCon _) = True
625 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
626 isConLikeUnfolding _ = False
628 -- | Is the thing we will unfold into certainly cheap?
629 isCheapUnfolding :: Unfolding -> Bool
630 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
631 isCheapUnfolding _ = False
633 isExpandableUnfolding :: Unfolding -> Bool
634 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
635 isExpandableUnfolding _ = False
637 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
638 -- Expand an expandable unfolding; this is used in rule matching
639 -- See Note [Expanding variables] in Rules.lhs
640 -- The key point here is that CONLIKE things can be expanded
641 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
642 expandUnfolding_maybe _ = Nothing
644 isInlineRule :: Unfolding -> Bool
645 isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
646 isInlineRule _ = False
648 isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
649 isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
650 | isInlineRuleSource src
651 = Just (src, unsat_ok)
653 unsat_ok = case guide of
654 UnfWhen unsat_ok _ -> unsat_ok
656 isInlineRule_maybe _ = Nothing
658 isCompulsoryUnfolding :: Unfolding -> Bool
659 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
660 isCompulsoryUnfolding _ = False
662 isStableUnfolding :: Unfolding -> Bool
663 -- True of unfoldings that should not be overwritten
664 -- by a CoreUnfolding for the RHS of a let-binding
665 isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
666 isStableUnfolding (DFunUnfolding {}) = True
667 isStableUnfolding _ = False
669 unfoldingArity :: Unfolding -> Arity
670 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
671 unfoldingArity _ = panic "unfoldingArity"
673 isClosedUnfolding :: Unfolding -> Bool -- No free variables
674 isClosedUnfolding (CoreUnfolding {}) = False
675 isClosedUnfolding (DFunUnfolding {}) = False
676 isClosedUnfolding _ = True
678 -- | Only returns False if there is no unfolding information available at all
679 hasSomeUnfolding :: Unfolding -> Bool
680 hasSomeUnfolding NoUnfolding = False
681 hasSomeUnfolding _ = True
683 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
684 neverUnfoldGuidance UnfNever = True
685 neverUnfoldGuidance _ = False
687 canUnfold :: Unfolding -> Bool
688 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
697 you intend that calls (f e) are replaced by <rhs>[e/x] So we
698 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
699 with it. Meanwhile, we can optimise <rhs> to our heart's content,
700 leaving the original unfolding intact in Unfolding of 'f'. For example
701 all xs = foldr (&&) True xs
702 any p = all . map p {-# INLINE any #-}
703 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
704 which deforests well at the call site.
706 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
708 Moreover, it's only used when 'f' is applied to the
709 specified number of arguments; that is, the number of argument on
710 the LHS of the '=' sign in the original source definition.
711 For example, (.) is now defined in the libraries like this
713 (.) f g = \x -> f (g x)
714 so that it'll inline when applied to two arguments. If 'x' appeared
717 it'd only inline when applied to three arguments. This slightly-experimental
718 change was requested by Roman, but it seems to make sense.
720 See also Note [Inlining an InlineRule] in CoreUnfold.
723 Note [OccInfo in unfoldings and rules]
724 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
725 In unfoldings and rules, we guarantee that the template is occ-analysed,
726 so that the occurence info on the binders is correct. This is important,
727 because the Simplifier does not re-analyse the template when using it. If
728 the occurrence info is wrong
729 - We may get more simpifier iterations than necessary, because
730 once-occ info isn't there
731 - More seriously, we may get an infinite loop if there's a Rec
732 without a loop breaker marked
735 %************************************************************************
737 \subsection{The main data type}
739 %************************************************************************
742 -- The Ord is needed for the FiniteMap used in the lookForConstructor
743 -- in SimplEnv. If you declared that lookForConstructor *ignores*
744 -- constructor-applications with LitArg args, then you could get
747 instance Outputable AltCon where
748 ppr (DataAlt dc) = ppr dc
749 ppr (LitAlt lit) = ppr lit
750 ppr DEFAULT = ptext (sLit "__DEFAULT")
752 instance Show AltCon where
753 showsPrec p con = showsPrecSDoc p (ppr con)
755 cmpAlt :: Alt b -> Alt b -> Ordering
756 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
758 ltAlt :: Alt b -> Alt b -> Bool
759 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
761 cmpAltCon :: AltCon -> AltCon -> Ordering
762 -- ^ Compares 'AltCon's within a single list of alternatives
763 cmpAltCon DEFAULT DEFAULT = EQ
764 cmpAltCon DEFAULT _ = LT
766 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
767 cmpAltCon (DataAlt _) DEFAULT = GT
768 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
769 cmpAltCon (LitAlt _) DEFAULT = GT
771 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
772 ppr con1 <+> ppr con2 )
776 %************************************************************************
778 \subsection{Useful synonyms}
780 %************************************************************************
783 -- | The common case for the type of binders and variables when
784 -- we are manipulating the Core language within GHC
786 -- | Expressions where binders are 'CoreBndr's
787 type CoreExpr = Expr CoreBndr
788 -- | Argument expressions where binders are 'CoreBndr's
789 type CoreArg = Arg CoreBndr
790 -- | Binding groups where binders are 'CoreBndr's
791 type CoreBind = Bind CoreBndr
792 -- | Case alternatives where binders are 'CoreBndr's
793 type CoreAlt = Alt CoreBndr
796 %************************************************************************
800 %************************************************************************
803 -- | Binders are /tagged/ with a t
804 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
806 type TaggedBind t = Bind (TaggedBndr t)
807 type TaggedExpr t = Expr (TaggedBndr t)
808 type TaggedArg t = Arg (TaggedBndr t)
809 type TaggedAlt t = Alt (TaggedBndr t)
811 instance Outputable b => Outputable (TaggedBndr b) where
812 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
814 instance Outputable b => OutputableBndr (TaggedBndr b) where
815 pprBndr _ b = ppr b -- Simple
819 %************************************************************************
821 \subsection{Core-constructing functions with checking}
823 %************************************************************************
826 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
827 -- use 'CoreUtils.mkCoreApps' if possible
828 mkApps :: Expr b -> [Arg b] -> Expr b
829 -- | Apply a list of type argument expressions to a function expression in a nested fashion
830 mkTyApps :: Expr b -> [Type] -> Expr b
831 -- | Apply a list of type or value variables to a function expression in a nested fashion
832 mkVarApps :: Expr b -> [Var] -> Expr b
833 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
834 -- use 'MkCore.mkCoreConApps' if possible
835 mkConApp :: DataCon -> [Arg b] -> Expr b
837 mkApps f args = foldl App f args
838 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
839 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
840 mkConApp con args = mkApps (Var (dataConWorkId con)) args
843 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
844 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
845 mkIntLit :: Integer -> Expr b
846 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
847 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
848 mkIntLitInt :: Int -> Expr b
850 mkIntLit n = Lit (mkMachInt n)
851 mkIntLitInt n = Lit (mkMachInt (toInteger n))
853 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
854 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
855 mkWordLit :: Integer -> Expr b
856 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
857 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
858 mkWordLitWord :: Word -> Expr b
860 mkWordLit w = Lit (mkMachWord w)
861 mkWordLitWord w = Lit (mkMachWord (toInteger w))
863 -- | Create a machine character literal expression of type @Char#@.
864 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
865 mkCharLit :: Char -> Expr b
866 -- | Create a machine string literal expression of type @Addr#@.
867 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
868 mkStringLit :: String -> Expr b
870 mkCharLit c = Lit (mkMachChar c)
871 mkStringLit s = Lit (mkMachString s)
873 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
874 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
875 mkFloatLit :: Rational -> Expr b
876 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
877 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
878 mkFloatLitFloat :: Float -> Expr b
880 mkFloatLit f = Lit (mkMachFloat f)
881 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
883 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
884 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
885 mkDoubleLit :: Rational -> Expr b
886 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
887 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
888 mkDoubleLitDouble :: Double -> Expr b
890 mkDoubleLit d = Lit (mkMachDouble d)
891 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
893 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
894 -- use 'CoreUtils.mkCoreLets' if possible
895 mkLets :: [Bind b] -> Expr b -> Expr b
896 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
897 -- use 'CoreUtils.mkCoreLams' if possible
898 mkLams :: [b] -> Expr b -> Expr b
900 mkLams binders body = foldr Lam body binders
901 mkLets binds body = foldr Let body binds
904 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
905 -- this can only be used to bind something in a non-recursive @let@ expression
906 mkTyBind :: TyVar -> Type -> CoreBind
907 mkTyBind tv ty = NonRec tv (Type ty)
909 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
910 varToCoreExpr :: CoreBndr -> Expr b
911 varToCoreExpr v | isId v = Var v
912 | otherwise = Type (mkTyVarTy v)
914 varsToCoreExprs :: [CoreBndr] -> [Expr b]
915 varsToCoreExprs vs = map varToCoreExpr vs
919 %************************************************************************
921 \subsection{Simple access functions}
923 %************************************************************************
926 -- | Extract every variable by this group
927 bindersOf :: Bind b -> [b]
928 bindersOf (NonRec binder _) = [binder]
929 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
931 -- | 'bindersOf' applied to a list of binding groups
932 bindersOfBinds :: [Bind b] -> [b]
933 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
935 rhssOfBind :: Bind b -> [Expr b]
936 rhssOfBind (NonRec _ rhs) = [rhs]
937 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
939 rhssOfAlts :: [Alt b] -> [Expr b]
940 rhssOfAlts alts = [e | (_,_,e) <- alts]
942 -- | Collapse all the bindings in the supplied groups into a single
943 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
944 flattenBinds :: [Bind b] -> [(b, Expr b)]
945 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
946 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
951 -- | We often want to strip off leading lambdas before getting down to
952 -- business. This function is your friend.
953 collectBinders :: Expr b -> ([b], Expr b)
954 -- | Collect as many type bindings as possible from the front of a nested lambda
955 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
956 -- | Collect as many value bindings as possible from the front of a nested lambda
957 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
958 -- | Collect type binders from the front of the lambda first,
959 -- then follow up by collecting as many value bindings as possible
960 -- from the resulting stripped expression
961 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
966 go bs (Lam b e) = go (b:bs) e
967 go bs e = (reverse bs, e)
969 collectTyAndValBinders expr
972 (tvs, body1) = collectTyBinders expr
973 (ids, body) = collectValBinders body1
975 collectTyBinders expr
978 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
979 go tvs e = (reverse tvs, e)
981 collectValBinders expr
984 go ids (Lam b e) | isId b = go (b:ids) e
985 go ids body = (reverse ids, body)
989 -- | Takes a nested application expression and returns the the function
990 -- being applied and the arguments to which it is applied
991 collectArgs :: Expr b -> (Expr b, [Arg b])
995 go (App f a) as = go f (a:as)
1000 -- | Gets the cost centre enclosing an expression, if any.
1001 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1002 coreExprCc :: Expr b -> CostCentre
1003 coreExprCc (Note (SCC cc) _) = cc
1004 coreExprCc (Note _ e) = coreExprCc e
1005 coreExprCc (Lam _ e) = coreExprCc e
1006 coreExprCc _ = noCostCentre
1009 %************************************************************************
1011 \subsection{Predicates}
1013 %************************************************************************
1015 At one time we optionally carried type arguments through to runtime.
1016 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1017 i.e. if type applications are actual lambdas because types are kept around
1018 at runtime. Similarly isRuntimeArg.
1021 -- | Will this variable exist at runtime?
1022 isRuntimeVar :: Var -> Bool
1025 -- | Will this argument expression exist at runtime?
1026 isRuntimeArg :: CoreExpr -> Bool
1027 isRuntimeArg = isValArg
1029 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1030 isValArg :: Expr b -> Bool
1031 isValArg (Type _) = False
1034 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1035 isTypeArg :: Expr b -> Bool
1036 isTypeArg (Type _) = True
1039 -- | The number of binders that bind values rather than types
1040 valBndrCount :: [CoreBndr] -> Int
1041 valBndrCount = count isId
1043 -- | The number of argument expressions that are values rather than types at their top level
1044 valArgCount :: [Arg b] -> Int
1045 valArgCount = count isValArg
1049 %************************************************************************
1051 \subsection{Seq stuff}
1053 %************************************************************************
1056 seqExpr :: CoreExpr -> ()
1057 seqExpr (Var v) = v `seq` ()
1058 seqExpr (Lit lit) = lit `seq` ()
1059 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1060 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1061 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1062 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1063 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1064 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1065 seqExpr (Type t) = seqType t
1067 seqExprs :: [CoreExpr] -> ()
1069 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1071 seqNote :: Note -> ()
1072 seqNote (CoreNote s) = s `seq` ()
1075 seqBndr :: CoreBndr -> ()
1076 seqBndr b = b `seq` ()
1078 seqBndrs :: [CoreBndr] -> ()
1080 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1082 seqBind :: Bind CoreBndr -> ()
1083 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1084 seqBind (Rec prs) = seqPairs prs
1086 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1088 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1090 seqAlts :: [CoreAlt] -> ()
1092 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1094 seqRules :: [CoreRule] -> ()
1096 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1097 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1098 seqRules (BuiltinRule {} : rules) = seqRules rules
1101 %************************************************************************
1103 \subsection{Annotated core}
1105 %************************************************************************
1108 -- | Annotated core: allows annotation at every node in the tree
1109 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1111 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1112 data AnnExpr' bndr annot
1115 | AnnLam bndr (AnnExpr bndr annot)
1116 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1117 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1118 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1119 | AnnCast (AnnExpr bndr annot) Coercion
1120 | AnnNote Note (AnnExpr bndr annot)
1123 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1124 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1126 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1127 data AnnBind bndr annot
1128 = AnnNonRec bndr (AnnExpr bndr annot)
1129 | AnnRec [(bndr, AnnExpr bndr annot)]
1133 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1134 deAnnotate (_, e) = deAnnotate' e
1136 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1137 deAnnotate' (AnnType t) = Type t
1138 deAnnotate' (AnnVar v) = Var v
1139 deAnnotate' (AnnLit lit) = Lit lit
1140 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1141 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1142 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1143 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1145 deAnnotate' (AnnLet bind body)
1146 = Let (deAnnBind bind) (deAnnotate body)
1148 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1149 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1151 deAnnotate' (AnnCase scrut v t alts)
1152 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1154 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1155 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1159 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1160 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1164 collect bs (_, AnnLam b body) = collect (b:bs) body
1165 collect bs body = (reverse bs, body)