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