2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
8 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
11 Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
12 CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
13 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
15 -- ** 'Expr' construction
17 mkApps, mkTyApps, mkVarApps,
19 mkIntLit, mkIntLitInt,
20 mkWordLit, mkWordLitWord,
21 mkCharLit, mkStringLit,
22 mkFloatLit, mkFloatLitFloat,
23 mkDoubleLit, mkDoubleLitDouble,
26 varToCoreExpr, varsToCoreExprs,
28 isTyVar, isIdVar, cmpAltCon, cmpAlt, ltAlt,
30 -- ** Simple 'Expr' access functions and predicates
31 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
32 collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
33 collectArgs, coreExprCc, flattenBinds,
35 isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
37 -- * Unfolding data types
38 Unfolding(..), UnfoldingGuidance(..), -- Both abstract everywhere but in CoreUnfold.lhs
40 -- ** Constructing 'Unfolding's
41 noUnfolding, evaldUnfolding, mkOtherCon,
43 -- ** Predicates and deconstruction on 'Unfolding'
44 unfoldingTemplate, setUnfoldingTemplate,
45 maybeUnfoldingTemplate, otherCons,
46 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
47 isInlineRule, isClosedUnfolding, hasSomeUnfolding, canUnfold, neverUnfoldGuidance,
50 seqExpr, seqExprs, seqUnfolding,
52 -- * Annotated expression data types
53 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
55 -- ** Operations on annotations
56 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
58 -- * Core rule data types
59 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
62 -- ** Operations on 'CoreRule's
63 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
65 isBuiltinRule, isLocalRule
68 #include "HsVersions.h"
84 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
85 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
88 %************************************************************************
90 \subsection{The main data types}
92 %************************************************************************
94 These data types are the heart of the compiler
97 infixl 8 `App` -- App brackets to the left
99 -- | This is the data type that represents GHCs core intermediate language. Currently
100 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
101 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
103 -- We get from Haskell source to this Core language in a number of stages:
105 -- 1. The source code is parsed into an abstract syntax tree, which is represented
106 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
108 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
109 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
110 -- For example, this program:
113 -- f x = let f x = x + 1
117 -- Would be renamed by having 'Unique's attached so it looked something like this:
120 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
124 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
125 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
127 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
128 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
129 -- optimization, analysis and code generation on.
131 -- The type parameter @b@ is for the type of binders in the expression tree.
133 = Var Id -- ^ Variables
134 | Lit Literal -- ^ Primitive literals
135 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
137 -- See "CoreSyn#let_app_invariant" for another invariant
138 | Lam b (Expr b) -- ^ Lambda abstraction
139 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
140 -- this corresponds to allocating a thunk for the things
141 -- bound and then executing the sub-expression.
143 -- #top_level_invariant#
144 -- #letrec_invariant#
146 -- The right hand sides of all top-level and recursive @let@s
147 -- /must/ be of lifted type (see "Type#type_classification" for
148 -- the meaning of /lifted/ vs. /unlifted/).
150 -- #let_app_invariant#
151 -- The right hand side of of a non-recursive 'Let' _and_ the argument of an 'App',
152 -- /may/ be of unlifted type, but only if the expression
153 -- is ok-for-speculation. This means that the let can be floated around
154 -- without difficulty. For example, this is OK:
156 -- > y::Int# = x +# 1#
158 -- But this is not, as it may affect termination if the expression is floated out:
160 -- > y::Int# = fac 4#
162 -- In this situation you should use @case@ rather than a @let@. The function
163 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
164 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
165 -- which will generate a @case@ if necessary
168 -- We allow a /non-recursive/ let to bind a type variable, thus:
170 -- > Let (NonRec tv (Type ty)) body
172 -- This can be very convenient for postponing type substitutions until
173 -- the next run of the simplifier.
175 -- At the moment, the rest of the compiler only deals with type-let
176 -- in a Let expression, rather than at top level. We may want to revist
178 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
179 -- the scrutinee (expression examined) to weak head normal form
180 -- and then examining at most one level of resulting constructor (i.e. you
181 -- cannot do nested pattern matching directly with this).
183 -- The binder gets bound to the value of the scrutinee,
184 -- and the 'Type' must be that of all the case alternatives
187 -- This is one of the more complicated elements of the Core language, and comes
188 -- with a number of restrictions:
190 -- The 'DEFAULT' case alternative must be first in the list, if it occurs at all.
192 -- The remaining cases are in order of increasing
193 -- tag (for 'DataAlts') or
194 -- lit (for 'LitAlts').
195 -- This makes finding the relevant constructor easy, and makes comparison easier too.
197 -- The list of alternatives must be exhaustive. An /exhaustive/ case
198 -- does not necessarily mention all constructors:
201 -- data Foo = Red | Green | Blue
204 -- other -> f (case x of
209 -- The inner case does not need a @Red@ alternative, because @x@ can't be @Red@ at
210 -- that program point.
211 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type. This is used to implement @newtype@s
212 -- (a @newtype@ constructor or destructor just becomes a 'Cast' in Core) and GADTs.
213 | Note Note (Expr b) -- ^ Notes. These allow general information to be
214 -- added to expressions in the syntax tree
215 | Type Type -- ^ A type: this should only show up at the top
218 -- | Type synonym for expressions that occur in function argument positions.
219 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
222 -- | A case split alternative. Consists of the constructor leading to the alternative,
223 -- the variables bound from the constructor, and the expression to be executed given that binding.
224 -- The default alternative is @(DEFAULT, [], rhs)@
225 type Alt b = (AltCon, [b], Expr b)
227 -- | A case alternative constructor (i.e. pattern match)
228 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
229 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
230 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
231 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
234 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
235 data Bind b = NonRec b (Expr b)
236 | Rec [(b, (Expr b))]
239 -------------------------- CoreSyn INVARIANTS ---------------------------
241 Note [CoreSyn top-level invariant]
242 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
243 See #toplevel_invariant#
245 Note [CoreSyn letrec invariant]
246 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
247 See #letrec_invariant#
249 Note [CoreSyn let/app invariant]
250 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
251 See #let_app_invariant#
253 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
255 Note [CoreSyn case invariants]
256 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
257 See #case_invariants#
259 Note [CoreSyn let goal]
260 ~~~~~~~~~~~~~~~~~~~~~~~
261 * The simplifier tries to ensure that if the RHS of a let is a constructor
262 application, its arguments are trivial, so that the constructor can be
272 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
274 = SCC CostCentre -- ^ A cost centre annotation for profiling
275 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
279 %************************************************************************
281 \subsection{Transformation rules}
283 %************************************************************************
285 The CoreRule type and its friends are dealt with mainly in CoreRules,
286 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
289 -- | A 'CoreRule' is:
291 -- * \"Local\" if the function it is a rule for is defined in the
292 -- same module as the rule itself.
294 -- * \"Orphan\" if nothing on the LHS is defined in the same module
295 -- as the rule itself
298 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
299 ru_act :: Activation, -- ^ When the rule is active
301 -- Rough-matching stuff
302 -- see comments with InstEnv.Instance( is_cls, is_rough )
303 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
304 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
306 -- Proper-matching stuff
307 -- see comments with InstEnv.Instance( is_tvs, is_tys )
308 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
309 ru_args :: [CoreExpr], -- ^ Left hand side arguments
311 -- And the right-hand side
312 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
315 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
316 -- defined in the same module as the rule
317 -- and is not an implicit 'Id' (like a record selector,
318 -- class operation, or data constructor)
320 -- NB: ru_local is *not* used to decide orphan-hood
321 -- c.g. MkIface.coreRuleToIfaceRule
324 -- | Built-in rules are used for constant folding
325 -- and suchlike. They have no free variables.
327 ru_name :: RuleName, -- ^ As above
328 ru_fn :: Name, -- ^ As above
329 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' expects,
330 -- including type arguments
331 ru_try :: [CoreExpr] -> Maybe CoreExpr
332 -- ^ This function does the rewrite. It given too many
333 -- arguments, it simply discards them; the returned 'CoreExpr'
334 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
336 -- See Note [Extra args in rule matching] in Rules.lhs
338 isBuiltinRule :: CoreRule -> Bool
339 isBuiltinRule (BuiltinRule {}) = True
340 isBuiltinRule _ = False
342 -- | The number of arguments the 'ru_fn' must be applied
343 -- to before the rule can match on it
344 ruleArity :: CoreRule -> Int
345 ruleArity (BuiltinRule {ru_nargs = n}) = n
346 ruleArity (Rule {ru_args = args}) = length args
348 ruleName :: CoreRule -> RuleName
351 ruleActivation_maybe :: CoreRule -> Maybe Activation
352 ruleActivation_maybe (BuiltinRule { }) = Nothing
353 ruleActivation_maybe (Rule { ru_act = act }) = Just act
355 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
356 ruleIdName :: CoreRule -> Name
359 isLocalRule :: CoreRule -> Bool
360 isLocalRule = ru_local
362 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
363 setRuleIdName :: Name -> CoreRule -> CoreRule
364 setRuleIdName nm ru = ru { ru_fn = nm }
368 %************************************************************************
372 %************************************************************************
374 The @Unfolding@ type is declared here to avoid numerous loops
377 -- | Records the /unfolding/ of an identifier, which is approximately the form the
378 -- identifier would have if we substituted its definition in for the identifier.
379 -- This type should be treated as abstract everywhere except in "CoreUnfold"
381 = NoUnfolding -- ^ We have no information about the unfolding
383 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
384 -- @OtherCon xs@ also indicates that something has been evaluated
385 -- and hence there's no point in re-evaluating it.
386 -- @OtherCon []@ is used even for non-data-type values
387 -- to indicated evaluated-ness. Notably:
389 -- > data C = C !(Int -> Int)
390 -- > case x of { C f -> ... }
392 -- Here, @f@ gets an @OtherCon []@ unfolding.
394 | CompulsoryUnfolding { -- There is /no original definition/, so you'd better unfold.
395 uf_tmpl :: CoreExpr -- The unfolding is guaranteed to have no free variables
396 } -- so no need to think about it during dependency analysis
398 | InlineRule { -- The function has an INLINE pragma, with the specified (original) RHS
399 -- (The inline phase, if any, is in the InlinePragInfo for this Id.)
400 -- Inline when (a) applied to at least this number of args
401 -- (b) if there is something interesting about args or context
402 uf_tmpl :: CoreExpr, -- The *original* RHS; occurrence info is correct
403 -- (The actual RHS of the function may be different by now,
404 -- but what we inline is still the original RHS (kept in the InlineRule).)
407 uf_arity :: Arity, -- Don't inline unless applied to this number of *value* args
408 uf_is_value :: Bool, -- True <=> exprIsHNF is true; save to discard a `seq`
409 uf_worker :: Maybe Id -- Just wrk_id <=> this unfolding is a the wrapper in a worker/wrapper
410 -- split from the strictness analyser
411 -- Used to abbreviate the uf_tmpl in interface files
412 -- In the Just case, interface files don't actually
413 -- need to contain the RHS; it can be derived from
414 -- the strictness info
415 -- Also used in CoreUnfold to guide inlining decisions
418 | CoreUnfolding { -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
419 -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
420 uf_tmpl :: CoreExpr, -- Template; binder-info is correct
421 uf_is_top :: Bool, -- True <=> top level binding
422 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard a `seq` on
424 uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining
425 -- Basically it's exprIsCheap
426 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
428 -- ^ An unfolding with redundant cached information. Parameters:
430 -- uf_tmpl: Template used to perform unfolding; binder-info is correct
432 -- uf_is_top: Is this a top level binding?
434 -- uf_is_valiue: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
437 -- uf_is_cheap: Does this waste only a little work if we expand it inside an inlining?
438 -- Basically this is a cached version of 'exprIsCheap'
440 -- uf_guidance: Tells us about the /size/ of the unfolding template
442 ------------------------------------------------
443 -- | 'UnfoldingGuidance' says when unfolding should take place
444 data UnfoldingGuidance
447 ug_arity :: Arity, -- "n" value args
449 ug_args :: [Int], -- Discount if the argument is evaluated.
450 -- (i.e., a simplification will definitely
451 -- be possible). One elt of the list per *value* arg.
453 ug_size :: Int, -- The "size" of the unfolding; to be elaborated
456 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
457 } -- a context (case (thing args) of ...),
458 -- (where there are the right number of arguments.)
460 ------------------------------------------------
461 noUnfolding :: Unfolding
462 -- ^ There is no known 'Unfolding'
463 evaldUnfolding :: Unfolding
464 -- ^ This unfolding marks the associated thing as being evaluated
466 noUnfolding = NoUnfolding
467 evaldUnfolding = OtherCon []
469 mkOtherCon :: [AltCon] -> Unfolding
470 mkOtherCon = OtherCon
472 seqUnfolding :: Unfolding -> ()
473 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
474 uf_is_value = b1, uf_is_cheap = b2, uf_guidance = g})
475 = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
478 seqGuidance :: UnfoldingGuidance -> ()
479 seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
484 -- | Retrieves the template of an unfolding: panics if none is known
485 unfoldingTemplate :: Unfolding -> CoreExpr
486 unfoldingTemplate = uf_tmpl
488 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
489 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
491 -- | Retrieves the template of an unfolding if possible
492 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
493 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr }) = Just expr
494 maybeUnfoldingTemplate (CompulsoryUnfolding { uf_tmpl = expr }) = Just expr
495 maybeUnfoldingTemplate (InlineRule { uf_tmpl = expr }) = Just expr
496 maybeUnfoldingTemplate _ = Nothing
498 -- | The constructors that the unfolding could never be:
499 -- returns @[]@ if no information is available
500 otherCons :: Unfolding -> [AltCon]
501 otherCons (OtherCon cons) = cons
504 -- | Determines if it is certainly the case that the unfolding will
505 -- yield a value (something in HNF): returns @False@ if unsure
506 isValueUnfolding :: Unfolding -> Bool
507 -- Returns False for OtherCon
508 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
509 isValueUnfolding (InlineRule { uf_is_value = is_evald }) = is_evald
510 isValueUnfolding _ = False
512 -- | Determines if it possibly the case that the unfolding will
513 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
515 isEvaldUnfolding :: Unfolding -> Bool
516 -- Returns True for OtherCon
517 isEvaldUnfolding (OtherCon _) = True
518 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
519 isEvaldUnfolding (InlineRule { uf_is_value = is_evald }) = is_evald
520 isEvaldUnfolding _ = False
522 -- | Is the thing we will unfold into certainly cheap?
523 isCheapUnfolding :: Unfolding -> Bool
524 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
525 isCheapUnfolding _ = False
527 isInlineRule :: Unfolding -> Bool
528 isInlineRule (InlineRule {}) = True
529 isInlineRule _ = False
531 -- | Must this unfolding happen for the code to be executable?
532 isCompulsoryUnfolding :: Unfolding -> Bool
533 isCompulsoryUnfolding (CompulsoryUnfolding {}) = True
534 isCompulsoryUnfolding _ = False
536 isClosedUnfolding :: Unfolding -> Bool -- No free variables
537 isClosedUnfolding (CoreUnfolding {}) = False
538 isClosedUnfolding (InlineRule {}) = False
539 isClosedUnfolding _ = True
541 -- | Only returns False if there is no unfolding information available at all
542 hasSomeUnfolding :: Unfolding -> Bool
543 hasSomeUnfolding NoUnfolding = False
544 hasSomeUnfolding _ = True
546 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
547 neverUnfoldGuidance UnfoldNever = True
548 neverUnfoldGuidance _ = False
550 canUnfold :: Unfolding -> Bool
551 canUnfold (InlineRule {}) = True
552 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
557 %************************************************************************
559 \subsection{The main data type}
561 %************************************************************************
564 -- The Ord is needed for the FiniteMap used in the lookForConstructor
565 -- in SimplEnv. If you declared that lookForConstructor *ignores*
566 -- constructor-applications with LitArg args, then you could get
569 instance Outputable AltCon where
570 ppr (DataAlt dc) = ppr dc
571 ppr (LitAlt lit) = ppr lit
572 ppr DEFAULT = ptext (sLit "__DEFAULT")
574 instance Show AltCon where
575 showsPrec p con = showsPrecSDoc p (ppr con)
577 cmpAlt :: Alt b -> Alt b -> Ordering
578 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
580 ltAlt :: Alt b -> Alt b -> Bool
581 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
583 cmpAltCon :: AltCon -> AltCon -> Ordering
584 -- ^ Compares 'AltCon's within a single list of alternatives
585 cmpAltCon DEFAULT DEFAULT = EQ
586 cmpAltCon DEFAULT _ = LT
588 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
589 cmpAltCon (DataAlt _) DEFAULT = GT
590 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
591 cmpAltCon (LitAlt _) DEFAULT = GT
593 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
594 ppr con1 <+> ppr con2 )
598 %************************************************************************
600 \subsection{Useful synonyms}
602 %************************************************************************
605 -- | The common case for the type of binders and variables when
606 -- we are manipulating the Core language within GHC
608 -- | Expressions where binders are 'CoreBndr's
609 type CoreExpr = Expr CoreBndr
610 -- | Argument expressions where binders are 'CoreBndr's
611 type CoreArg = Arg CoreBndr
612 -- | Binding groups where binders are 'CoreBndr's
613 type CoreBind = Bind CoreBndr
614 -- | Case alternatives where binders are 'CoreBndr's
615 type CoreAlt = Alt CoreBndr
618 %************************************************************************
622 %************************************************************************
625 -- | Binders are /tagged/ with a t
626 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
628 type TaggedBind t = Bind (TaggedBndr t)
629 type TaggedExpr t = Expr (TaggedBndr t)
630 type TaggedArg t = Arg (TaggedBndr t)
631 type TaggedAlt t = Alt (TaggedBndr t)
633 instance Outputable b => Outputable (TaggedBndr b) where
634 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
636 instance Outputable b => OutputableBndr (TaggedBndr b) where
637 pprBndr _ b = ppr b -- Simple
641 %************************************************************************
643 \subsection{Core-constructing functions with checking}
645 %************************************************************************
648 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
649 -- use 'CoreUtils.mkCoreApps' if possible
650 mkApps :: Expr b -> [Arg b] -> Expr b
651 -- | Apply a list of type argument expressions to a function expression in a nested fashion
652 mkTyApps :: Expr b -> [Type] -> Expr b
653 -- | Apply a list of type or value variables to a function expression in a nested fashion
654 mkVarApps :: Expr b -> [Var] -> Expr b
655 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
656 -- use 'MkCore.mkCoreConApps' if possible
657 mkConApp :: DataCon -> [Arg b] -> Expr b
659 mkApps f args = foldl App f args
660 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
661 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
662 mkConApp con args = mkApps (Var (dataConWorkId con)) args
665 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
666 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
667 mkIntLit :: Integer -> Expr b
668 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
669 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
670 mkIntLitInt :: Int -> Expr b
672 mkIntLit n = Lit (mkMachInt n)
673 mkIntLitInt n = Lit (mkMachInt (toInteger n))
675 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
676 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
677 mkWordLit :: Integer -> Expr b
678 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
679 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
680 mkWordLitWord :: Word -> Expr b
682 mkWordLit w = Lit (mkMachWord w)
683 mkWordLitWord w = Lit (mkMachWord (toInteger w))
685 -- | Create a machine character literal expression of type @Char#@.
686 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
687 mkCharLit :: Char -> Expr b
688 -- | Create a machine string literal expression of type @Addr#@.
689 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
690 mkStringLit :: String -> Expr b
692 mkCharLit c = Lit (mkMachChar c)
693 mkStringLit s = Lit (mkMachString s)
695 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
696 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
697 mkFloatLit :: Rational -> Expr b
698 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
699 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
700 mkFloatLitFloat :: Float -> Expr b
702 mkFloatLit f = Lit (mkMachFloat f)
703 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
705 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
706 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
707 mkDoubleLit :: Rational -> Expr b
708 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
709 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
710 mkDoubleLitDouble :: Double -> Expr b
712 mkDoubleLit d = Lit (mkMachDouble d)
713 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
715 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
716 -- use 'CoreUtils.mkCoreLets' if possible
717 mkLets :: [Bind b] -> Expr b -> Expr b
718 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
719 -- use 'CoreUtils.mkCoreLams' if possible
720 mkLams :: [b] -> Expr b -> Expr b
722 mkLams binders body = foldr Lam body binders
723 mkLets binds body = foldr Let body binds
726 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
727 -- this can only be used to bind something in a non-recursive @let@ expression
728 mkTyBind :: TyVar -> Type -> CoreBind
729 mkTyBind tv ty = NonRec tv (Type ty)
731 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
732 varToCoreExpr :: CoreBndr -> Expr b
733 varToCoreExpr v | isIdVar v = Var v
734 | otherwise = Type (mkTyVarTy v)
736 varsToCoreExprs :: [CoreBndr] -> [Expr b]
737 varsToCoreExprs vs = map varToCoreExpr vs
741 %************************************************************************
743 \subsection{Simple access functions}
745 %************************************************************************
748 -- | Extract every variable by this group
749 bindersOf :: Bind b -> [b]
750 bindersOf (NonRec binder _) = [binder]
751 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
753 -- | 'bindersOf' applied to a list of binding groups
754 bindersOfBinds :: [Bind b] -> [b]
755 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
757 rhssOfBind :: Bind b -> [Expr b]
758 rhssOfBind (NonRec _ rhs) = [rhs]
759 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
761 rhssOfAlts :: [Alt b] -> [Expr b]
762 rhssOfAlts alts = [e | (_,_,e) <- alts]
764 -- | Collapse all the bindings in the supplied groups into a single
765 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
766 flattenBinds :: [Bind b] -> [(b, Expr b)]
767 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
768 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
773 -- | We often want to strip off leading lambdas before getting down to
774 -- business. This function is your friend.
775 collectBinders :: Expr b -> ([b], Expr b)
776 -- | Collect as many type bindings as possible from the front of a nested lambda
777 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
778 -- | Collect as many value bindings as possible from the front of a nested lambda
779 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
780 -- | Collect type binders from the front of the lambda first,
781 -- then follow up by collecting as many value bindings as possible
782 -- from the resulting stripped expression
783 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
788 go bs (Lam b e) = go (b:bs) e
789 go bs e = (reverse bs, e)
791 collectTyAndValBinders expr
794 (tvs, body1) = collectTyBinders expr
795 (ids, body) = collectValBinders body1
797 collectTyBinders expr
800 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
801 go tvs e = (reverse tvs, e)
803 collectValBinders expr
806 go ids (Lam b e) | isIdVar b = go (b:ids) e
807 go ids body = (reverse ids, body)
811 -- | Takes a nested application expression and returns the the function
812 -- being applied and the arguments to which it is applied
813 collectArgs :: Expr b -> (Expr b, [Arg b])
817 go (App f a) as = go f (a:as)
822 -- | Gets the cost centre enclosing an expression, if any.
823 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
824 coreExprCc :: Expr b -> CostCentre
825 coreExprCc (Note (SCC cc) _) = cc
826 coreExprCc (Note _ e) = coreExprCc e
827 coreExprCc (Lam _ e) = coreExprCc e
828 coreExprCc _ = noCostCentre
831 %************************************************************************
833 \subsection{Predicates}
835 %************************************************************************
837 At one time we optionally carried type arguments through to runtime.
838 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
839 i.e. if type applications are actual lambdas because types are kept around
840 at runtime. Similarly isRuntimeArg.
843 -- | Will this variable exist at runtime?
844 isRuntimeVar :: Var -> Bool
845 isRuntimeVar = isIdVar
847 -- | Will this argument expression exist at runtime?
848 isRuntimeArg :: CoreExpr -> Bool
849 isRuntimeArg = isValArg
851 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
852 isValArg :: Expr b -> Bool
853 isValArg (Type _) = False
856 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
857 isTypeArg :: Expr b -> Bool
858 isTypeArg (Type _) = True
861 -- | The number of binders that bind values rather than types
862 valBndrCount :: [CoreBndr] -> Int
863 valBndrCount = count isIdVar
865 -- | The number of argument expressions that are values rather than types at their top level
866 valArgCount :: [Arg b] -> Int
867 valArgCount = count isValArg
871 %************************************************************************
873 \subsection{Seq stuff}
875 %************************************************************************
878 seqExpr :: CoreExpr -> ()
879 seqExpr (Var v) = v `seq` ()
880 seqExpr (Lit lit) = lit `seq` ()
881 seqExpr (App f a) = seqExpr f `seq` seqExpr a
882 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
883 seqExpr (Let b e) = seqBind b `seq` seqExpr e
884 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
885 seqExpr (Cast e co) = seqExpr e `seq` seqType co
886 seqExpr (Note n e) = seqNote n `seq` seqExpr e
887 seqExpr (Type t) = seqType t
889 seqExprs :: [CoreExpr] -> ()
891 seqExprs (e:es) = seqExpr e `seq` seqExprs es
893 seqNote :: Note -> ()
894 seqNote (CoreNote s) = s `seq` ()
897 seqBndr :: CoreBndr -> ()
898 seqBndr b = b `seq` ()
900 seqBndrs :: [CoreBndr] -> ()
902 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
904 seqBind :: Bind CoreBndr -> ()
905 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
906 seqBind (Rec prs) = seqPairs prs
908 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
910 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
912 seqAlts :: [CoreAlt] -> ()
914 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
916 seqRules :: [CoreRule] -> ()
918 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
919 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
920 seqRules (BuiltinRule {} : rules) = seqRules rules
923 %************************************************************************
925 \subsection{Annotated core}
927 %************************************************************************
930 -- | Annotated core: allows annotation at every node in the tree
931 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
933 -- | A clone of the 'Expr' type but allowing annotation at every tree node
934 data AnnExpr' bndr annot
937 | AnnLam bndr (AnnExpr bndr annot)
938 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
939 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
940 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
941 | AnnCast (AnnExpr bndr annot) Coercion
942 | AnnNote Note (AnnExpr bndr annot)
945 -- | A clone of the 'Alt' type but allowing annotation at every tree node
946 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
948 -- | A clone of the 'Bind' type but allowing annotation at every tree node
949 data AnnBind bndr annot
950 = AnnNonRec bndr (AnnExpr bndr annot)
951 | AnnRec [(bndr, AnnExpr bndr annot)]
955 deAnnotate :: AnnExpr bndr annot -> Expr bndr
956 deAnnotate (_, e) = deAnnotate' e
958 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
959 deAnnotate' (AnnType t) = Type t
960 deAnnotate' (AnnVar v) = Var v
961 deAnnotate' (AnnLit lit) = Lit lit
962 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
963 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
964 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
965 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
967 deAnnotate' (AnnLet bind body)
968 = Let (deAnnBind bind) (deAnnotate body)
970 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
971 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
973 deAnnotate' (AnnCase scrut v t alts)
974 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
976 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
977 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
981 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
982 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
986 collect bs (_, AnnLam b body) = collect (b:bs) body
987 collect bs body = (reverse bs, body)