compiler: de-lhs coreSyn/
[ghc.git] / compiler / coreSyn / CoreSyn.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
7
8 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
9 module CoreSyn (
10 -- * Main data types
11 Expr(..), Alt, Bind(..), AltCon(..), Arg, Tickish(..),
12 CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
13 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
14
15 -- ** 'Expr' construction
16 mkLets, mkLams,
17 mkApps, mkTyApps, mkCoApps, mkVarApps,
18
19 mkIntLit, mkIntLitInt,
20 mkWordLit, mkWordLitWord,
21 mkWord64LitWord64, mkInt64LitInt64,
22 mkCharLit, mkStringLit,
23 mkFloatLit, mkFloatLitFloat,
24 mkDoubleLit, mkDoubleLitDouble,
25
26 mkConApp, mkConApp2, mkTyBind, mkCoBind,
27 varToCoreExpr, varsToCoreExprs,
28
29 isId, cmpAltCon, cmpAlt, ltAlt,
30
31 -- ** Simple 'Expr' access functions and predicates
32 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
33 collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
34 collectArgs, flattenBinds,
35
36 isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
37 isRuntimeArg, isRuntimeVar,
38
39 tickishCounts, tickishScoped, tickishIsCode, mkNoCount, mkNoScope,
40 tickishCanSplit,
41
42 -- * Unfolding data types
43 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
44
45 -- ** Constructing 'Unfolding's
46 noUnfolding, evaldUnfolding, mkOtherCon,
47 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
48
49 -- ** Predicates and deconstruction on 'Unfolding'
50 unfoldingTemplate, expandUnfolding_maybe,
51 maybeUnfoldingTemplate, otherCons,
52 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
53 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
54 isStableUnfolding, hasStableCoreUnfolding_maybe,
55 isClosedUnfolding, hasSomeUnfolding,
56 canUnfold, neverUnfoldGuidance, isStableSource,
57
58 -- * Strictness
59 seqExpr, seqExprs, seqUnfolding,
60
61 -- * Annotated expression data types
62 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
63
64 -- ** Operations on annotated expressions
65 collectAnnArgs,
66
67 -- ** Operations on annotations
68 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
69
70 -- * Core rule data types
71 CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
72 RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
73
74 -- ** Operations on 'CoreRule's
75 seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
76 setRuleIdName,
77 isBuiltinRule, isLocalRule, isAutoRule,
78
79 -- * Core vectorisation declarations data type
80 CoreVect(..)
81 ) where
82
83 #include "HsVersions.h"
84
85 import CostCentre
86 import VarEnv( InScopeSet )
87 import Var
88 import Type
89 import Coercion
90 import Name
91 import Literal
92 import DataCon
93 import Module
94 import TyCon
95 import BasicTypes
96 import DynFlags
97 import FastString
98 import Outputable
99 import Util
100
101 import Data.Data hiding (TyCon)
102 import Data.Int
103 import Data.Word
104
105 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
106 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
107
108 {-
109 ************************************************************************
110 * *
111 \subsection{The main data types}
112 * *
113 ************************************************************************
114
115 These data types are the heart of the compiler
116 -}
117
118 -- | This is the data type that represents GHCs core intermediate language. Currently
119 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
120 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
121 --
122 -- We get from Haskell source to this Core language in a number of stages:
123 --
124 -- 1. The source code is parsed into an abstract syntax tree, which is represented
125 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
126 --
127 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
128 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
129 -- For example, this program:
130 --
131 -- @
132 -- f x = let f x = x + 1
133 -- in f (x - 2)
134 -- @
135 --
136 -- Would be renamed by having 'Unique's attached so it looked something like this:
137 --
138 -- @
139 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
140 -- in f_3 (x_2 - 2)
141 -- @
142 -- But see Note [Shadowing] below.
143 --
144 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
145 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
146 --
147 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
148 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
149 -- optimization, analysis and code generation on.
150 --
151 -- The type parameter @b@ is for the type of binders in the expression tree.
152 --
153 -- The language consists of the following elements:
154 --
155 -- * Variables
156 --
157 -- * Primitive literals
158 --
159 -- * Applications: note that the argument may be a 'Type'.
160 --
161 -- See "CoreSyn#let_app_invariant" for another invariant
162 --
163 -- * Lambda abstraction
164 --
165 -- * Recursive and non recursive @let@s. Operationally
166 -- this corresponds to allocating a thunk for the things
167 -- bound and then executing the sub-expression.
168 --
169 -- #top_level_invariant#
170 -- #letrec_invariant#
171 --
172 -- The right hand sides of all top-level and recursive @let@s
173 -- /must/ be of lifted type (see "Type#type_classification" for
174 -- the meaning of /lifted/ vs. /unlifted/).
175 --
176 -- See Note [CoreSyn let/app invariant]
177 --
178 -- #type_let#
179 -- We allow a /non-recursive/ let to bind a type variable, thus:
180 --
181 -- > Let (NonRec tv (Type ty)) body
182 --
183 -- This can be very convenient for postponing type substitutions until
184 -- the next run of the simplifier.
185 --
186 -- At the moment, the rest of the compiler only deals with type-let
187 -- in a Let expression, rather than at top level. We may want to revist
188 -- this choice.
189 --
190 -- * Case split. Operationally this corresponds to evaluating
191 -- the scrutinee (expression examined) to weak head normal form
192 -- and then examining at most one level of resulting constructor (i.e. you
193 -- cannot do nested pattern matching directly with this).
194 --
195 -- The binder gets bound to the value of the scrutinee,
196 -- and the 'Type' must be that of all the case alternatives
197 --
198 -- #case_invariants#
199 -- This is one of the more complicated elements of the Core language,
200 -- and comes with a number of restrictions:
201 --
202 -- 1. The list of alternatives may be empty;
203 -- See Note [Empty case alternatives]
204 --
205 -- 2. The 'DEFAULT' case alternative must be first in the list,
206 -- if it occurs at all.
207 --
208 -- 3. The remaining cases are in order of increasing
209 -- tag (for 'DataAlts') or
210 -- lit (for 'LitAlts').
211 -- This makes finding the relevant constructor easy,
212 -- and makes comparison easier too.
213 --
214 -- 4. The list of alternatives must be exhaustive. An /exhaustive/ case
215 -- does not necessarily mention all constructors:
216 --
217 -- @
218 -- data Foo = Red | Green | Blue
219 -- ... case x of
220 -- Red -> True
221 -- other -> f (case x of
222 -- Green -> ...
223 -- Blue -> ... ) ...
224 -- @
225 --
226 -- The inner case does not need a @Red@ alternative, because @x@
227 -- can't be @Red@ at that program point.
228 --
229 -- * Cast an expression to a particular type.
230 -- This is used to implement @newtype@s (a @newtype@ constructor or
231 -- destructor just becomes a 'Cast' in Core) and GADTs.
232 --
233 -- * Notes. These allow general information to be added to expressions
234 -- in the syntax tree
235 --
236 -- * A type: this should only show up at the top level of an Arg
237 --
238 -- * A coercion
239
240 -- If you edit this type, you may need to update the GHC formalism
241 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
242 data Expr b
243 = Var Id
244 | Lit Literal
245 | App (Expr b) (Arg b)
246 | Lam b (Expr b)
247 | Let (Bind b) (Expr b)
248 | Case (Expr b) b Type [Alt b] -- See #case_invariant#
249 | Cast (Expr b) Coercion
250 | Tick (Tickish Id) (Expr b)
251 | Type Type
252 | Coercion Coercion
253 deriving (Data, Typeable)
254
255 -- | Type synonym for expressions that occur in function argument positions.
256 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
257 type Arg b = Expr b
258
259 -- | A case split alternative. Consists of the constructor leading to the alternative,
260 -- the variables bound from the constructor, and the expression to be executed given that binding.
261 -- The default alternative is @(DEFAULT, [], rhs)@
262
263 -- If you edit this type, you may need to update the GHC formalism
264 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
265 type Alt b = (AltCon, [b], Expr b)
266
267 -- | A case alternative constructor (i.e. pattern match)
268
269 -- If you edit this type, you may need to update the GHC formalism
270 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
271 data AltCon
272 = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
273 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
274
275 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
276 -- Invariant: always an *unlifted* literal
277 -- See Note [Literal alternatives]
278
279 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
280 deriving (Eq, Ord, Data, Typeable)
281
282 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
283
284 -- If you edit this type, you may need to update the GHC formalism
285 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
286 data Bind b = NonRec b (Expr b)
287 | Rec [(b, (Expr b))]
288 deriving (Data, Typeable)
289
290 {-
291 Note [Shadowing]
292 ~~~~~~~~~~~~~~~~
293 While various passes attempt to rename on-the-fly in a manner that
294 avoids "shadowing" (thereby simplifying downstream optimizations),
295 neither the simplifier nor any other pass GUARANTEES that shadowing is
296 avoided. Thus, all passes SHOULD work fine even in the presence of
297 arbitrary shadowing in their inputs.
298
299 In particular, scrutinee variables `x` in expressions of the form
300 `Case e x t` are often renamed to variables with a prefix
301 "wild_". These "wild" variables may appear in the body of the
302 case-expression, and further, may be shadowed within the body.
303
304 So the Unique in an Var is not really unique at all. Still, it's very
305 useful to give a constant-time equality/ordering for Vars, and to give
306 a key that can be used to make sets of Vars (VarSet), or mappings from
307 Vars to other things (VarEnv). Moreover, if you do want to eliminate
308 shadowing, you can give a new Unique to an Id without changing its
309 printable name, which makes debugging easier.
310
311 Note [Literal alternatives]
312 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
313 Literal alternatives (LitAlt lit) are always for *un-lifted* literals.
314 We have one literal, a literal Integer, that is lifted, and we don't
315 allow in a LitAlt, because LitAlt cases don't do any evaluation. Also
316 (see Trac #5603) if you say
317 case 3 of
318 S# x -> ...
319 J# _ _ -> ...
320 (where S#, J# are the constructors for Integer) we don't want the
321 simplifier calling findAlt with argument (LitAlt 3). No no. Integer
322 literals are an opaque encoding of an algebraic data type, not of
323 an unlifted literal, like all the others.
324
325
326 -------------------------- CoreSyn INVARIANTS ---------------------------
327
328 Note [CoreSyn top-level invariant]
329 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
330 See #toplevel_invariant#
331
332 Note [CoreSyn letrec invariant]
333 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
334 See #letrec_invariant#
335
336 Note [CoreSyn let/app invariant]
337 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
338 The let/app invariant
339 the right hand side of of a non-recursive 'Let', and
340 the argument of an 'App',
341 /may/ be of unlifted type, but only if
342 the expression is ok-for-speculation.
343
344 This means that the let can be floated around
345 without difficulty. For example, this is OK:
346
347 y::Int# = x +# 1#
348
349 But this is not, as it may affect termination if the
350 expression is floated out:
351
352 y::Int# = fac 4#
353
354 In this situation you should use @case@ rather than a @let@. The function
355 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
356 alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
357 which will generate a @case@ if necessary
358
359 Th let/app invariant is initially enforced by DsUtils.mkCoreLet and mkCoreApp
360
361 Note [CoreSyn case invariants]
362 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
363 See #case_invariants#
364
365 Note [CoreSyn let goal]
366 ~~~~~~~~~~~~~~~~~~~~~~~
367 * The simplifier tries to ensure that if the RHS of a let is a constructor
368 application, its arguments are trivial, so that the constructor can be
369 inlined vigorously.
370
371 Note [Type let]
372 ~~~~~~~~~~~~~~~
373 See #type_let#
374
375 Note [Empty case alternatives]
376 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
377 The alternatives of a case expression should be exhaustive. A case expression
378 can have empty alternatives if (and only if) the scrutinee is bound to raise
379 an exception or diverge. So:
380 Case (error Int "Hello") b Bool []
381 is fine, and has type Bool. This is one reason we need a type on
382 the case expression: if the alternatives are empty we can't get the type
383 from the alternatives! I'll write this
384 case (error Int "Hello") of Bool {}
385 with the return type just before the alternatives.
386
387 Here's another example:
388 data T
389 f :: T -> Bool
390 f = \(x:t). case x of Bool {}
391 Since T has no data constructors, the case alternatives are of course
392 empty. However note that 'x' is not bound to a visibly-bottom value;
393 it's the *type* that tells us it's going to diverge. Its a bit of a
394 degnerate situation but we do NOT want to replace
395 case x of Bool {} --> error Bool "Inaccessible case"
396 because x might raise an exception, and *that*'s what we want to see!
397 (Trac #6067 is an example.) To preserve semantics we'd have to say
398 x `seq` error Bool "Inaccessible case"
399 but the 'seq' is just a case, so we are back to square 1. Or I suppose
400 we could say
401 x |> UnsafeCoerce T Bool
402 but that loses all trace of the fact that this originated with an empty
403 set of alternatives.
404
405 We can use the empty-alternative construct to coerce error values from
406 one type to another. For example
407
408 f :: Int -> Int
409 f n = error "urk"
410
411 g :: Int -> (# Char, Bool #)
412 g x = case f x of { 0 -> ..., n -> ... }
413
414 Then if we inline f in g's RHS we get
415 case (error Int "urk") of (# Char, Bool #) { ... }
416 and we can discard the alternatives since the scrutinee is bottom to give
417 case (error Int "urk") of (# Char, Bool #) {}
418
419 This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
420 if for no other reason that we don't need to instantiate the (~) at an
421 unboxed type.
422
423
424 ************************************************************************
425 * *
426 Ticks
427 * *
428 ************************************************************************
429 -}
430
431 -- | Allows attaching extra information to points in expressions
432
433 -- If you edit this type, you may need to update the GHC formalism
434 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
435 data Tickish id =
436 -- | An @{-# SCC #-}@ profiling annotation, either automatically
437 -- added by the desugarer as a result of -auto-all, or added by
438 -- the user.
439 ProfNote {
440 profNoteCC :: CostCentre, -- ^ the cost centre
441 profNoteCount :: !Bool, -- ^ bump the entry count?
442 profNoteScope :: !Bool -- ^ scopes over the enclosed expression
443 -- (i.e. not just a tick)
444 }
445
446 -- | A "tick" used by HPC to track the execution of each
447 -- subexpression in the original source code.
448 | HpcTick {
449 tickModule :: Module,
450 tickId :: !Int
451 }
452
453 -- | A breakpoint for the GHCi debugger. This behaves like an HPC
454 -- tick, but has a list of free variables which will be available
455 -- for inspection in GHCi when the program stops at the breakpoint.
456 --
457 -- NB. we must take account of these Ids when (a) counting free variables,
458 -- and (b) substituting (don't substitute for them)
459 | Breakpoint
460 { breakpointId :: !Int
461 , breakpointFVs :: [id] -- ^ the order of this list is important:
462 -- it matches the order of the lists in the
463 -- appropriate entry in HscTypes.ModBreaks.
464 --
465 -- Careful about substitution! See
466 -- Note [substTickish] in CoreSubst.
467 }
468
469 deriving (Eq, Ord, Data, Typeable)
470
471
472 -- | A "counting tick" (where tickishCounts is True) is one that
473 -- counts evaluations in some way. We cannot discard a counting tick,
474 -- and the compiler should preserve the number of counting ticks as
475 -- far as possible.
476 --
477 -- However, we still allow the simplifier to increase or decrease
478 -- sharing, so in practice the actual number of ticks may vary, except
479 -- that we never change the value from zero to non-zero or vice versa.
480 --
481 tickishCounts :: Tickish id -> Bool
482 tickishCounts n@ProfNote{} = profNoteCount n
483 tickishCounts HpcTick{} = True
484 tickishCounts Breakpoint{} = True
485
486 tickishScoped :: Tickish id -> Bool
487 tickishScoped n@ProfNote{} = profNoteScope n
488 tickishScoped HpcTick{} = False
489 tickishScoped Breakpoint{} = True
490 -- Breakpoints are scoped: eventually we're going to do call
491 -- stacks, but also this helps prevent the simplifier from moving
492 -- breakpoints around and changing their result type (see #1531).
493
494 mkNoCount :: Tickish id -> Tickish id
495 mkNoCount n@ProfNote{} = n {profNoteCount = False}
496 mkNoCount Breakpoint{} = panic "mkNoCount: Breakpoint" -- cannot split a BP
497 mkNoCount HpcTick{} = panic "mkNoCount: HpcTick"
498
499 mkNoScope :: Tickish id -> Tickish id
500 mkNoScope n@ProfNote{} = n {profNoteScope = False}
501 mkNoScope Breakpoint{} = panic "mkNoScope: Breakpoint" -- cannot split a BP
502 mkNoScope HpcTick{} = panic "mkNoScope: HpcTick"
503
504 -- | Return True if this source annotation compiles to some code, or will
505 -- disappear before the backend.
506 tickishIsCode :: Tickish id -> Bool
507 tickishIsCode _tickish = True -- all of them for now
508
509 -- | Return True if this Tick can be split into (tick,scope) parts with
510 -- 'mkNoScope' and 'mkNoCount' respectively.
511 tickishCanSplit :: Tickish Id -> Bool
512 tickishCanSplit Breakpoint{} = False
513 tickishCanSplit HpcTick{} = False
514 tickishCanSplit _ = True
515
516 {-
517 ************************************************************************
518 * *
519 \subsection{Transformation rules}
520 * *
521 ************************************************************************
522
523 The CoreRule type and its friends are dealt with mainly in CoreRules,
524 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
525 -}
526
527 -- | A 'CoreRule' is:
528 --
529 -- * \"Local\" if the function it is a rule for is defined in the
530 -- same module as the rule itself.
531 --
532 -- * \"Orphan\" if nothing on the LHS is defined in the same module
533 -- as the rule itself
534 data CoreRule
535 = Rule {
536 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
537 ru_act :: Activation, -- ^ When the rule is active
538
539 -- Rough-matching stuff
540 -- see comments with InstEnv.ClsInst( is_cls, is_rough )
541 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
542 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
543
544 -- Proper-matching stuff
545 -- see comments with InstEnv.ClsInst( is_tvs, is_tys )
546 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
547 ru_args :: [CoreExpr], -- ^ Left hand side arguments
548
549 -- And the right-hand side
550 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
551 -- Occurrence info is guaranteed correct
552 -- See Note [OccInfo in unfoldings and rules]
553
554 -- Locality
555 ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
556 -- @False@ <=> generated at the users behest
557 -- Main effect: reporting of orphan-hood
558
559 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
560 -- defined in the same module as the rule
561 -- and is not an implicit 'Id' (like a record selector,
562 -- class operation, or data constructor)
563
564 -- NB: ru_local is *not* used to decide orphan-hood
565 -- c.g. MkIface.coreRuleToIfaceRule
566 }
567
568 -- | Built-in rules are used for constant folding
569 -- and suchlike. They have no free variables.
570 | BuiltinRule {
571 ru_name :: RuleName, -- ^ As above
572 ru_fn :: Name, -- ^ As above
573 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
574 -- if it fires, including type arguments
575 ru_try :: RuleFun
576 -- ^ This function does the rewrite. It given too many
577 -- arguments, it simply discards them; the returned 'CoreExpr'
578 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
579 }
580 -- See Note [Extra args in rule matching] in Rules.lhs
581
582 type RuleFun = DynFlags -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
583 type InScopeEnv = (InScopeSet, IdUnfoldingFun)
584
585 type IdUnfoldingFun = Id -> Unfolding
586 -- A function that embodies how to unfold an Id if you need
587 -- to do that in the Rule. The reason we need to pass this info in
588 -- is that whether an Id is unfoldable depends on the simplifier phase
589
590 isBuiltinRule :: CoreRule -> Bool
591 isBuiltinRule (BuiltinRule {}) = True
592 isBuiltinRule _ = False
593
594 isAutoRule :: CoreRule -> Bool
595 isAutoRule (BuiltinRule {}) = False
596 isAutoRule (Rule { ru_auto = is_auto }) = is_auto
597
598 -- | The number of arguments the 'ru_fn' must be applied
599 -- to before the rule can match on it
600 ruleArity :: CoreRule -> Int
601 ruleArity (BuiltinRule {ru_nargs = n}) = n
602 ruleArity (Rule {ru_args = args}) = length args
603
604 ruleName :: CoreRule -> RuleName
605 ruleName = ru_name
606
607 ruleActivation :: CoreRule -> Activation
608 ruleActivation (BuiltinRule { }) = AlwaysActive
609 ruleActivation (Rule { ru_act = act }) = act
610
611 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
612 ruleIdName :: CoreRule -> Name
613 ruleIdName = ru_fn
614
615 isLocalRule :: CoreRule -> Bool
616 isLocalRule = ru_local
617
618 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
619 setRuleIdName :: Name -> CoreRule -> CoreRule
620 setRuleIdName nm ru = ru { ru_fn = nm }
621
622 {-
623 ************************************************************************
624 * *
625 \subsection{Vectorisation declarations}
626 * *
627 ************************************************************************
628
629 Representation of desugared vectorisation declarations that are fed to the vectoriser (via
630 'ModGuts').
631 -}
632
633 data CoreVect = Vect Id CoreExpr
634 | NoVect Id
635 | VectType Bool TyCon (Maybe TyCon)
636 | VectClass TyCon -- class tycon
637 | VectInst Id -- instance dfun (always SCALAR) !!!FIXME: should be superfluous now
638
639 {-
640 ************************************************************************
641 * *
642 Unfoldings
643 * *
644 ************************************************************************
645
646 The @Unfolding@ type is declared here to avoid numerous loops
647 -}
648
649 -- | Records the /unfolding/ of an identifier, which is approximately the form the
650 -- identifier would have if we substituted its definition in for the identifier.
651 -- This type should be treated as abstract everywhere except in "CoreUnfold"
652 data Unfolding
653 = NoUnfolding -- ^ We have no information about the unfolding
654
655 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
656 -- @OtherCon xs@ also indicates that something has been evaluated
657 -- and hence there's no point in re-evaluating it.
658 -- @OtherCon []@ is used even for non-data-type values
659 -- to indicated evaluated-ness. Notably:
660 --
661 -- > data C = C !(Int -> Int)
662 -- > case x of { C f -> ... }
663 --
664 -- Here, @f@ gets an @OtherCon []@ unfolding.
665
666 | DFunUnfolding { -- The Unfolding of a DFunId
667 -- See Note [DFun unfoldings]
668 -- df = /\a1..am. \d1..dn. MkD t1 .. tk
669 -- (op1 a1..am d1..dn)
670 -- (op2 a1..am d1..dn)
671 df_bndrs :: [Var], -- The bound variables [a1..m],[d1..dn]
672 df_con :: DataCon, -- The dictionary data constructor (never a newtype datacon)
673 df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods,
674 } -- in positional order
675
676 | CoreUnfolding { -- An unfolding for an Id with no pragma,
677 -- or perhaps a NOINLINE pragma
678 -- (For NOINLINE, the phase, if any, is in the
679 -- InlinePragInfo for this Id.)
680 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
681 uf_src :: UnfoldingSource, -- Where the unfolding came from
682 uf_is_top :: Bool, -- True <=> top level binding
683 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
684 -- a `seq` on this variable
685 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
686 -- Cached version of exprIsConLike
687 uf_is_work_free :: Bool, -- True <=> doesn't waste (much) work to expand
688 -- inside an inlining
689 -- Cached version of exprIsCheap
690 uf_expandable :: Bool, -- True <=> can expand in RULE matching
691 -- Cached version of exprIsExpandable
692 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
693 }
694 -- ^ An unfolding with redundant cached information. Parameters:
695 --
696 -- uf_tmpl: Template used to perform unfolding;
697 -- NB: Occurrence info is guaranteed correct:
698 -- see Note [OccInfo in unfoldings and rules]
699 --
700 -- uf_is_top: Is this a top level binding?
701 --
702 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
703 -- this variable
704 --
705 -- uf_is_work_free: Does this waste only a little work if we expand it inside an inlining?
706 -- Basically this is a cached version of 'exprIsWorkFree'
707 --
708 -- uf_guidance: Tells us about the /size/ of the unfolding template
709
710
711 ------------------------------------------------
712 data UnfoldingSource
713 = -- See also Note [Historical note: unfoldings for wrappers]
714
715 InlineRhs -- The current rhs of the function
716 -- Replace uf_tmpl each time around
717
718 | InlineStable -- From an INLINE or INLINABLE pragma
719 -- INLINE if guidance is UnfWhen
720 -- INLINABLE if guidance is UnfIfGoodArgs/UnfoldNever
721 -- (well, technically an INLINABLE might be made
722 -- UnfWhen if it was small enough, and then
723 -- it will behave like INLINE outside the current
724 -- module, but that is the way automatic unfoldings
725 -- work so it is consistent with the intended
726 -- meaning of INLINABLE).
727 --
728 -- uf_tmpl may change, but only as a result of
729 -- gentle simplification, it doesn't get updated
730 -- to the current RHS during compilation as with
731 -- InlineRhs.
732 --
733 -- See Note [InlineRules]
734
735 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
736 -- Only a few primop-like things have this property
737 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
738 -- Inline absolutely always, however boring the context.
739
740
741
742 -- | 'UnfoldingGuidance' says when unfolding should take place
743 data UnfoldingGuidance
744 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
745 -- Used (a) for small *and* cheap unfoldings
746 -- (b) for INLINE functions
747 -- See Note [INLINE for small functions] in CoreUnfold
748 ug_arity :: Arity, -- Number of value arguments expected
749
750 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
751 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
752 -- So True,True means "always"
753 }
754
755 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
756 -- result of a simple analysis of the RHS
757
758 ug_args :: [Int], -- Discount if the argument is evaluated.
759 -- (i.e., a simplification will definitely
760 -- be possible). One elt of the list per *value* arg.
761
762 ug_size :: Int, -- The "size" of the unfolding.
763
764 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
765 } -- a context (case (thing args) of ...),
766 -- (where there are the right number of arguments.)
767
768 | UnfNever -- The RHS is big, so don't inline it
769
770 {-
771 Note [Historical note: unfoldings for wrappers]
772 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
773 We used to have a nice clever scheme in interface files for
774 wrappers. A wrapper's unfolding can be reconstructed from its worker's
775 id and its strictness. This decreased .hi file size (sometimes
776 significantly, for modules like GHC.Classes with many high-arity w/w
777 splits) and had a slight corresponding effect on compile times.
778
779 However, when we added the second demand analysis, this scheme lead to
780 some Core lint errors. The second analysis could change the strictness
781 signatures, which sometimes resulted in a wrapper's regenerated
782 unfolding applying the wrapper to too many arguments.
783
784 Instead of repairing the clever .hi scheme, we abandoned it in favor
785 of simplicity. The .hi sizes are usually insignificant (excluding the
786 +1M for base libraries), and compile time barely increases (~+1% for
787 nofib). The nicer upshot is that the UnfoldingSource no longer mentions
788 an Id, so, eg, substitutions need not traverse them.
789
790
791 Note [DFun unfoldings]
792 ~~~~~~~~~~~~~~~~~~~~~~
793 The Arity in a DFunUnfolding is total number of args (type and value)
794 that the DFun needs to produce a dictionary. That's not necessarily
795 related to the ordinary arity of the dfun Id, esp if the class has
796 one method, so the dictionary is represented by a newtype. Example
797
798 class C a where { op :: a -> Int }
799 instance C a -> C [a] where op xs = op (head xs)
800
801 The instance translates to
802
803 $dfCList :: forall a. C a => C [a] -- Arity 2!
804 $dfCList = /\a.\d. $copList {a} d |> co
805
806 $copList :: forall a. C a => [a] -> Int -- Arity 2!
807 $copList = /\a.\d.\xs. op {a} d (head xs)
808
809 Now we might encounter (op (dfCList {ty} d) a1 a2)
810 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
811 has all its arguments, even though its (value) arity is 2. That's
812 why we record the number of expected arguments in the DFunUnfolding.
813
814 Note that although it's an Arity, it's most convenient for it to give
815 the *total* number of arguments, both type and value. See the use
816 site in exprIsConApp_maybe.
817 -}
818
819 -- Constants for the UnfWhen constructor
820 needSaturated, unSaturatedOk :: Bool
821 needSaturated = False
822 unSaturatedOk = True
823
824 boringCxtNotOk, boringCxtOk :: Bool
825 boringCxtOk = True
826 boringCxtNotOk = False
827
828 ------------------------------------------------
829 noUnfolding :: Unfolding
830 -- ^ There is no known 'Unfolding'
831 evaldUnfolding :: Unfolding
832 -- ^ This unfolding marks the associated thing as being evaluated
833
834 noUnfolding = NoUnfolding
835 evaldUnfolding = OtherCon []
836
837 mkOtherCon :: [AltCon] -> Unfolding
838 mkOtherCon = OtherCon
839
840 seqUnfolding :: Unfolding -> ()
841 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
842 uf_is_value = b1, uf_is_work_free = b2,
843 uf_expandable = b3, uf_is_conlike = b4,
844 uf_guidance = g})
845 = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
846
847 seqUnfolding _ = ()
848
849 seqGuidance :: UnfoldingGuidance -> ()
850 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
851 seqGuidance _ = ()
852
853 isStableSource :: UnfoldingSource -> Bool
854 -- Keep the unfolding template
855 isStableSource InlineCompulsory = True
856 isStableSource InlineStable = True
857 isStableSource InlineRhs = False
858
859 -- | Retrieves the template of an unfolding: panics if none is known
860 unfoldingTemplate :: Unfolding -> CoreExpr
861 unfoldingTemplate = uf_tmpl
862
863 -- | Retrieves the template of an unfolding if possible
864 -- maybeUnfoldingTemplate is used mainly wnen specialising, and we do
865 -- want to specialise DFuns, so it's important to return a template
866 -- for DFunUnfoldings
867 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
868 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })
869 = Just expr
870 maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })
871 = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args))
872 maybeUnfoldingTemplate _
873 = Nothing
874
875 -- | The constructors that the unfolding could never be:
876 -- returns @[]@ if no information is available
877 otherCons :: Unfolding -> [AltCon]
878 otherCons (OtherCon cons) = cons
879 otherCons _ = []
880
881 -- | Determines if it is certainly the case that the unfolding will
882 -- yield a value (something in HNF): returns @False@ if unsure
883 isValueUnfolding :: Unfolding -> Bool
884 -- Returns False for OtherCon
885 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
886 isValueUnfolding _ = False
887
888 -- | Determines if it possibly the case that the unfolding will
889 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
890 -- for 'OtherCon'
891 isEvaldUnfolding :: Unfolding -> Bool
892 -- Returns True for OtherCon
893 isEvaldUnfolding (OtherCon _) = True
894 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
895 isEvaldUnfolding _ = False
896
897 -- | @True@ if the unfolding is a constructor application, the application
898 -- of a CONLIKE function or 'OtherCon'
899 isConLikeUnfolding :: Unfolding -> Bool
900 isConLikeUnfolding (OtherCon _) = True
901 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
902 isConLikeUnfolding _ = False
903
904 -- | Is the thing we will unfold into certainly cheap?
905 isCheapUnfolding :: Unfolding -> Bool
906 isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf
907 isCheapUnfolding _ = False
908
909 isExpandableUnfolding :: Unfolding -> Bool
910 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
911 isExpandableUnfolding _ = False
912
913 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
914 -- Expand an expandable unfolding; this is used in rule matching
915 -- See Note [Expanding variables] in Rules.lhs
916 -- The key point here is that CONLIKE things can be expanded
917 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
918 expandUnfolding_maybe _ = Nothing
919
920 hasStableCoreUnfolding_maybe :: Unfolding -> Maybe Bool
921 -- Just True <=> has stable inlining, very keen to inline (eg. INLINE pragma)
922 -- Just False <=> has stable inlining, open to inlining it (eg. INLINEABLE pragma)
923 -- Nothing <=> not stable, or cannot inline it anyway
924 hasStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
925 | isStableSource src
926 = case guide of
927 UnfWhen {} -> Just True
928 UnfIfGoodArgs {} -> Just False
929 UnfNever -> Nothing
930 hasStableCoreUnfolding_maybe _ = Nothing
931
932 isCompulsoryUnfolding :: Unfolding -> Bool
933 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
934 isCompulsoryUnfolding _ = False
935
936 isStableUnfolding :: Unfolding -> Bool
937 -- True of unfoldings that should not be overwritten
938 -- by a CoreUnfolding for the RHS of a let-binding
939 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
940 isStableUnfolding (DFunUnfolding {}) = True
941 isStableUnfolding _ = False
942
943 isClosedUnfolding :: Unfolding -> Bool -- No free variables
944 isClosedUnfolding (CoreUnfolding {}) = False
945 isClosedUnfolding (DFunUnfolding {}) = False
946 isClosedUnfolding _ = True
947
948 -- | Only returns False if there is no unfolding information available at all
949 hasSomeUnfolding :: Unfolding -> Bool
950 hasSomeUnfolding NoUnfolding = False
951 hasSomeUnfolding _ = True
952
953 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
954 neverUnfoldGuidance UnfNever = True
955 neverUnfoldGuidance _ = False
956
957 canUnfold :: Unfolding -> Bool
958 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
959 canUnfold _ = False
960
961 {-
962 Note [InlineRules]
963 ~~~~~~~~~~~~~~~~~
964 When you say
965 {-# INLINE f #-}
966 f x = <rhs>
967 you intend that calls (f e) are replaced by <rhs>[e/x] So we
968 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
969 with it. Meanwhile, we can optimise <rhs> to our heart's content,
970 leaving the original unfolding intact in Unfolding of 'f'. For example
971 all xs = foldr (&&) True xs
972 any p = all . map p {-# INLINE any #-}
973 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
974 which deforests well at the call site.
975
976 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
977
978 Moreover, it's only used when 'f' is applied to the
979 specified number of arguments; that is, the number of argument on
980 the LHS of the '=' sign in the original source definition.
981 For example, (.) is now defined in the libraries like this
982 {-# INLINE (.) #-}
983 (.) f g = \x -> f (g x)
984 so that it'll inline when applied to two arguments. If 'x' appeared
985 on the left, thus
986 (.) f g x = f (g x)
987 it'd only inline when applied to three arguments. This slightly-experimental
988 change was requested by Roman, but it seems to make sense.
989
990 See also Note [Inlining an InlineRule] in CoreUnfold.
991
992
993 Note [OccInfo in unfoldings and rules]
994 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
995 In unfoldings and rules, we guarantee that the template is occ-analysed,
996 so that the occurrence info on the binders is correct. This is important,
997 because the Simplifier does not re-analyse the template when using it. If
998 the occurrence info is wrong
999 - We may get more simpifier iterations than necessary, because
1000 once-occ info isn't there
1001 - More seriously, we may get an infinite loop if there's a Rec
1002 without a loop breaker marked
1003
1004
1005 ************************************************************************
1006 * *
1007 AltCon
1008 * *
1009 ************************************************************************
1010 -}
1011
1012 -- The Ord is needed for the FiniteMap used in the lookForConstructor
1013 -- in SimplEnv. If you declared that lookForConstructor *ignores*
1014 -- constructor-applications with LitArg args, then you could get
1015 -- rid of this Ord.
1016
1017 instance Outputable AltCon where
1018 ppr (DataAlt dc) = ppr dc
1019 ppr (LitAlt lit) = ppr lit
1020 ppr DEFAULT = ptext (sLit "__DEFAULT")
1021
1022 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
1023 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
1024
1025 ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool
1026 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
1027
1028 cmpAltCon :: AltCon -> AltCon -> Ordering
1029 -- ^ Compares 'AltCon's within a single list of alternatives
1030 cmpAltCon DEFAULT DEFAULT = EQ
1031 cmpAltCon DEFAULT _ = LT
1032
1033 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
1034 cmpAltCon (DataAlt _) DEFAULT = GT
1035 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
1036 cmpAltCon (LitAlt _) DEFAULT = GT
1037
1038 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
1039 ppr con1 <+> ppr con2 )
1040 LT
1041
1042 {-
1043 ************************************************************************
1044 * *
1045 \subsection{Useful synonyms}
1046 * *
1047 ************************************************************************
1048
1049 Note [CoreProgram]
1050 ~~~~~~~~~~~~~~~~~~
1051 The top level bindings of a program, a CoreProgram, are represented as
1052 a list of CoreBind
1053
1054 * Later bindings in the list can refer to earlier ones, but not vice
1055 versa. So this is OK
1056 NonRec { x = 4 }
1057 Rec { p = ...q...x...
1058 ; q = ...p...x }
1059 Rec { f = ...p..x..f.. }
1060 NonRec { g = ..f..q...x.. }
1061 But it would NOT be ok for 'f' to refer to 'g'.
1062
1063 * The occurrence analyser does strongly-connected component analysis
1064 on each Rec binding, and splits it into a sequence of smaller
1065 bindings where possible. So the program typically starts life as a
1066 single giant Rec, which is then dependency-analysed into smaller
1067 chunks.
1068 -}
1069
1070 -- If you edit this type, you may need to update the GHC formalism
1071 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
1072 type CoreProgram = [CoreBind] -- See Note [CoreProgram]
1073
1074 -- | The common case for the type of binders and variables when
1075 -- we are manipulating the Core language within GHC
1076 type CoreBndr = Var
1077 -- | Expressions where binders are 'CoreBndr's
1078 type CoreExpr = Expr CoreBndr
1079 -- | Argument expressions where binders are 'CoreBndr's
1080 type CoreArg = Arg CoreBndr
1081 -- | Binding groups where binders are 'CoreBndr's
1082 type CoreBind = Bind CoreBndr
1083 -- | Case alternatives where binders are 'CoreBndr's
1084 type CoreAlt = Alt CoreBndr
1085
1086 {-
1087 ************************************************************************
1088 * *
1089 \subsection{Tagging}
1090 * *
1091 ************************************************************************
1092 -}
1093
1094 -- | Binders are /tagged/ with a t
1095 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
1096
1097 type TaggedBind t = Bind (TaggedBndr t)
1098 type TaggedExpr t = Expr (TaggedBndr t)
1099 type TaggedArg t = Arg (TaggedBndr t)
1100 type TaggedAlt t = Alt (TaggedBndr t)
1101
1102 instance Outputable b => Outputable (TaggedBndr b) where
1103 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
1104
1105 instance Outputable b => OutputableBndr (TaggedBndr b) where
1106 pprBndr _ b = ppr b -- Simple
1107 pprInfixOcc b = ppr b
1108 pprPrefixOcc b = ppr b
1109
1110 deTagExpr :: TaggedExpr t -> CoreExpr
1111 deTagExpr (Var v) = Var v
1112 deTagExpr (Lit l) = Lit l
1113 deTagExpr (Type ty) = Type ty
1114 deTagExpr (Coercion co) = Coercion co
1115 deTagExpr (App e1 e2) = App (deTagExpr e1) (deTagExpr e2)
1116 deTagExpr (Lam (TB b _) e) = Lam b (deTagExpr e)
1117 deTagExpr (Let bind body) = Let (deTagBind bind) (deTagExpr body)
1118 deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)
1119 deTagExpr (Tick t e) = Tick t (deTagExpr e)
1120 deTagExpr (Cast e co) = Cast (deTagExpr e) co
1121
1122 deTagBind :: TaggedBind t -> CoreBind
1123 deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)
1124 deTagBind (Rec prs) = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]
1125
1126 deTagAlt :: TaggedAlt t -> CoreAlt
1127 deTagAlt (con, bndrs, rhs) = (con, [b | TB b _ <- bndrs], deTagExpr rhs)
1128
1129 {-
1130 ************************************************************************
1131 * *
1132 \subsection{Core-constructing functions with checking}
1133 * *
1134 ************************************************************************
1135 -}
1136
1137 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
1138 -- use 'MkCore.mkCoreApps' if possible
1139 mkApps :: Expr b -> [Arg b] -> Expr b
1140 -- | Apply a list of type argument expressions to a function expression in a nested fashion
1141 mkTyApps :: Expr b -> [Type] -> Expr b
1142 -- | Apply a list of coercion argument expressions to a function expression in a nested fashion
1143 mkCoApps :: Expr b -> [Coercion] -> Expr b
1144 -- | Apply a list of type or value variables to a function expression in a nested fashion
1145 mkVarApps :: Expr b -> [Var] -> Expr b
1146 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
1147 -- use 'MkCore.mkCoreConApps' if possible
1148 mkConApp :: DataCon -> [Arg b] -> Expr b
1149
1150 mkApps f args = foldl App f args
1151 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
1152 mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args
1153 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
1154 mkConApp con args = mkApps (Var (dataConWorkId con)) args
1155
1156 mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
1157 mkConApp2 con tys arg_ids = Var (dataConWorkId con)
1158 `mkApps` map Type tys
1159 `mkApps` map varToCoreExpr arg_ids
1160
1161
1162 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
1163 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1164 mkIntLit :: DynFlags -> Integer -> Expr b
1165 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
1166 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1167 mkIntLitInt :: DynFlags -> Int -> Expr b
1168
1169 mkIntLit dflags n = Lit (mkMachInt dflags n)
1170 mkIntLitInt dflags n = Lit (mkMachInt dflags (toInteger n))
1171
1172 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
1173 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1174 mkWordLit :: DynFlags -> Integer -> Expr b
1175 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
1176 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1177 mkWordLitWord :: DynFlags -> Word -> Expr b
1178
1179 mkWordLit dflags w = Lit (mkMachWord dflags w)
1180 mkWordLitWord dflags w = Lit (mkMachWord dflags (toInteger w))
1181
1182 mkWord64LitWord64 :: Word64 -> Expr b
1183 mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
1184
1185 mkInt64LitInt64 :: Int64 -> Expr b
1186 mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))
1187
1188 -- | Create a machine character literal expression of type @Char#@.
1189 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
1190 mkCharLit :: Char -> Expr b
1191 -- | Create a machine string literal expression of type @Addr#@.
1192 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
1193 mkStringLit :: String -> Expr b
1194
1195 mkCharLit c = Lit (mkMachChar c)
1196 mkStringLit s = Lit (mkMachString s)
1197
1198 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
1199 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1200 mkFloatLit :: Rational -> Expr b
1201 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
1202 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1203 mkFloatLitFloat :: Float -> Expr b
1204
1205 mkFloatLit f = Lit (mkMachFloat f)
1206 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
1207
1208 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
1209 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1210 mkDoubleLit :: Rational -> Expr b
1211 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
1212 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1213 mkDoubleLitDouble :: Double -> Expr b
1214
1215 mkDoubleLit d = Lit (mkMachDouble d)
1216 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
1217
1218 -- | Bind all supplied binding groups over an expression in a nested let expression. Assumes
1219 -- that the rhs satisfies the let/app invariant. Prefer to use 'MkCore.mkCoreLets' if
1220 -- possible, which does guarantee the invariant
1221 mkLets :: [Bind b] -> Expr b -> Expr b
1222 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
1223 -- use 'MkCore.mkCoreLams' if possible
1224 mkLams :: [b] -> Expr b -> Expr b
1225
1226 mkLams binders body = foldr Lam body binders
1227 mkLets binds body = foldr Let body binds
1228
1229
1230 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1231 -- this can only be used to bind something in a non-recursive @let@ expression
1232 mkTyBind :: TyVar -> Type -> CoreBind
1233 mkTyBind tv ty = NonRec tv (Type ty)
1234
1235 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1236 -- this can only be used to bind something in a non-recursive @let@ expression
1237 mkCoBind :: CoVar -> Coercion -> CoreBind
1238 mkCoBind cv co = NonRec cv (Coercion co)
1239
1240 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
1241 varToCoreExpr :: CoreBndr -> Expr b
1242 varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)
1243 | isCoVar v = Coercion (mkCoVarCo v)
1244 | otherwise = ASSERT( isId v ) Var v
1245
1246 varsToCoreExprs :: [CoreBndr] -> [Expr b]
1247 varsToCoreExprs vs = map varToCoreExpr vs
1248
1249 {-
1250 ************************************************************************
1251 * *
1252 \subsection{Simple access functions}
1253 * *
1254 ************************************************************************
1255 -}
1256
1257 -- | Extract every variable by this group
1258 bindersOf :: Bind b -> [b]
1259 -- If you edit this function, you may need to update the GHC formalism
1260 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
1261 bindersOf (NonRec binder _) = [binder]
1262 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
1263
1264 -- | 'bindersOf' applied to a list of binding groups
1265 bindersOfBinds :: [Bind b] -> [b]
1266 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
1267
1268 rhssOfBind :: Bind b -> [Expr b]
1269 rhssOfBind (NonRec _ rhs) = [rhs]
1270 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
1271
1272 rhssOfAlts :: [Alt b] -> [Expr b]
1273 rhssOfAlts alts = [e | (_,_,e) <- alts]
1274
1275 -- | Collapse all the bindings in the supplied groups into a single
1276 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
1277 flattenBinds :: [Bind b] -> [(b, Expr b)]
1278 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
1279 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
1280 flattenBinds [] = []
1281
1282 -- | We often want to strip off leading lambdas before getting down to
1283 -- business. This function is your friend.
1284 collectBinders :: Expr b -> ([b], Expr b)
1285 -- | Collect as many type bindings as possible from the front of a nested lambda
1286 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
1287 -- | Collect as many value bindings as possible from the front of a nested lambda
1288 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
1289 -- | Collect type binders from the front of the lambda first,
1290 -- then follow up by collecting as many value bindings as possible
1291 -- from the resulting stripped expression
1292 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
1293
1294 collectBinders expr
1295 = go [] expr
1296 where
1297 go bs (Lam b e) = go (b:bs) e
1298 go bs e = (reverse bs, e)
1299
1300 collectTyAndValBinders expr
1301 = (tvs, ids, body)
1302 where
1303 (tvs, body1) = collectTyBinders expr
1304 (ids, body) = collectValBinders body1
1305
1306 collectTyBinders expr
1307 = go [] expr
1308 where
1309 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
1310 go tvs e = (reverse tvs, e)
1311
1312 collectValBinders expr
1313 = go [] expr
1314 where
1315 go ids (Lam b e) | isId b = go (b:ids) e
1316 go ids body = (reverse ids, body)
1317
1318 -- | Takes a nested application expression and returns the the function
1319 -- being applied and the arguments to which it is applied
1320 collectArgs :: Expr b -> (Expr b, [Arg b])
1321 collectArgs expr
1322 = go expr []
1323 where
1324 go (App f a) as = go f (a:as)
1325 go e as = (e, as)
1326
1327 {-
1328 ************************************************************************
1329 * *
1330 \subsection{Predicates}
1331 * *
1332 ************************************************************************
1333
1334 At one time we optionally carried type arguments through to runtime.
1335 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1336 i.e. if type applications are actual lambdas because types are kept around
1337 at runtime. Similarly isRuntimeArg.
1338 -}
1339
1340 -- | Will this variable exist at runtime?
1341 isRuntimeVar :: Var -> Bool
1342 isRuntimeVar = isId
1343
1344 -- | Will this argument expression exist at runtime?
1345 isRuntimeArg :: CoreExpr -> Bool
1346 isRuntimeArg = isValArg
1347
1348 -- | Returns @True@ for value arguments, false for type args
1349 -- NB: coercions are value arguments (zero width, to be sure,
1350 -- like State#, but still value args).
1351 isValArg :: Expr b -> Bool
1352 isValArg e = not (isTypeArg e)
1353
1354 -- | Returns @True@ iff the expression is a 'Type' or 'Coercion'
1355 -- expression at its top level
1356 isTyCoArg :: Expr b -> Bool
1357 isTyCoArg (Type {}) = True
1358 isTyCoArg (Coercion {}) = True
1359 isTyCoArg _ = False
1360
1361 -- | Returns @True@ iff the expression is a 'Type' expression at its
1362 -- top level. Note this does NOT include 'Coercion's.
1363 isTypeArg :: Expr b -> Bool
1364 isTypeArg (Type {}) = True
1365 isTypeArg _ = False
1366
1367 -- | The number of binders that bind values rather than types
1368 valBndrCount :: [CoreBndr] -> Int
1369 valBndrCount = count isId
1370
1371 -- | The number of argument expressions that are values rather than types at their top level
1372 valArgCount :: [Arg b] -> Int
1373 valArgCount = count isValArg
1374
1375 {-
1376 ************************************************************************
1377 * *
1378 \subsection{Seq stuff}
1379 * *
1380 ************************************************************************
1381 -}
1382
1383 seqExpr :: CoreExpr -> ()
1384 seqExpr (Var v) = v `seq` ()
1385 seqExpr (Lit lit) = lit `seq` ()
1386 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1387 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1388 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1389 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1390 seqExpr (Cast e co) = seqExpr e `seq` seqCo co
1391 seqExpr (Tick n e) = seqTickish n `seq` seqExpr e
1392 seqExpr (Type t) = seqType t
1393 seqExpr (Coercion co) = seqCo co
1394
1395 seqExprs :: [CoreExpr] -> ()
1396 seqExprs [] = ()
1397 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1398
1399 seqTickish :: Tickish Id -> ()
1400 seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
1401 seqTickish HpcTick{} = ()
1402 seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
1403
1404 seqBndr :: CoreBndr -> ()
1405 seqBndr b = b `seq` ()
1406
1407 seqBndrs :: [CoreBndr] -> ()
1408 seqBndrs [] = ()
1409 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1410
1411 seqBind :: Bind CoreBndr -> ()
1412 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1413 seqBind (Rec prs) = seqPairs prs
1414
1415 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1416 seqPairs [] = ()
1417 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1418
1419 seqAlts :: [CoreAlt] -> ()
1420 seqAlts [] = ()
1421 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1422
1423 seqRules :: [CoreRule] -> ()
1424 seqRules [] = ()
1425 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1426 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1427 seqRules (BuiltinRule {} : rules) = seqRules rules
1428
1429 {-
1430 ************************************************************************
1431 * *
1432 \subsection{Annotated core}
1433 * *
1434 ************************************************************************
1435 -}
1436
1437 -- | Annotated core: allows annotation at every node in the tree
1438 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1439
1440 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1441 data AnnExpr' bndr annot
1442 = AnnVar Id
1443 | AnnLit Literal
1444 | AnnLam bndr (AnnExpr bndr annot)
1445 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1446 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1447 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1448 | AnnCast (AnnExpr bndr annot) (annot, Coercion)
1449 -- Put an annotation on the (root of) the coercion
1450 | AnnTick (Tickish Id) (AnnExpr bndr annot)
1451 | AnnType Type
1452 | AnnCoercion Coercion
1453
1454 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1455 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1456
1457 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1458 data AnnBind bndr annot
1459 = AnnNonRec bndr (AnnExpr bndr annot)
1460 | AnnRec [(bndr, AnnExpr bndr annot)]
1461
1462 -- | Takes a nested application expression and returns the the function
1463 -- being applied and the arguments to which it is applied
1464 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1465 collectAnnArgs expr
1466 = go expr []
1467 where
1468 go (_, AnnApp f a) as = go f (a:as)
1469 go e as = (e, as)
1470
1471 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1472 deAnnotate (_, e) = deAnnotate' e
1473
1474 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1475 deAnnotate' (AnnType t) = Type t
1476 deAnnotate' (AnnCoercion co) = Coercion co
1477 deAnnotate' (AnnVar v) = Var v
1478 deAnnotate' (AnnLit lit) = Lit lit
1479 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1480 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1481 deAnnotate' (AnnCast e (_,co)) = Cast (deAnnotate e) co
1482 deAnnotate' (AnnTick tick body) = Tick tick (deAnnotate body)
1483
1484 deAnnotate' (AnnLet bind body)
1485 = Let (deAnnBind bind) (deAnnotate body)
1486 where
1487 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1488 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1489
1490 deAnnotate' (AnnCase scrut v t alts)
1491 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1492
1493 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1494 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1495
1496 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1497 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1498 collectAnnBndrs e
1499 = collect [] e
1500 where
1501 collect bs (_, AnnLam b body) = collect (b:bs) body
1502 collect bs body = (reverse bs, body)