2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
7 {-# LANGUAGE DeriveDataTypeable #-}
9 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
12 Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
13 CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
14 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
16 -- ** 'Expr' construction
18 mkApps, mkTyApps, mkVarApps,
20 mkIntLit, mkIntLitInt,
21 mkWordLit, mkWordLitWord,
22 mkCharLit, mkStringLit,
23 mkFloatLit, mkFloatLitFloat,
24 mkDoubleLit, mkDoubleLitDouble,
27 varToCoreExpr, varsToCoreExprs,
29 isTyCoVar, isId, cmpAltCon, cmpAlt, ltAlt,
31 -- ** Simple 'Expr' access functions and predicates
32 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
33 collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
34 collectArgs, coreExprCc, flattenBinds,
36 isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
39 -- * Unfolding data types
40 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
41 -- Abstract everywhere but in CoreUnfold.lhs
43 -- ** Constructing 'Unfolding's
44 noUnfolding, evaldUnfolding, mkOtherCon,
45 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
47 -- ** Predicates and deconstruction on 'Unfolding'
48 unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
49 maybeUnfoldingTemplate, otherCons, unfoldingArity,
50 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
51 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
52 isStableUnfolding, isStableUnfolding_maybe,
53 isClosedUnfolding, hasSomeUnfolding,
54 canUnfold, neverUnfoldGuidance, isStableSource,
57 seqExpr, seqExprs, seqUnfolding,
59 -- * Annotated expression data types
60 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
62 -- ** Operations on annotations
63 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
65 -- * Core rule data types
66 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
67 RuleName, IdUnfoldingFun,
69 -- ** Operations on 'CoreRule's
70 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
72 isBuiltinRule, isLocalRule
75 #include "HsVersions.h"
92 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`
93 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
96 %************************************************************************
98 \subsection{The main data types}
100 %************************************************************************
102 These data types are the heart of the compiler
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_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
340 -- @False@ <=> generated at the users behest
341 -- Main effect: reporting of orphan-hood
343 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
344 -- defined in the same module as the rule
345 -- and is not an implicit 'Id' (like a record selector,
346 -- class operation, or data constructor)
348 -- NB: ru_local is *not* used to decide orphan-hood
349 -- c.g. MkIface.coreRuleToIfaceRule
352 -- | Built-in rules are used for constant folding
353 -- and suchlike. They have no free variables.
355 ru_name :: RuleName, -- ^ As above
356 ru_fn :: Name, -- ^ As above
357 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
358 -- if it fires, including type arguments
359 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
360 -- ^ This function does the rewrite. It given too many
361 -- arguments, it simply discards them; the returned 'CoreExpr'
362 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
364 -- See Note [Extra args in rule matching] in Rules.lhs
366 type IdUnfoldingFun = Id -> Unfolding
367 -- A function that embodies how to unfold an Id if you need
368 -- to do that in the Rule. The reason we need to pass this info in
369 -- is that whether an Id is unfoldable depends on the simplifier phase
371 isBuiltinRule :: CoreRule -> Bool
372 isBuiltinRule (BuiltinRule {}) = True
373 isBuiltinRule _ = False
375 -- | The number of arguments the 'ru_fn' must be applied
376 -- to before the rule can match on it
377 ruleArity :: CoreRule -> Int
378 ruleArity (BuiltinRule {ru_nargs = n}) = n
379 ruleArity (Rule {ru_args = args}) = length args
381 ruleName :: CoreRule -> RuleName
384 ruleActivation_maybe :: CoreRule -> Maybe Activation
385 ruleActivation_maybe (BuiltinRule { }) = Nothing
386 ruleActivation_maybe (Rule { ru_act = act }) = Just act
388 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
389 ruleIdName :: CoreRule -> Name
392 isLocalRule :: CoreRule -> Bool
393 isLocalRule = ru_local
395 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
396 setRuleIdName :: Name -> CoreRule -> CoreRule
397 setRuleIdName nm ru = ru { ru_fn = nm }
401 %************************************************************************
405 %************************************************************************
407 The @Unfolding@ type is declared here to avoid numerous loops
410 -- | Records the /unfolding/ of an identifier, which is approximately the form the
411 -- identifier would have if we substituted its definition in for the identifier.
412 -- This type should be treated as abstract everywhere except in "CoreUnfold"
414 = NoUnfolding -- ^ We have no information about the unfolding
416 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
417 -- @OtherCon xs@ also indicates that something has been evaluated
418 -- and hence there's no point in re-evaluating it.
419 -- @OtherCon []@ is used even for non-data-type values
420 -- to indicated evaluated-ness. Notably:
422 -- > data C = C !(Int -> Int)
423 -- > case x of { C f -> ... }
425 -- Here, @f@ gets an @OtherCon []@ unfolding.
427 | DFunUnfolding -- The Unfolding of a DFunId
428 -- See Note [DFun unfoldings]
429 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
430 -- (op2 a1..am d1..dn)
432 Arity -- Arity = m+n, the *total* number of args
433 -- (unusually, both type and value) to the dfun
435 DataCon -- The dictionary data constructor (possibly a newtype datacon)
437 [CoreExpr] -- The [CoreExpr] are the superclasses and methods [op1,op2],
438 -- in positional order.
439 -- They are usually variables, but can be trivial expressions
440 -- instead (e.g. a type application).
442 | CoreUnfolding { -- An unfolding for an Id with no pragma,
443 -- or perhaps a NOINLINE pragma
444 -- (For NOINLINE, the phase, if any, is in the
445 -- InlinePragInfo for this Id.)
446 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
447 uf_src :: UnfoldingSource, -- Where the unfolding came from
448 uf_is_top :: Bool, -- True <=> top level binding
449 uf_arity :: Arity, -- Number of value arguments expected
450 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
451 -- a `seq` on this variable
452 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
453 -- Cached version of exprIsConLike
454 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand
455 -- inside an inlining
456 -- Cached version of exprIsCheap
457 uf_expandable :: Bool, -- True <=> can expand in RULE matching
458 -- Cached version of exprIsExpandable
459 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
461 -- ^ An unfolding with redundant cached information. Parameters:
463 -- uf_tmpl: Template used to perform unfolding;
464 -- NB: Occurrence info is guaranteed correct:
465 -- see Note [OccInfo in unfoldings and rules]
467 -- uf_is_top: Is this a top level binding?
469 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
472 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
473 -- Basically this is a cached version of 'exprIsCheap'
475 -- uf_guidance: Tells us about the /size/ of the unfolding template
477 ------------------------------------------------
479 = InlineRhs -- The current rhs of the function
480 -- Replace uf_tmpl each time around
482 | InlineStable -- From an INLINE or INLINABLE pragma
483 -- Do not replace uf_tmpl; instead, keep it unchanged
484 -- See Note [InlineRules]
486 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
487 -- Only a few primop-like things have this property
488 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
489 -- Inline absolutely always, however boring the context.
491 | InlineWrapper Id -- This unfolding is a the wrapper in a
492 -- worker/wrapper split from the strictness analyser
493 -- The Id is the worker-id
494 -- Used to abbreviate the uf_tmpl in interface files
495 -- which don't need to contain the RHS;
496 -- it can be derived from the strictness info
500 -- | 'UnfoldingGuidance' says when unfolding should take place
501 data UnfoldingGuidance
502 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
503 -- Used (a) for small *and* cheap unfoldings
504 -- (b) for INLINE functions
505 -- See Note [INLINE for small functions] in CoreUnfold
506 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
507 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
508 -- So True,True means "always"
511 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
512 -- result of a simple analysis of the RHS
514 ug_args :: [Int], -- Discount if the argument is evaluated.
515 -- (i.e., a simplification will definitely
516 -- be possible). One elt of the list per *value* arg.
518 ug_size :: Int, -- The "size" of the unfolding.
520 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
521 } -- a context (case (thing args) of ...),
522 -- (where there are the right number of arguments.)
524 | UnfNever -- The RHS is big, so don't inline it
528 Note [DFun unfoldings]
529 ~~~~~~~~~~~~~~~~~~~~~~
530 The Arity in a DFunUnfolding is total number of args (type and value)
531 that the DFun needs to produce a dictionary. That's not necessarily
532 related to the ordinary arity of the dfun Id, esp if the class has
533 one method, so the dictionary is represented by a newtype. Example
535 class C a where { op :: a -> Int }
536 instance C a -> C [a] where op xs = op (head xs)
538 The instance translates to
540 $dfCList :: forall a. C a => C [a] -- Arity 2!
541 $dfCList = /\a.\d. $copList {a} d |> co
543 $copList :: forall a. C a => [a] -> Int -- Arity 2!
544 $copList = /\a.\d.\xs. op {a} d (head xs)
546 Now we might encounter (op (dfCList {ty} d) a1 a2)
547 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
548 has all its arguments, even though its (value) arity is 2. That's
549 why we record the number of expected arguments in the DFunUnfolding.
551 Note that although it's an Arity, it's most convenient for it to give
552 the *total* number of arguments, both type and value. See the use
553 site in exprIsConApp_maybe.
556 -- Constants for the UnfWhen constructor
557 needSaturated, unSaturatedOk :: Bool
558 needSaturated = False
561 boringCxtNotOk, boringCxtOk :: Bool
563 boringCxtNotOk = False
565 ------------------------------------------------
566 noUnfolding :: Unfolding
567 -- ^ There is no known 'Unfolding'
568 evaldUnfolding :: Unfolding
569 -- ^ This unfolding marks the associated thing as being evaluated
571 noUnfolding = NoUnfolding
572 evaldUnfolding = OtherCon []
574 mkOtherCon :: [AltCon] -> Unfolding
575 mkOtherCon = OtherCon
577 seqUnfolding :: Unfolding -> ()
578 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
579 uf_is_value = b1, uf_is_cheap = b2,
580 uf_expandable = b3, uf_is_conlike = b4,
581 uf_arity = a, uf_guidance = g})
582 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
586 seqGuidance :: UnfoldingGuidance -> ()
587 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
592 isStableSource :: UnfoldingSource -> Bool
593 -- Keep the unfolding template
594 isStableSource InlineCompulsory = True
595 isStableSource InlineStable = True
596 isStableSource (InlineWrapper {}) = True
597 isStableSource InlineRhs = False
599 -- | Retrieves the template of an unfolding: panics if none is known
600 unfoldingTemplate :: Unfolding -> CoreExpr
601 unfoldingTemplate = uf_tmpl
603 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
604 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
606 -- | Retrieves the template of an unfolding if possible
607 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
608 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
609 maybeUnfoldingTemplate _ = Nothing
611 -- | The constructors that the unfolding could never be:
612 -- returns @[]@ if no information is available
613 otherCons :: Unfolding -> [AltCon]
614 otherCons (OtherCon cons) = cons
617 -- | Determines if it is certainly the case that the unfolding will
618 -- yield a value (something in HNF): returns @False@ if unsure
619 isValueUnfolding :: Unfolding -> Bool
620 -- Returns False for OtherCon
621 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
622 isValueUnfolding _ = False
624 -- | Determines if it possibly the case that the unfolding will
625 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
627 isEvaldUnfolding :: Unfolding -> Bool
628 -- Returns True for OtherCon
629 isEvaldUnfolding (OtherCon _) = True
630 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
631 isEvaldUnfolding _ = False
633 -- | @True@ if the unfolding is a constructor application, the application
634 -- of a CONLIKE function or 'OtherCon'
635 isConLikeUnfolding :: Unfolding -> Bool
636 isConLikeUnfolding (OtherCon _) = True
637 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
638 isConLikeUnfolding _ = False
640 -- | Is the thing we will unfold into certainly cheap?
641 isCheapUnfolding :: Unfolding -> Bool
642 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
643 isCheapUnfolding _ = False
645 isExpandableUnfolding :: Unfolding -> Bool
646 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
647 isExpandableUnfolding _ = False
649 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
650 -- Expand an expandable unfolding; this is used in rule matching
651 -- See Note [Expanding variables] in Rules.lhs
652 -- The key point here is that CONLIKE things can be expanded
653 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
654 expandUnfolding_maybe _ = Nothing
656 isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
657 isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
659 = Just (src, unsat_ok)
661 unsat_ok = case guide of
662 UnfWhen unsat_ok _ -> unsat_ok
664 isStableUnfolding_maybe _ = Nothing
666 isCompulsoryUnfolding :: Unfolding -> Bool
667 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
668 isCompulsoryUnfolding _ = False
670 isStableUnfolding :: Unfolding -> Bool
671 -- True of unfoldings that should not be overwritten
672 -- by a CoreUnfolding for the RHS of a let-binding
673 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
674 isStableUnfolding (DFunUnfolding {}) = True
675 isStableUnfolding _ = False
677 unfoldingArity :: Unfolding -> Arity
678 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
679 unfoldingArity _ = panic "unfoldingArity"
681 isClosedUnfolding :: Unfolding -> Bool -- No free variables
682 isClosedUnfolding (CoreUnfolding {}) = False
683 isClosedUnfolding (DFunUnfolding {}) = False
684 isClosedUnfolding _ = True
686 -- | Only returns False if there is no unfolding information available at all
687 hasSomeUnfolding :: Unfolding -> Bool
688 hasSomeUnfolding NoUnfolding = False
689 hasSomeUnfolding _ = True
691 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
692 neverUnfoldGuidance UnfNever = True
693 neverUnfoldGuidance _ = False
695 canUnfold :: Unfolding -> Bool
696 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
705 you intend that calls (f e) are replaced by <rhs>[e/x] So we
706 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
707 with it. Meanwhile, we can optimise <rhs> to our heart's content,
708 leaving the original unfolding intact in Unfolding of 'f'. For example
709 all xs = foldr (&&) True xs
710 any p = all . map p {-# INLINE any #-}
711 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
712 which deforests well at the call site.
714 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
716 Moreover, it's only used when 'f' is applied to the
717 specified number of arguments; that is, the number of argument on
718 the LHS of the '=' sign in the original source definition.
719 For example, (.) is now defined in the libraries like this
721 (.) f g = \x -> f (g x)
722 so that it'll inline when applied to two arguments. If 'x' appeared
725 it'd only inline when applied to three arguments. This slightly-experimental
726 change was requested by Roman, but it seems to make sense.
728 See also Note [Inlining an InlineRule] in CoreUnfold.
731 Note [OccInfo in unfoldings and rules]
732 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
733 In unfoldings and rules, we guarantee that the template is occ-analysed,
734 so that the occurence info on the binders is correct. This is important,
735 because the Simplifier does not re-analyse the template when using it. If
736 the occurrence info is wrong
737 - We may get more simpifier iterations than necessary, because
738 once-occ info isn't there
739 - More seriously, we may get an infinite loop if there's a Rec
740 without a loop breaker marked
743 %************************************************************************
745 \subsection{The main data type}
747 %************************************************************************
750 -- The Ord is needed for the FiniteMap used in the lookForConstructor
751 -- in SimplEnv. If you declared that lookForConstructor *ignores*
752 -- constructor-applications with LitArg args, then you could get
755 instance Outputable AltCon where
756 ppr (DataAlt dc) = ppr dc
757 ppr (LitAlt lit) = ppr lit
758 ppr DEFAULT = ptext (sLit "__DEFAULT")
760 instance Show AltCon where
761 showsPrec p con = showsPrecSDoc p (ppr con)
763 cmpAlt :: Alt b -> Alt b -> Ordering
764 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
766 ltAlt :: Alt b -> Alt b -> Bool
767 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
769 cmpAltCon :: AltCon -> AltCon -> Ordering
770 -- ^ Compares 'AltCon's within a single list of alternatives
771 cmpAltCon DEFAULT DEFAULT = EQ
772 cmpAltCon DEFAULT _ = LT
774 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
775 cmpAltCon (DataAlt _) DEFAULT = GT
776 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
777 cmpAltCon (LitAlt _) DEFAULT = GT
779 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
780 ppr con1 <+> ppr con2 )
784 %************************************************************************
786 \subsection{Useful synonyms}
788 %************************************************************************
791 -- | The common case for the type of binders and variables when
792 -- we are manipulating the Core language within GHC
794 -- | Expressions where binders are 'CoreBndr's
795 type CoreExpr = Expr CoreBndr
796 -- | Argument expressions where binders are 'CoreBndr's
797 type CoreArg = Arg CoreBndr
798 -- | Binding groups where binders are 'CoreBndr's
799 type CoreBind = Bind CoreBndr
800 -- | Case alternatives where binders are 'CoreBndr's
801 type CoreAlt = Alt CoreBndr
804 %************************************************************************
808 %************************************************************************
811 -- | Binders are /tagged/ with a t
812 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
814 type TaggedBind t = Bind (TaggedBndr t)
815 type TaggedExpr t = Expr (TaggedBndr t)
816 type TaggedArg t = Arg (TaggedBndr t)
817 type TaggedAlt t = Alt (TaggedBndr t)
819 instance Outputable b => Outputable (TaggedBndr b) where
820 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
822 instance Outputable b => OutputableBndr (TaggedBndr b) where
823 pprBndr _ b = ppr b -- Simple
827 %************************************************************************
829 \subsection{Core-constructing functions with checking}
831 %************************************************************************
834 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
835 -- use 'CoreUtils.mkCoreApps' if possible
836 mkApps :: Expr b -> [Arg b] -> Expr b
837 -- | Apply a list of type argument expressions to a function expression in a nested fashion
838 mkTyApps :: Expr b -> [Type] -> Expr b
839 -- | Apply a list of type or value variables to a function expression in a nested fashion
840 mkVarApps :: Expr b -> [Var] -> Expr b
841 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
842 -- use 'MkCore.mkCoreConApps' if possible
843 mkConApp :: DataCon -> [Arg b] -> Expr b
845 mkApps f args = foldl App f args
846 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
847 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
848 mkConApp con args = mkApps (Var (dataConWorkId con)) args
851 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
852 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
853 mkIntLit :: Integer -> Expr b
854 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
855 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
856 mkIntLitInt :: Int -> Expr b
858 mkIntLit n = Lit (mkMachInt n)
859 mkIntLitInt n = Lit (mkMachInt (toInteger n))
861 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
862 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
863 mkWordLit :: Integer -> Expr b
864 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
865 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
866 mkWordLitWord :: Word -> Expr b
868 mkWordLit w = Lit (mkMachWord w)
869 mkWordLitWord w = Lit (mkMachWord (toInteger w))
871 -- | Create a machine character literal expression of type @Char#@.
872 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
873 mkCharLit :: Char -> Expr b
874 -- | Create a machine string literal expression of type @Addr#@.
875 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
876 mkStringLit :: String -> Expr b
878 mkCharLit c = Lit (mkMachChar c)
879 mkStringLit s = Lit (mkMachString s)
881 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
882 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
883 mkFloatLit :: Rational -> Expr b
884 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
885 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
886 mkFloatLitFloat :: Float -> Expr b
888 mkFloatLit f = Lit (mkMachFloat f)
889 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
891 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
892 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
893 mkDoubleLit :: Rational -> Expr b
894 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
895 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
896 mkDoubleLitDouble :: Double -> Expr b
898 mkDoubleLit d = Lit (mkMachDouble d)
899 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
901 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
902 -- use 'CoreUtils.mkCoreLets' if possible
903 mkLets :: [Bind b] -> Expr b -> Expr b
904 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
905 -- use 'CoreUtils.mkCoreLams' if possible
906 mkLams :: [b] -> Expr b -> Expr b
908 mkLams binders body = foldr Lam body binders
909 mkLets binds body = foldr Let body binds
912 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
913 -- this can only be used to bind something in a non-recursive @let@ expression
914 mkTyBind :: TyVar -> Type -> CoreBind
915 mkTyBind tv ty = NonRec tv (Type ty)
917 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
918 varToCoreExpr :: CoreBndr -> Expr b
919 varToCoreExpr v | isId v = Var v
920 | otherwise = Type (mkTyVarTy v)
922 varsToCoreExprs :: [CoreBndr] -> [Expr b]
923 varsToCoreExprs vs = map varToCoreExpr vs
927 %************************************************************************
929 \subsection{Simple access functions}
931 %************************************************************************
934 -- | Extract every variable by this group
935 bindersOf :: Bind b -> [b]
936 bindersOf (NonRec binder _) = [binder]
937 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
939 -- | 'bindersOf' applied to a list of binding groups
940 bindersOfBinds :: [Bind b] -> [b]
941 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
943 rhssOfBind :: Bind b -> [Expr b]
944 rhssOfBind (NonRec _ rhs) = [rhs]
945 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
947 rhssOfAlts :: [Alt b] -> [Expr b]
948 rhssOfAlts alts = [e | (_,_,e) <- alts]
950 -- | Collapse all the bindings in the supplied groups into a single
951 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
952 flattenBinds :: [Bind b] -> [(b, Expr b)]
953 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
954 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
959 -- | We often want to strip off leading lambdas before getting down to
960 -- business. This function is your friend.
961 collectBinders :: Expr b -> ([b], Expr b)
962 -- | Collect as many type bindings as possible from the front of a nested lambda
963 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
964 -- | Collect as many value bindings as possible from the front of a nested lambda
965 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
966 -- | Collect type binders from the front of the lambda first,
967 -- then follow up by collecting as many value bindings as possible
968 -- from the resulting stripped expression
969 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
974 go bs (Lam b e) = go (b:bs) e
975 go bs e = (reverse bs, e)
977 collectTyAndValBinders expr
980 (tvs, body1) = collectTyBinders expr
981 (ids, body) = collectValBinders body1
983 collectTyBinders expr
986 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
987 go tvs e = (reverse tvs, e)
989 collectValBinders expr
992 go ids (Lam b e) | isId b = go (b:ids) e
993 go ids body = (reverse ids, body)
997 -- | Takes a nested application expression and returns the the function
998 -- being applied and the arguments to which it is applied
999 collectArgs :: Expr b -> (Expr b, [Arg b])
1003 go (App f a) as = go f (a:as)
1008 -- | Gets the cost centre enclosing an expression, if any.
1009 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1010 coreExprCc :: Expr b -> CostCentre
1011 coreExprCc (Note (SCC cc) _) = cc
1012 coreExprCc (Note _ e) = coreExprCc e
1013 coreExprCc (Lam _ e) = coreExprCc e
1014 coreExprCc _ = noCostCentre
1017 %************************************************************************
1019 \subsection{Predicates}
1021 %************************************************************************
1023 At one time we optionally carried type arguments through to runtime.
1024 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1025 i.e. if type applications are actual lambdas because types are kept around
1026 at runtime. Similarly isRuntimeArg.
1029 -- | Will this variable exist at runtime?
1030 isRuntimeVar :: Var -> Bool
1033 -- | Will this argument expression exist at runtime?
1034 isRuntimeArg :: CoreExpr -> Bool
1035 isRuntimeArg = isValArg
1037 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1038 isValArg :: Expr b -> Bool
1039 isValArg (Type _) = False
1042 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1043 isTypeArg :: Expr b -> Bool
1044 isTypeArg (Type _) = True
1047 -- | The number of binders that bind values rather than types
1048 valBndrCount :: [CoreBndr] -> Int
1049 valBndrCount = count isId
1051 -- | The number of argument expressions that are values rather than types at their top level
1052 valArgCount :: [Arg b] -> Int
1053 valArgCount = count isValArg
1055 notSccNote :: Note -> Bool
1056 notSccNote (SCC {}) = False
1061 %************************************************************************
1063 \subsection{Seq stuff}
1065 %************************************************************************
1068 seqExpr :: CoreExpr -> ()
1069 seqExpr (Var v) = v `seq` ()
1070 seqExpr (Lit lit) = lit `seq` ()
1071 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1072 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1073 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1074 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1075 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1076 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1077 seqExpr (Type t) = seqType t
1079 seqExprs :: [CoreExpr] -> ()
1081 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1083 seqNote :: Note -> ()
1084 seqNote (CoreNote s) = s `seq` ()
1087 seqBndr :: CoreBndr -> ()
1088 seqBndr b = b `seq` ()
1090 seqBndrs :: [CoreBndr] -> ()
1092 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1094 seqBind :: Bind CoreBndr -> ()
1095 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1096 seqBind (Rec prs) = seqPairs prs
1098 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1100 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1102 seqAlts :: [CoreAlt] -> ()
1104 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1106 seqRules :: [CoreRule] -> ()
1108 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1109 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1110 seqRules (BuiltinRule {} : rules) = seqRules rules
1113 %************************************************************************
1115 \subsection{Annotated core}
1117 %************************************************************************
1120 -- | Annotated core: allows annotation at every node in the tree
1121 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1123 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1124 data AnnExpr' bndr annot
1127 | AnnLam bndr (AnnExpr bndr annot)
1128 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1129 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1130 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1131 | AnnCast (AnnExpr bndr annot) Coercion
1132 | AnnNote Note (AnnExpr bndr annot)
1135 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1136 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1138 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1139 data AnnBind bndr annot
1140 = AnnNonRec bndr (AnnExpr bndr annot)
1141 | AnnRec [(bndr, AnnExpr bndr annot)]
1145 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1146 deAnnotate (_, e) = deAnnotate' e
1148 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1149 deAnnotate' (AnnType t) = Type t
1150 deAnnotate' (AnnVar v) = Var v
1151 deAnnotate' (AnnLit lit) = Lit lit
1152 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1153 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1154 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1155 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1157 deAnnotate' (AnnLet bind body)
1158 = Let (deAnnBind bind) (deAnnotate body)
1160 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1161 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1163 deAnnotate' (AnnCase scrut v t alts)
1164 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1166 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1167 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1171 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1172 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1176 collect bs (_, AnnLam b body) = collect (b:bs) body
1177 collect bs body = (reverse bs, body)