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, maybeUnfoldingTemplate, otherCons,
45 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
46 hasUnfolding, hasSomeUnfolding, neverUnfold,
49 seqExpr, seqExprs, seqUnfolding,
51 -- * Annotated expression data types
52 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
54 -- ** Operations on annotations
55 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
57 -- * Core rule data types
58 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
61 -- ** Operations on 'CoreRule's
62 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
64 isBuiltinRule, isLocalRule
67 #include "HsVersions.h"
83 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
84 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
87 %************************************************************************
89 \subsection{The main data types}
91 %************************************************************************
93 These data types are the heart of the compiler
96 infixl 8 `App` -- App brackets to the left
98 -- | This is the data type that represents GHCs core intermediate language. Currently
99 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
100 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
102 -- We get from Haskell source to this Core language in a number of stages:
104 -- 1. The source code is parsed into an abstract syntax tree, which is represented
105 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
107 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
108 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
109 -- For example, this program:
112 -- f x = let f x = x + 1
116 -- Would be renamed by having 'Unique's attached so it looked something like this:
119 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
123 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
124 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
126 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
127 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
128 -- optimization, analysis and code generation on.
130 -- The type parameter @b@ is for the type of binders in the expression tree.
132 = Var Id -- ^ Variables
133 | Lit Literal -- ^ Primitive literals
134 | App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
136 -- See "CoreSyn#let_app_invariant" for another invariant
137 | Lam b (Expr b) -- ^ Lambda abstraction
138 | Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
139 -- this corresponds to allocating a thunk for the things
140 -- bound and then executing the sub-expression.
142 -- #top_level_invariant#
143 -- #letrec_invariant#
145 -- The right hand sides of all top-level and recursive @let@s
146 -- /must/ be of lifted type (see "Type#type_classification" for
147 -- the meaning of /lifted/ vs. /unlifted/).
149 -- #let_app_invariant#
150 -- The right hand side of of a non-recursive 'Let' _and_ the argument of an 'App',
151 -- /may/ be of unlifted type, but only if the expression
152 -- is ok-for-speculation. This means that the let can be floated around
153 -- without difficulty. For example, this is OK:
155 -- > y::Int# = x +# 1#
157 -- But this is not, as it may affect termination if the expression is floated out:
159 -- > y::Int# = fac 4#
161 -- In this situation you should use @case@ rather than a @let@. The function
162 -- 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
163 -- alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
164 -- which will generate a @case@ if necessary
167 -- We allow a /non-recursive/ let to bind a type variable, thus:
169 -- > Let (NonRec tv (Type ty)) body
171 -- This can be very convenient for postponing type substitutions until
172 -- the next run of the simplifier.
174 -- At the moment, the rest of the compiler only deals with type-let
175 -- in a Let expression, rather than at top level. We may want to revist
177 | Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
178 -- the scrutinee (expression examined) to weak head normal form
179 -- and then examining at most one level of resulting constructor (i.e. you
180 -- cannot do nested pattern matching directly with this).
182 -- The binder gets bound to the value of the scrutinee,
183 -- and the 'Type' must be that of all the case alternatives
186 -- This is one of the more complicated elements of the Core language, and comes
187 -- with a number of restrictions:
189 -- The 'DEFAULT' case alternative must be first in the list, if it occurs at all.
191 -- The remaining cases are in order of increasing
192 -- tag (for 'DataAlts') or
193 -- lit (for 'LitAlts').
194 -- This makes finding the relevant constructor easy, and makes comparison easier too.
196 -- The list of alternatives must be exhaustive. An /exhaustive/ case
197 -- does not necessarily mention all constructors:
200 -- data Foo = Red | Green | Blue
203 -- other -> f (case x of
208 -- The inner case does not need a @Red@ alternative, because @x@ can't be @Red@ at
209 -- that program point.
210 | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type. This is used to implement @newtype@s
211 -- (a @newtype@ constructor or destructor just becomes a 'Cast' in Core) and GADTs.
212 | Note Note (Expr b) -- ^ Notes. These allow general information to be
213 -- added to expressions in the syntax tree
214 | Type Type -- ^ A type: this should only show up at the top
217 -- | Type synonym for expressions that occur in function argument positions.
218 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
221 -- | A case split alternative. Consists of the constructor leading to the alternative,
222 -- the variables bound from the constructor, and the expression to be executed given that binding.
223 -- The default alternative is @(DEFAULT, [], rhs)@
224 type Alt b = (AltCon, [b], Expr b)
226 -- | A case alternative constructor (i.e. pattern match)
227 data AltCon = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
228 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
229 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
230 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
233 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
234 data Bind b = NonRec b (Expr b)
235 | Rec [(b, (Expr b))]
238 -------------------------- CoreSyn INVARIANTS ---------------------------
240 Note [CoreSyn top-level invariant]
241 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
242 See #toplevel_invariant#
244 Note [CoreSyn letrec invariant]
245 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
246 See #letrec_invariant#
248 Note [CoreSyn let/app invariant]
249 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
250 See #let_app_invariant#
252 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
254 Note [CoreSyn case invariants]
255 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
256 See #case_invariants#
258 Note [CoreSyn let goal]
259 ~~~~~~~~~~~~~~~~~~~~~~~
260 * The simplifier tries to ensure that if the RHS of a let is a constructor
261 application, its arguments are trivial, so that the constructor can be
271 -- | Allows attaching extra information to points in expressions rather than e.g. identifiers.
273 = SCC CostCentre -- ^ A cost centre annotation for profiling
275 | InlineMe -- ^ Instructs the core simplifer to treat the enclosed expression
276 -- as very small, and inline it at its call sites
278 | CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
280 -- NOTE: we also treat expressions wrapped in InlineMe as
281 -- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
282 -- What this means is that we obediently inline even things that don't
283 -- look like valuse. This is sometimes important:
286 -- Here, f looks like a redex, and we aren't going to inline (.) because it's
287 -- inside an INLINE, so it'll stay looking like a redex. Nevertheless, we
288 -- should inline f even inside lambdas. In effect, we should trust the programmer.
292 %************************************************************************
294 \subsection{Transformation rules}
296 %************************************************************************
298 The CoreRule type and its friends are dealt with mainly in CoreRules,
299 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
302 -- | A 'CoreRule' is:
304 -- * \"Local\" if the function it is a rule for is defined in the
305 -- same module as the rule itself.
307 -- * \"Orphan\" if nothing on the LHS is defined in the same module
308 -- as the rule itself
311 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
312 ru_act :: Activation, -- ^ When the rule is active
314 -- Rough-matching stuff
315 -- see comments with InstEnv.Instance( is_cls, is_rough )
316 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
317 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
319 -- Proper-matching stuff
320 -- see comments with InstEnv.Instance( is_tvs, is_tys )
321 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
322 ru_args :: [CoreExpr], -- ^ Left hand side arguments
324 -- And the right-hand side
325 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
328 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
329 -- defined in the same module as the rule
330 -- and is not an implicit 'Id' (like a record selector,
331 -- class operation, or data constructor)
333 -- NB: ru_local is *not* used to decide orphan-hood
334 -- c.g. MkIface.coreRuleToIfaceRule
337 -- | Built-in rules are used for constant folding
338 -- and suchlike. They have no free variables.
340 ru_name :: RuleName, -- ^ As above
341 ru_fn :: Name, -- ^ As above
342 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' expects,
343 -- including type arguments
344 ru_try :: [CoreExpr] -> Maybe CoreExpr
345 -- ^ This function does the rewrite. It given too many
346 -- arguments, it simply discards them; the returned 'CoreExpr'
347 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
349 -- See Note [Extra args in rule matching] in Rules.lhs
351 isBuiltinRule :: CoreRule -> Bool
352 isBuiltinRule (BuiltinRule {}) = True
353 isBuiltinRule _ = False
355 -- | The number of arguments the 'ru_fn' must be applied
356 -- to before the rule can match on it
357 ruleArity :: CoreRule -> Int
358 ruleArity (BuiltinRule {ru_nargs = n}) = n
359 ruleArity (Rule {ru_args = args}) = length args
361 ruleName :: CoreRule -> RuleName
364 ruleActivation_maybe :: CoreRule -> Maybe Activation
365 ruleActivation_maybe (BuiltinRule { }) = Nothing
366 ruleActivation_maybe (Rule { ru_act = act }) = Just act
368 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
369 ruleIdName :: CoreRule -> Name
372 isLocalRule :: CoreRule -> Bool
373 isLocalRule = ru_local
375 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
376 setRuleIdName :: Name -> CoreRule -> CoreRule
377 setRuleIdName nm ru = ru { ru_fn = nm }
381 %************************************************************************
385 %************************************************************************
387 The @Unfolding@ type is declared here to avoid numerous loops
390 -- | Records the /unfolding/ of an identifier, which is approximately the form the
391 -- identifier would have if we substituted its definition in for the identifier.
392 -- This type should be treated as abstract everywhere except in "CoreUnfold"
394 = NoUnfolding -- ^ We have no information about the unfolding
396 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
397 -- @OtherCon xs@ also indicates that something has been evaluated
398 -- and hence there's no point in re-evaluating it.
399 -- @OtherCon []@ is used even for non-data-type values
400 -- to indicated evaluated-ness. Notably:
402 -- > data C = C !(Int -> Int)
403 -- > case x of { C f -> ... }
405 -- Here, @f@ gets an @OtherCon []@ unfolding.
407 | CompulsoryUnfolding CoreExpr -- ^ There is /no original definition/,
408 -- so you'd better unfold.
416 -- ^ An unfolding with redundant cached information. Parameters:
418 -- 1) Template used to perform unfolding; binder-info is correct
420 -- 2) Is this a top level binding?
422 -- 3) 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
425 -- 4) Does this waste only a little work if we expand it inside an inlining?
426 -- Basically this is a cached version of 'exprIsCheap'
428 -- 5) Tells us about the /size/ of the unfolding template
430 -- | When unfolding should take place
431 data UnfoldingGuidance
433 | UnfoldIfGoodArgs Int -- and "n" value args
435 [Int] -- Discount if the argument is evaluated.
436 -- (i.e., a simplification will definitely
437 -- be possible). One elt of the list per *value* arg.
439 Int -- The "size" of the unfolding; to be elaborated
442 Int -- Scrutinee discount: the discount to substract if the thing is in
443 -- a context (case (thing args) of ...),
444 -- (where there are the right number of arguments.)
446 noUnfolding :: Unfolding
447 -- ^ There is no known 'Unfolding'
448 evaldUnfolding :: Unfolding
449 -- ^ This unfolding marks the associated thing as being evaluated
451 noUnfolding = NoUnfolding
452 evaldUnfolding = OtherCon []
454 mkOtherCon :: [AltCon] -> Unfolding
455 mkOtherCon = OtherCon
457 seqUnfolding :: Unfolding -> ()
458 seqUnfolding (CoreUnfolding e top b1 b2 g)
459 = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
462 seqGuidance :: UnfoldingGuidance -> ()
463 seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
468 -- | Retrieves the template of an unfolding: panics if none is known
469 unfoldingTemplate :: Unfolding -> CoreExpr
470 unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
471 unfoldingTemplate (CompulsoryUnfolding expr) = expr
472 unfoldingTemplate _ = panic "getUnfoldingTemplate"
474 -- | Retrieves the template of an unfolding if possible
475 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
476 maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
477 maybeUnfoldingTemplate (CompulsoryUnfolding expr) = Just expr
478 maybeUnfoldingTemplate _ = Nothing
480 -- | The constructors that the unfolding could never be:
481 -- returns @[]@ if no information is available
482 otherCons :: Unfolding -> [AltCon]
483 otherCons (OtherCon cons) = cons
486 -- | Determines if it is certainly the case that the unfolding will
487 -- yield a value (something in HNF): returns @False@ if unsure
488 isValueUnfolding :: Unfolding -> Bool
489 isValueUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
490 isValueUnfolding _ = False
492 -- | Determines if it possibly the case that the unfolding will
493 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
495 isEvaldUnfolding :: Unfolding -> Bool
496 isEvaldUnfolding (OtherCon _) = True
497 isEvaldUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
498 isEvaldUnfolding _ = False
500 -- | Is the thing we will unfold into certainly cheap?
501 isCheapUnfolding :: Unfolding -> Bool
502 isCheapUnfolding (CoreUnfolding _ _ _ is_cheap _) = is_cheap
503 isCheapUnfolding _ = False
505 -- | Must this unfolding happen for the code to be executable?
506 isCompulsoryUnfolding :: Unfolding -> Bool
507 isCompulsoryUnfolding (CompulsoryUnfolding _) = True
508 isCompulsoryUnfolding _ = False
510 -- | Do we have an available or compulsory unfolding?
511 hasUnfolding :: Unfolding -> Bool
512 hasUnfolding (CoreUnfolding _ _ _ _ _) = True
513 hasUnfolding (CompulsoryUnfolding _) = True
514 hasUnfolding _ = False
516 -- | Only returns False if there is no unfolding information available at all
517 hasSomeUnfolding :: Unfolding -> Bool
518 hasSomeUnfolding NoUnfolding = False
519 hasSomeUnfolding _ = True
521 -- | Similar to @not . hasUnfolding@, but also returns @True@
522 -- if it has an unfolding that says it should never occur
523 neverUnfold :: Unfolding -> Bool
524 neverUnfold NoUnfolding = True
525 neverUnfold (OtherCon _) = True
526 neverUnfold (CoreUnfolding _ _ _ _ UnfoldNever) = True
527 neverUnfold _ = False
531 %************************************************************************
533 \subsection{The main data type}
535 %************************************************************************
538 -- The Ord is needed for the FiniteMap used in the lookForConstructor
539 -- in SimplEnv. If you declared that lookForConstructor *ignores*
540 -- constructor-applications with LitArg args, then you could get
543 instance Outputable AltCon where
544 ppr (DataAlt dc) = ppr dc
545 ppr (LitAlt lit) = ppr lit
546 ppr DEFAULT = ptext (sLit "__DEFAULT")
548 instance Show AltCon where
549 showsPrec p con = showsPrecSDoc p (ppr con)
551 cmpAlt :: Alt b -> Alt b -> Ordering
552 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
554 ltAlt :: Alt b -> Alt b -> Bool
555 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
557 cmpAltCon :: AltCon -> AltCon -> Ordering
558 -- ^ Compares 'AltCon's within a single list of alternatives
559 cmpAltCon DEFAULT DEFAULT = EQ
560 cmpAltCon DEFAULT _ = LT
562 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
563 cmpAltCon (DataAlt _) DEFAULT = GT
564 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
565 cmpAltCon (LitAlt _) DEFAULT = GT
567 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
568 ppr con1 <+> ppr con2 )
572 %************************************************************************
574 \subsection{Useful synonyms}
576 %************************************************************************
579 -- | The common case for the type of binders and variables when
580 -- we are manipulating the Core language within GHC
582 -- | Expressions where binders are 'CoreBndr's
583 type CoreExpr = Expr CoreBndr
584 -- | Argument expressions where binders are 'CoreBndr's
585 type CoreArg = Arg CoreBndr
586 -- | Binding groups where binders are 'CoreBndr's
587 type CoreBind = Bind CoreBndr
588 -- | Case alternatives where binders are 'CoreBndr's
589 type CoreAlt = Alt CoreBndr
592 %************************************************************************
596 %************************************************************************
599 -- | Binders are /tagged/ with a t
600 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
602 type TaggedBind t = Bind (TaggedBndr t)
603 type TaggedExpr t = Expr (TaggedBndr t)
604 type TaggedArg t = Arg (TaggedBndr t)
605 type TaggedAlt t = Alt (TaggedBndr t)
607 instance Outputable b => Outputable (TaggedBndr b) where
608 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
610 instance Outputable b => OutputableBndr (TaggedBndr b) where
611 pprBndr _ b = ppr b -- Simple
615 %************************************************************************
617 \subsection{Core-constructing functions with checking}
619 %************************************************************************
622 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
623 -- use 'CoreUtils.mkCoreApps' if possible
624 mkApps :: Expr b -> [Arg b] -> Expr b
625 -- | Apply a list of type argument expressions to a function expression in a nested fashion
626 mkTyApps :: Expr b -> [Type] -> Expr b
627 -- | Apply a list of type or value variables to a function expression in a nested fashion
628 mkVarApps :: Expr b -> [Var] -> Expr b
629 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
630 -- use 'MkCore.mkCoreConApps' if possible
631 mkConApp :: DataCon -> [Arg b] -> Expr b
633 mkApps f args = foldl App f args
634 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
635 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
636 mkConApp con args = mkApps (Var (dataConWorkId con)) args
639 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
640 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
641 mkIntLit :: Integer -> Expr b
642 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
643 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
644 mkIntLitInt :: Int -> Expr b
646 mkIntLit n = Lit (mkMachInt n)
647 mkIntLitInt n = Lit (mkMachInt (toInteger n))
649 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
650 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
651 mkWordLit :: Integer -> Expr b
652 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
653 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
654 mkWordLitWord :: Word -> Expr b
656 mkWordLit w = Lit (mkMachWord w)
657 mkWordLitWord w = Lit (mkMachWord (toInteger w))
659 -- | Create a machine character literal expression of type @Char#@.
660 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
661 mkCharLit :: Char -> Expr b
662 -- | Create a machine string literal expression of type @Addr#@.
663 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
664 mkStringLit :: String -> Expr b
666 mkCharLit c = Lit (mkMachChar c)
667 mkStringLit s = Lit (mkMachString s)
669 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
670 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
671 mkFloatLit :: Rational -> Expr b
672 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
673 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
674 mkFloatLitFloat :: Float -> Expr b
676 mkFloatLit f = Lit (mkMachFloat f)
677 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
679 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
680 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
681 mkDoubleLit :: Rational -> Expr b
682 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
683 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
684 mkDoubleLitDouble :: Double -> Expr b
686 mkDoubleLit d = Lit (mkMachDouble d)
687 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
689 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
690 -- use 'CoreUtils.mkCoreLets' if possible
691 mkLets :: [Bind b] -> Expr b -> Expr b
692 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
693 -- use 'CoreUtils.mkCoreLams' if possible
694 mkLams :: [b] -> Expr b -> Expr b
696 mkLams binders body = foldr Lam body binders
697 mkLets binds body = foldr Let body binds
700 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
701 -- this can only be used to bind something in a non-recursive @let@ expression
702 mkTyBind :: TyVar -> Type -> CoreBind
703 mkTyBind tv ty = NonRec tv (Type ty)
705 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
706 varToCoreExpr :: CoreBndr -> Expr b
707 varToCoreExpr v | isIdVar v = Var v
708 | otherwise = Type (mkTyVarTy v)
710 varsToCoreExprs :: [CoreBndr] -> [Expr b]
711 varsToCoreExprs vs = map varToCoreExpr vs
715 %************************************************************************
717 \subsection{Simple access functions}
719 %************************************************************************
722 -- | Extract every variable by this group
723 bindersOf :: Bind b -> [b]
724 bindersOf (NonRec binder _) = [binder]
725 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
727 -- | 'bindersOf' applied to a list of binding groups
728 bindersOfBinds :: [Bind b] -> [b]
729 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
731 rhssOfBind :: Bind b -> [Expr b]
732 rhssOfBind (NonRec _ rhs) = [rhs]
733 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
735 rhssOfAlts :: [Alt b] -> [Expr b]
736 rhssOfAlts alts = [e | (_,_,e) <- alts]
738 -- | Collapse all the bindings in the supplied groups into a single
739 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
740 flattenBinds :: [Bind b] -> [(b, Expr b)]
741 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
742 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
747 -- | We often want to strip off leading lambdas before getting down to
748 -- business. This function is your friend.
749 collectBinders :: Expr b -> ([b], Expr b)
750 -- | Collect as many type bindings as possible from the front of a nested lambda
751 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
752 -- | Collect as many value bindings as possible from the front of a nested lambda
753 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
754 -- | Collect type binders from the front of the lambda first,
755 -- then follow up by collecting as many value bindings as possible
756 -- from the resulting stripped expression
757 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
762 go bs (Lam b e) = go (b:bs) e
763 go bs e = (reverse bs, e)
765 collectTyAndValBinders expr
768 (tvs, body1) = collectTyBinders expr
769 (ids, body) = collectValBinders body1
771 collectTyBinders expr
774 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
775 go tvs e = (reverse tvs, e)
777 collectValBinders expr
780 go ids (Lam b e) | isIdVar b = go (b:ids) e
781 go ids body = (reverse ids, body)
785 -- | Takes a nested application expression and returns the the function
786 -- being applied and the arguments to which it is applied
787 collectArgs :: Expr b -> (Expr b, [Arg b])
791 go (App f a) as = go f (a:as)
796 -- | Gets the cost centre enclosing an expression, if any.
797 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
798 coreExprCc :: Expr b -> CostCentre
799 coreExprCc (Note (SCC cc) _) = cc
800 coreExprCc (Note _ e) = coreExprCc e
801 coreExprCc (Lam _ e) = coreExprCc e
802 coreExprCc _ = noCostCentre
805 %************************************************************************
807 \subsection{Predicates}
809 %************************************************************************
811 At one time we optionally carried type arguments through to runtime.
812 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
813 i.e. if type applications are actual lambdas because types are kept around
814 at runtime. Similarly isRuntimeArg.
817 -- | Will this variable exist at runtime?
818 isRuntimeVar :: Var -> Bool
819 isRuntimeVar = isIdVar
821 -- | Will this argument expression exist at runtime?
822 isRuntimeArg :: CoreExpr -> Bool
823 isRuntimeArg = isValArg
825 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
826 isValArg :: Expr b -> Bool
827 isValArg (Type _) = False
830 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
831 isTypeArg :: Expr b -> Bool
832 isTypeArg (Type _) = True
835 -- | The number of binders that bind values rather than types
836 valBndrCount :: [CoreBndr] -> Int
837 valBndrCount = count isIdVar
839 -- | The number of argument expressions that are values rather than types at their top level
840 valArgCount :: [Arg b] -> Int
841 valArgCount = count isValArg
845 %************************************************************************
847 \subsection{Seq stuff}
849 %************************************************************************
852 seqExpr :: CoreExpr -> ()
853 seqExpr (Var v) = v `seq` ()
854 seqExpr (Lit lit) = lit `seq` ()
855 seqExpr (App f a) = seqExpr f `seq` seqExpr a
856 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
857 seqExpr (Let b e) = seqBind b `seq` seqExpr e
858 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
859 seqExpr (Cast e co) = seqExpr e `seq` seqType co
860 seqExpr (Note n e) = seqNote n `seq` seqExpr e
861 seqExpr (Type t) = seqType t
863 seqExprs :: [CoreExpr] -> ()
865 seqExprs (e:es) = seqExpr e `seq` seqExprs es
867 seqNote :: Note -> ()
868 seqNote (CoreNote s) = s `seq` ()
871 seqBndr :: CoreBndr -> ()
872 seqBndr b = b `seq` ()
874 seqBndrs :: [CoreBndr] -> ()
876 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
878 seqBind :: Bind CoreBndr -> ()
879 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
880 seqBind (Rec prs) = seqPairs prs
882 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
884 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
886 seqAlts :: [CoreAlt] -> ()
888 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
890 seqRules :: [CoreRule] -> ()
892 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
893 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
894 seqRules (BuiltinRule {} : rules) = seqRules rules
897 %************************************************************************
899 \subsection{Annotated core}
901 %************************************************************************
904 -- | Annotated core: allows annotation at every node in the tree
905 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
907 -- | A clone of the 'Expr' type but allowing annotation at every tree node
908 data AnnExpr' bndr annot
911 | AnnLam bndr (AnnExpr bndr annot)
912 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
913 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
914 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
915 | AnnCast (AnnExpr bndr annot) Coercion
916 | AnnNote Note (AnnExpr bndr annot)
919 -- | A clone of the 'Alt' type but allowing annotation at every tree node
920 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
922 -- | A clone of the 'Bind' type but allowing annotation at every tree node
923 data AnnBind bndr annot
924 = AnnNonRec bndr (AnnExpr bndr annot)
925 | AnnRec [(bndr, AnnExpr bndr annot)]
929 deAnnotate :: AnnExpr bndr annot -> Expr bndr
930 deAnnotate (_, e) = deAnnotate' e
932 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
933 deAnnotate' (AnnType t) = Type t
934 deAnnotate' (AnnVar v) = Var v
935 deAnnotate' (AnnLit lit) = Lit lit
936 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
937 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
938 deAnnotate' (AnnCast e co) = Cast (deAnnotate e) co
939 deAnnotate' (AnnNote note body) = Note note (deAnnotate body)
941 deAnnotate' (AnnLet bind body)
942 = Let (deAnnBind bind) (deAnnotate body)
944 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
945 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
947 deAnnotate' (AnnCase scrut v t alts)
948 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
950 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
951 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
955 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
956 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
960 collect bs (_, AnnLam b body) = collect (b:bs) body
961 collect bs body = (reverse bs, body)