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,
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`, `App`
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 -- | 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
139 | Lit Literal -- ^ Primitive literals
141 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
143 -- See "CoreSyn#let_app_invariant" for another invariant
145 | Lam b (Expr b) -- ^ Lambda abstraction
147 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
148 -- this corresponds to allocating a thunk for the things
149 -- bound and then executing the sub-expression.
151 -- #top_level_invariant#
152 -- #letrec_invariant#
154 -- The right hand sides of all top-level and recursive @let@s
155 -- /must/ be of lifted type (see "Type#type_classification" for
156 -- the meaning of /lifted/ vs. /unlifted/).
158 -- #let_app_invariant#
159 -- The right hand side of of a non-recursive 'Let'
160 -- _and_ the argument of an 'App',
161 -- /may/ be of unlifted type, but only if the expression
162 -- is ok-for-speculation. This means that the let can be floated
163 -- around without difficulty. For example, this is OK:
165 -- > y::Int# = x +# 1#
167 -- But this is not, as it may affect termination if the
168 -- expression is floated out:
170 -- > y::Int# = fac 4#
172 -- In this situation you should use @case@ rather than a @let@. The function
173 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
174 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
175 -- which will generate a @case@ if necessary
178 -- We allow a /non-recursive/ let to bind a type variable, thus:
180 -- > Let (NonRec tv (Type ty)) body
182 -- This can be very convenient for postponing type substitutions until
183 -- the next run of the simplifier.
185 -- At the moment, the rest of the compiler only deals with type-let
186 -- in a Let expression, rather than at top level. We may want to revist
189 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
190 -- the scrutinee (expression examined) to weak head normal form
191 -- and then examining at most one level of resulting constructor (i.e. you
192 -- cannot do nested pattern matching directly with this).
194 -- The binder gets bound to the value of the scrutinee,
195 -- and the 'Type' must be that of all the case alternatives
198 -- This is one of the more complicated elements of the Core language,
199 -- and comes with a number of restrictions:
201 -- The 'DEFAULT' case alternative must be first in the list,
202 -- if it occurs at all.
204 -- The remaining cases are in order of increasing
205 -- tag (for 'DataAlts') or
206 -- lit (for 'LitAlts').
207 -- This makes finding the relevant constructor easy,
208 -- and makes comparison easier too.
210 -- The list of alternatives must be exhaustive. An /exhaustive/ case
211 -- does not necessarily mention all constructors:
214 -- data Foo = Red | Green | Blue
217 -- other -> f (case x of
222 -- The inner case does not need a @Red@ alternative, because @x@
223 -- can't be @Red@ at that program point.
225 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type.
226 -- This is used to implement @newtype@s (a @newtype@ constructor or
227 -- destructor just becomes a 'Cast' in Core) and GADTs.
229 | Note Note (Expr b) -- ^ Notes. These allow general information to be
230 -- added to expressions in the syntax tree
232 | Type Type -- ^ A type: this should only show up at the top
234 deriving (Data, Typeable)
236 -- | Type synonym for expressions that occur in function argument positions.
237 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
240 -- | A case split alternative. Consists of the constructor leading to the alternative,
241 -- the variables bound from the constructor, and the expression to be executed given that binding.
242 -- The default alternative is @(DEFAULT, [], rhs)@
243 type Alt b = (AltCon, [b], Expr b)
245 -- | A case alternative constructor (i.e. pattern match)
246 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
247 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
248 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
249 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
250 deriving (Eq, Ord, Data, Typeable)
252 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
253 data Bind b = NonRec b (Expr b)
254 | Rec [(b, (Expr b))]
255 deriving (Data, Typeable)
258 -------------------------- CoreSyn INVARIANTS ---------------------------
260 Note [CoreSyn top-level invariant]
261 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
262 See #toplevel_invariant#
264 Note [CoreSyn letrec invariant]
265 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
266 See #letrec_invariant#
268 Note [CoreSyn let/app invariant]
269 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
270 See #let_app_invariant#
272 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
274 Note [CoreSyn case invariants]
275 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
276 See #case_invariants#
278 Note [CoreSyn let goal]
279 ~~~~~~~~~~~~~~~~~~~~~~~
280 * The simplifier tries to ensure that if the RHS of a let is a constructor
281 application, its arguments are trivial, so that the constructor can be
291 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
293 = SCC CostCentre -- ^ A cost centre annotation for profiling
294 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
295 deriving (Data, Typeable)
299 %************************************************************************
301 \subsection{Transformation rules}
303 %************************************************************************
305 The CoreRule type and its friends are dealt with mainly in CoreRules,
306 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
309 -- | A 'CoreRule' is:
311 -- * \"Local\" if the function it is a rule for is defined in the
312 -- same module as the rule itself.
314 -- * \"Orphan\" if nothing on the LHS is defined in the same module
315 -- as the rule itself
318 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
319 ru_act :: Activation, -- ^ When the rule is active
321 -- Rough-matching stuff
322 -- see comments with InstEnv.Instance( is_cls, is_rough )
323 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
324 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
326 -- Proper-matching stuff
327 -- see comments with InstEnv.Instance( is_tvs, is_tys )
328 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
329 ru_args :: [CoreExpr], -- ^ Left hand side arguments
331 -- And the right-hand side
332 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
333 -- Occurrence info is guaranteed correct
334 -- See Note [OccInfo in unfoldings and rules]
337 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
338 -- defined in the same module as the rule
339 -- and is not an implicit 'Id' (like a record selector,
340 -- class operation, or data constructor)
342 -- NB: ru_local is *not* used to decide orphan-hood
343 -- c.g. MkIface.coreRuleToIfaceRule
346 -- | Built-in rules are used for constant folding
347 -- and suchlike. They have no free variables.
349 ru_name :: RuleName, -- ^ As above
350 ru_fn :: Name, -- ^ As above
351 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
352 -- if it fires, including type arguments
353 ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
354 -- ^ This function does the rewrite. It given too many
355 -- arguments, it simply discards them; the returned 'CoreExpr'
356 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
358 -- See Note [Extra args in rule matching] in Rules.lhs
360 type IdUnfoldingFun = Id -> Unfolding
361 -- A function that embodies how to unfold an Id if you need
362 -- to do that in the Rule. The reason we need to pass this info in
363 -- is that whether an Id is unfoldable depends on the simplifier phase
365 isBuiltinRule :: CoreRule -> Bool
366 isBuiltinRule (BuiltinRule {}) = True
367 isBuiltinRule _ = False
369 -- | The number of arguments the 'ru_fn' must be applied
370 -- to before the rule can match on it
371 ruleArity :: CoreRule -> Int
372 ruleArity (BuiltinRule {ru_nargs = n}) = n
373 ruleArity (Rule {ru_args = args}) = length args
375 ruleName :: CoreRule -> RuleName
378 ruleActivation_maybe :: CoreRule -> Maybe Activation
379 ruleActivation_maybe (BuiltinRule { }) = Nothing
380 ruleActivation_maybe (Rule { ru_act = act }) = Just act
382 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
383 ruleIdName :: CoreRule -> Name
386 isLocalRule :: CoreRule -> Bool
387 isLocalRule = ru_local
389 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
390 setRuleIdName :: Name -> CoreRule -> CoreRule
391 setRuleIdName nm ru = ru { ru_fn = nm }
395 %************************************************************************
399 %************************************************************************
401 The @Unfolding@ type is declared here to avoid numerous loops
404 -- | Records the /unfolding/ of an identifier, which is approximately the form the
405 -- identifier would have if we substituted its definition in for the identifier.
406 -- This type should be treated as abstract everywhere except in "CoreUnfold"
408 = NoUnfolding -- ^ We have no information about the unfolding
410 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
411 -- @OtherCon xs@ also indicates that something has been evaluated
412 -- and hence there's no point in re-evaluating it.
413 -- @OtherCon []@ is used even for non-data-type values
414 -- to indicated evaluated-ness. Notably:
416 -- > data C = C !(Int -> Int)
417 -- > case x of { C f -> ... }
419 -- Here, @f@ gets an @OtherCon []@ unfolding.
421 | DFunUnfolding -- The Unfolding of a DFunId
422 -- See Note [DFun unfoldings]
423 -- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
424 -- (op2 a1..am d1..dn)
426 Arity -- Arity = m+n, the *total* number of args
427 -- (unusually, both type and value) to the dfun
429 DataCon -- The dictionary data constructor (possibly a newtype datacon)
431 [CoreExpr] -- The [CoreExpr] are the superclasses and methods [op1,op2],
432 -- in positional order.
433 -- They are usually variables, but can be trivial expressions
434 -- instead (e.g. a type application).
436 | CoreUnfolding { -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
437 -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
438 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
439 uf_src :: UnfoldingSource, -- Where the unfolding came from
440 uf_is_top :: Bool, -- True <=> top level binding
441 uf_arity :: Arity, -- Number of value arguments expected
442 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard a `seq` on
444 uf_is_conlike :: Bool, -- True <=> application of constructor or CONLIKE function
445 -- Cached version of exprIsConLike
446 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining
447 -- Cached version of exprIsCheap
448 uf_expandable :: Bool, -- True <=> can expand in RULE matching
449 -- Cached version of exprIsExpandable
450 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
452 -- ^ An unfolding with redundant cached information. Parameters:
454 -- uf_tmpl: Template used to perform unfolding;
455 -- NB: Occurrence info is guaranteed correct:
456 -- see Note [OccInfo in unfoldings and rules]
458 -- uf_is_top: Is this a top level binding?
460 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
463 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
464 -- Basically this is a cached version of 'exprIsCheap'
466 -- uf_guidance: Tells us about the /size/ of the unfolding template
468 ------------------------------------------------
470 = InlineCompulsory -- Something that *has* no binding, so you *must* inline it
471 -- Only a few primop-like things have this property
472 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
473 -- Inline absolutely always, however boring the context.
475 | InlineRule -- From an {-# INLINE #-} pragma; See Note [InlineRules]
477 | InlineWrapper Id -- This unfolding is a the wrapper in a
478 -- worker/wrapper split from the strictness analyser
479 -- The Id is the worker-id
480 -- Used to abbreviate the uf_tmpl in interface files
481 -- which don't need to contain the RHS;
482 -- it can be derived from the strictness info
484 | InlineRhs -- The current rhs of the function
486 -- For InlineRhs, the uf_tmpl is replaced each time around
487 -- For all the others we leave uf_tmpl alone
490 -- | 'UnfoldingGuidance' says when unfolding should take place
491 data UnfoldingGuidance
492 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
493 -- Used (a) for small *and* cheap unfoldings
494 -- (b) for INLINE functions
495 -- See Note [INLINE for small functions] in CoreUnfold
496 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
497 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
498 -- So True,True means "always"
501 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
502 -- result of a simple analysis of the RHS
504 ug_args :: [Int], -- Discount if the argument is evaluated.
505 -- (i.e., a simplification will definitely
506 -- be possible). One elt of the list per *value* arg.
508 ug_size :: Int, -- The "size" of the unfolding.
510 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
511 } -- a context (case (thing args) of ...),
512 -- (where there are the right number of arguments.)
514 | UnfNever -- The RHS is big, so don't inline it
518 Note [DFun unfoldings]
519 ~~~~~~~~~~~~~~~~~~~~~~
520 The Arity in a DFunUnfolding is total number of args (type and value)
521 that the DFun needs to produce a dictionary. That's not necessarily
522 related to the ordinary arity of the dfun Id, esp if the class has
523 one method, so the dictionary is represented by a newtype. Example
525 class C a where { op :: a -> Int }
526 instance C a -> C [a] where op xs = op (head xs)
528 The instance translates to
530 $dfCList :: forall a. C a => C [a] -- Arity 2!
531 $dfCList = /\a.\d. $copList {a} d |> co
533 $copList :: forall a. C a => [a] -> Int -- Arity 2!
534 $copList = /\a.\d.\xs. op {a} d (head xs)
536 Now we might encounter (op (dfCList {ty} d) a1 a2)
537 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
538 has all its arguments, even though its (value) arity is 2. That's
539 why we record the number of expected arguments in the DFunUnfolding.
541 Note that although it's an Arity, it's most convenient for it to give
542 the *total* number of arguments, both type and value. See the use
543 site in exprIsConApp_maybe.
546 -- Constants for the UnfWhen constructor
547 needSaturated, unSaturatedOk :: Bool
548 needSaturated = False
551 boringCxtNotOk, boringCxtOk :: Bool
553 boringCxtNotOk = False
555 ------------------------------------------------
556 noUnfolding :: Unfolding
557 -- ^ There is no known 'Unfolding'
558 evaldUnfolding :: Unfolding
559 -- ^ This unfolding marks the associated thing as being evaluated
561 noUnfolding = NoUnfolding
562 evaldUnfolding = OtherCon []
564 mkOtherCon :: [AltCon] -> Unfolding
565 mkOtherCon = OtherCon
567 seqUnfolding :: Unfolding -> ()
568 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
569 uf_is_value = b1, uf_is_cheap = b2,
570 uf_expandable = b3, uf_is_conlike = b4,
571 uf_arity = a, uf_guidance = g})
572 = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
576 seqGuidance :: UnfoldingGuidance -> ()
577 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
582 isInlineRuleSource :: UnfoldingSource -> Bool
583 isInlineRuleSource InlineCompulsory = True
584 isInlineRuleSource InlineRule = True
585 isInlineRuleSource (InlineWrapper {}) = True
586 isInlineRuleSource InlineRhs = False
588 -- | Retrieves the template of an unfolding: panics if none is known
589 unfoldingTemplate :: Unfolding -> CoreExpr
590 unfoldingTemplate = uf_tmpl
592 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
593 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
595 -- | Retrieves the template of an unfolding if possible
596 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
597 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
598 maybeUnfoldingTemplate _ = Nothing
600 -- | The constructors that the unfolding could never be:
601 -- returns @[]@ if no information is available
602 otherCons :: Unfolding -> [AltCon]
603 otherCons (OtherCon cons) = cons
606 -- | Determines if it is certainly the case that the unfolding will
607 -- yield a value (something in HNF): returns @False@ if unsure
608 isValueUnfolding :: Unfolding -> Bool
609 -- Returns False for OtherCon
610 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
611 isValueUnfolding _ = False
613 -- | Determines if it possibly the case that the unfolding will
614 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
616 isEvaldUnfolding :: Unfolding -> Bool
617 -- Returns True for OtherCon
618 isEvaldUnfolding (OtherCon _) = True
619 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
620 isEvaldUnfolding _ = False
622 -- | @True@ if the unfolding is a constructor application, the application
623 -- of a CONLIKE function or 'OtherCon'
624 isConLikeUnfolding :: Unfolding -> Bool
625 isConLikeUnfolding (OtherCon _) = True
626 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
627 isConLikeUnfolding _ = False
629 -- | Is the thing we will unfold into certainly cheap?
630 isCheapUnfolding :: Unfolding -> Bool
631 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
632 isCheapUnfolding _ = False
634 isExpandableUnfolding :: Unfolding -> Bool
635 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
636 isExpandableUnfolding _ = False
638 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
639 -- Expand an expandable unfolding; this is used in rule matching
640 -- See Note [Expanding variables] in Rules.lhs
641 -- The key point here is that CONLIKE things can be expanded
642 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
643 expandUnfolding_maybe _ = Nothing
645 isInlineRule :: Unfolding -> Bool
646 isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
647 isInlineRule _ = False
649 isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
650 isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
651 | isInlineRuleSource src
652 = Just (src, unsat_ok)
654 unsat_ok = case guide of
655 UnfWhen unsat_ok _ -> unsat_ok
657 isInlineRule_maybe _ = Nothing
659 isCompulsoryUnfolding :: Unfolding -> Bool
660 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
661 isCompulsoryUnfolding _ = False
663 isStableUnfolding :: Unfolding -> Bool
664 -- True of unfoldings that should not be overwritten
665 -- by a CoreUnfolding for the RHS of a let-binding
666 isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
667 isStableUnfolding (DFunUnfolding {}) = True
668 isStableUnfolding _ = False
670 unfoldingArity :: Unfolding -> Arity
671 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
672 unfoldingArity _ = panic "unfoldingArity"
674 isClosedUnfolding :: Unfolding -> Bool -- No free variables
675 isClosedUnfolding (CoreUnfolding {}) = False
676 isClosedUnfolding (DFunUnfolding {}) = False
677 isClosedUnfolding _ = True
679 -- | Only returns False if there is no unfolding information available at all
680 hasSomeUnfolding :: Unfolding -> Bool
681 hasSomeUnfolding NoUnfolding = False
682 hasSomeUnfolding _ = True
684 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
685 neverUnfoldGuidance UnfNever = True
686 neverUnfoldGuidance _ = False
688 canUnfold :: Unfolding -> Bool
689 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
698 you intend that calls (f e) are replaced by <rhs>[e/x] So we
699 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
700 with it. Meanwhile, we can optimise <rhs> to our heart's content,
701 leaving the original unfolding intact in Unfolding of 'f'. For example
702 all xs = foldr (&&) True xs
703 any p = all . map p {-# INLINE any #-}
704 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
705 which deforests well at the call site.
707 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
709 Moreover, it's only used when 'f' is applied to the
710 specified number of arguments; that is, the number of argument on
711 the LHS of the '=' sign in the original source definition.
712 For example, (.) is now defined in the libraries like this
714 (.) f g = \x -> f (g x)
715 so that it'll inline when applied to two arguments. If 'x' appeared
718 it'd only inline when applied to three arguments. This slightly-experimental
719 change was requested by Roman, but it seems to make sense.
721 See also Note [Inlining an InlineRule] in CoreUnfold.
724 Note [OccInfo in unfoldings and rules]
725 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
726 In unfoldings and rules, we guarantee that the template is occ-analysed,
727 so that the occurence info on the binders is correct. This is important,
728 because the Simplifier does not re-analyse the template when using it. If
729 the occurrence info is wrong
730 - We may get more simpifier iterations than necessary, because
731 once-occ info isn't there
732 - More seriously, we may get an infinite loop if there's a Rec
733 without a loop breaker marked
736 %************************************************************************
738 \subsection{The main data type}
740 %************************************************************************
743 -- The Ord is needed for the FiniteMap used in the lookForConstructor
744 -- in SimplEnv. If you declared that lookForConstructor *ignores*
745 -- constructor-applications with LitArg args, then you could get
748 instance Outputable AltCon where
749 ppr (DataAlt dc) = ppr dc
750 ppr (LitAlt lit) = ppr lit
751 ppr DEFAULT = ptext (sLit "__DEFAULT")
753 instance Show AltCon where
754 showsPrec p con = showsPrecSDoc p (ppr con)
756 cmpAlt :: Alt b -> Alt b -> Ordering
757 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
759 ltAlt :: Alt b -> Alt b -> Bool
760 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
762 cmpAltCon :: AltCon -> AltCon -> Ordering
763 -- ^ Compares 'AltCon's within a single list of alternatives
764 cmpAltCon DEFAULT DEFAULT = EQ
765 cmpAltCon DEFAULT _ = LT
767 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
768 cmpAltCon (DataAlt _) DEFAULT = GT
769 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
770 cmpAltCon (LitAlt _) DEFAULT = GT
772 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
773 ppr con1 <+> ppr con2 )
777 %************************************************************************
779 \subsection{Useful synonyms}
781 %************************************************************************
784 -- | The common case for the type of binders and variables when
785 -- we are manipulating the Core language within GHC
787 -- | Expressions where binders are 'CoreBndr's
788 type CoreExpr = Expr CoreBndr
789 -- | Argument expressions where binders are 'CoreBndr's
790 type CoreArg = Arg CoreBndr
791 -- | Binding groups where binders are 'CoreBndr's
792 type CoreBind = Bind CoreBndr
793 -- | Case alternatives where binders are 'CoreBndr's
794 type CoreAlt = Alt CoreBndr
797 %************************************************************************
801 %************************************************************************
804 -- | Binders are /tagged/ with a t
805 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
807 type TaggedBind t = Bind (TaggedBndr t)
808 type TaggedExpr t = Expr (TaggedBndr t)
809 type TaggedArg t = Arg (TaggedBndr t)
810 type TaggedAlt t = Alt (TaggedBndr t)
812 instance Outputable b => Outputable (TaggedBndr b) where
813 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
815 instance Outputable b => OutputableBndr (TaggedBndr b) where
816 pprBndr _ b = ppr b -- Simple
820 %************************************************************************
822 \subsection{Core-constructing functions with checking}
824 %************************************************************************
827 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
828 -- use 'CoreUtils.mkCoreApps' if possible
829 mkApps :: Expr b -> [Arg b] -> Expr b
830 -- | Apply a list of type argument expressions to a function expression in a nested fashion
831 mkTyApps :: Expr b -> [Type] -> Expr b
832 -- | Apply a list of type or value variables to a function expression in a nested fashion
833 mkVarApps :: Expr b -> [Var] -> Expr b
834 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
835 -- use 'MkCore.mkCoreConApps' if possible
836 mkConApp :: DataCon -> [Arg b] -> Expr b
838 mkApps f args = foldl App f args
839 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
840 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
841 mkConApp con args = mkApps (Var (dataConWorkId con)) args
844 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
845 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
846 mkIntLit :: Integer -> Expr b
847 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
848 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
849 mkIntLitInt :: Int -> Expr b
851 mkIntLit n = Lit (mkMachInt n)
852 mkIntLitInt n = Lit (mkMachInt (toInteger n))
854 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
855 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
856 mkWordLit :: Integer -> Expr b
857 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
858 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
859 mkWordLitWord :: Word -> Expr b
861 mkWordLit w = Lit (mkMachWord w)
862 mkWordLitWord w = Lit (mkMachWord (toInteger w))
864 -- | Create a machine character literal expression of type @Char#@.
865 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
866 mkCharLit :: Char -> Expr b
867 -- | Create a machine string literal expression of type @Addr#@.
868 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
869 mkStringLit :: String -> Expr b
871 mkCharLit c = Lit (mkMachChar c)
872 mkStringLit s = Lit (mkMachString s)
874 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
875 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
876 mkFloatLit :: Rational -> Expr b
877 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
878 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
879 mkFloatLitFloat :: Float -> Expr b
881 mkFloatLit f = Lit (mkMachFloat f)
882 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
884 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
885 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
886 mkDoubleLit :: Rational -> Expr b
887 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
888 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
889 mkDoubleLitDouble :: Double -> Expr b
891 mkDoubleLit d = Lit (mkMachDouble d)
892 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
894 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
895 -- use 'CoreUtils.mkCoreLets' if possible
896 mkLets :: [Bind b] -> Expr b -> Expr b
897 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
898 -- use 'CoreUtils.mkCoreLams' if possible
899 mkLams :: [b] -> Expr b -> Expr b
901 mkLams binders body = foldr Lam body binders
902 mkLets binds body = foldr Let body binds
905 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
906 -- this can only be used to bind something in a non-recursive @let@ expression
907 mkTyBind :: TyVar -> Type -> CoreBind
908 mkTyBind tv ty = NonRec tv (Type ty)
910 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
911 varToCoreExpr :: CoreBndr -> Expr b
912 varToCoreExpr v | isId v = Var v
913 | otherwise = Type (mkTyVarTy v)
915 varsToCoreExprs :: [CoreBndr] -> [Expr b]
916 varsToCoreExprs vs = map varToCoreExpr vs
920 %************************************************************************
922 \subsection{Simple access functions}
924 %************************************************************************
927 -- | Extract every variable by this group
928 bindersOf :: Bind b -> [b]
929 bindersOf (NonRec binder _) = [binder]
930 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
932 -- | 'bindersOf' applied to a list of binding groups
933 bindersOfBinds :: [Bind b] -> [b]
934 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
936 rhssOfBind :: Bind b -> [Expr b]
937 rhssOfBind (NonRec _ rhs) = [rhs]
938 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
940 rhssOfAlts :: [Alt b] -> [Expr b]
941 rhssOfAlts alts = [e | (_,_,e) <- alts]
943 -- | Collapse all the bindings in the supplied groups into a single
944 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
945 flattenBinds :: [Bind b] -> [(b, Expr b)]
946 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
947 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
952 -- | We often want to strip off leading lambdas before getting down to
953 -- business. This function is your friend.
954 collectBinders :: Expr b -> ([b], Expr b)
955 -- | Collect as many type bindings as possible from the front of a nested lambda
956 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
957 -- | Collect as many value bindings as possible from the front of a nested lambda
958 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
959 -- | Collect type binders from the front of the lambda first,
960 -- then follow up by collecting as many value bindings as possible
961 -- from the resulting stripped expression
962 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
967 go bs (Lam b e) = go (b:bs) e
968 go bs e = (reverse bs, e)
970 collectTyAndValBinders expr
973 (tvs, body1) = collectTyBinders expr
974 (ids, body) = collectValBinders body1
976 collectTyBinders expr
979 go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
980 go tvs e = (reverse tvs, e)
982 collectValBinders expr
985 go ids (Lam b e) | isId b = go (b:ids) e
986 go ids body = (reverse ids, body)
990 -- | Takes a nested application expression and returns the the function
991 -- being applied and the arguments to which it is applied
992 collectArgs :: Expr b -> (Expr b, [Arg b])
996 go (App f a) as = go f (a:as)
1001 -- | Gets the cost centre enclosing an expression, if any.
1002 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
1003 coreExprCc :: Expr b -> CostCentre
1004 coreExprCc (Note (SCC cc) _) = cc
1005 coreExprCc (Note _ e) = coreExprCc e
1006 coreExprCc (Lam _ e) = coreExprCc e
1007 coreExprCc _ = noCostCentre
1010 %************************************************************************
1012 \subsection{Predicates}
1014 %************************************************************************
1016 At one time we optionally carried type arguments through to runtime.
1017 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1018 i.e. if type applications are actual lambdas because types are kept around
1019 at runtime. Similarly isRuntimeArg.
1022 -- | Will this variable exist at runtime?
1023 isRuntimeVar :: Var -> Bool
1026 -- | Will this argument expression exist at runtime?
1027 isRuntimeArg :: CoreExpr -> Bool
1028 isRuntimeArg = isValArg
1030 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
1031 isValArg :: Expr b -> Bool
1032 isValArg (Type _) = False
1035 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
1036 isTypeArg :: Expr b -> Bool
1037 isTypeArg (Type _) = True
1040 -- | The number of binders that bind values rather than types
1041 valBndrCount :: [CoreBndr] -> Int
1042 valBndrCount = count isId
1044 -- | The number of argument expressions that are values rather than types at their top level
1045 valArgCount :: [Arg b] -> Int
1046 valArgCount = count isValArg
1050 %************************************************************************
1052 \subsection{Seq stuff}
1054 %************************************************************************
1057 seqExpr :: CoreExpr -> ()
1058 seqExpr (Var v) = v `seq` ()
1059 seqExpr (Lit lit) = lit `seq` ()
1060 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1061 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1062 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1063 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1064 seqExpr (Cast e co) = seqExpr e `seq` seqType co
1065 seqExpr (Note n e) = seqNote n `seq` seqExpr e
1066 seqExpr (Type t) = seqType t
1068 seqExprs :: [CoreExpr] -> ()
1070 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1072 seqNote :: Note -> ()
1073 seqNote (CoreNote s) = s `seq` ()
1076 seqBndr :: CoreBndr -> ()
1077 seqBndr b = b `seq` ()
1079 seqBndrs :: [CoreBndr] -> ()
1081 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1083 seqBind :: Bind CoreBndr -> ()
1084 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1085 seqBind (Rec prs) = seqPairs prs
1087 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1089 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1091 seqAlts :: [CoreAlt] -> ()
1093 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1095 seqRules :: [CoreRule] -> ()
1097 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1098 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1099 seqRules (BuiltinRule {} : rules) = seqRules rules
1102 %************************************************************************
1104 \subsection{Annotated core}
1106 %************************************************************************
1109 -- | Annotated core: allows annotation at every node in the tree
1110 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1112 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1113 data AnnExpr' bndr annot
1116 | AnnLam bndr (AnnExpr bndr annot)
1117 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1118 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1119 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1120 | AnnCast (AnnExpr bndr annot) Coercion
1121 | AnnNote Note (AnnExpr bndr annot)
1124 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1125 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1127 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1128 data AnnBind bndr annot
1129 = AnnNonRec bndr (AnnExpr bndr annot)
1130 | AnnRec [(bndr, AnnExpr bndr annot)]
1134 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1135 deAnnotate (_, e) = deAnnotate' e
1137 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1138 deAnnotate' (AnnType t) = Type t
1139 deAnnotate' (AnnVar v) = Var v
1140 deAnnotate' (AnnLit lit) = Lit lit
1141 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1142 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1143 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
1144 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
1146 deAnnotate' (AnnLet bind body)
1147 = Let (deAnnBind bind) (deAnnotate body)
1149 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1150 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1152 deAnnotate' (AnnCase scrut v t alts)
1153 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1155 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1156 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1160 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1161 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1165 collect bs (_, AnnLam b body) = collect (b:bs) body
1166 collect bs body = (reverse bs, body)