Annotation linting
[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.lhs
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.lhs
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.lhs
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.lhs
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 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.lhs
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
498 -- | A "counting tick" (where tickishCounts is True) is one that
499 -- counts evaluations in some way. We cannot discard a counting tick,
500 -- and the compiler should preserve the number of counting ticks as
501 -- far as possible.
502 --
503 -- However, we still allow the simplifier to increase or decrease
504 -- sharing, so in practice the actual number of ticks may vary, except
505 -- that we never change the value from zero to non-zero or vice versa.
506 tickishCounts :: Tickish id -> Bool
507 tickishCounts n@ProfNote{} = profNoteCount n
508 tickishCounts HpcTick{} = True
509 tickishCounts Breakpoint{} = True
510 tickishCounts _ = False
511
512
513 -- | Specifies the scoping behaviour of ticks. This governs the
514 -- behaviour of ticks that care about the covered code and the cost
515 -- associated with it. Important for ticks relating to profiling.
516 data TickishScoping =
517 -- | No scoping: The tick does not care about what code it
518 -- covers. Transformations can freely move code inside as well as
519 -- outside without any additional annotation obligations
520 NoScope
521
522 -- | Soft scoping: We want all code that is covered to stay
523 -- covered. Note that this scope type does not forbid
524 -- transformations from happening, as as long as all results of
525 -- the transformations are still covered by this tick or a copy of
526 -- it. For example
527 --
528 -- let x = tick<...> (let y = foo in bar) in baz
529 -- ===>
530 -- let x = tick<...> bar; y = tick<...> foo in baz
531 --
532 -- Is a valid transformation as far as "bar" and "foo" is
533 -- concerned, because both still are scoped over by the tick.
534 --
535 -- Note though that one might object to the "let" not being
536 -- covered by the tick any more. However, we are generally lax
537 -- with this - constant costs don't matter too much, and given
538 -- that the "let" was effectively merged we can view it as having
539 -- lost its identity anyway.
540 --
541 -- Also note that this scoping behaviour allows floating a tick
542 -- "upwards" in pretty much any situation. For example:
543 --
544 -- case foo of x -> tick<...> bar
545 -- ==>
546 -- tick<...> case foo of x -> bar
547 --
548 -- While this is always leagl, we want to make a best effort to
549 -- only make us of this where it exposes transformation
550 -- opportunities.
551 | SoftScope
552
553 -- | Cost centre scoping: We don't want any costs to move to other
554 -- cost-centre stacks. This means we not only want no code or cost
555 -- to get moved out of their cost centres, but we also object to
556 -- code getting associated with new cost-centre ticks - or
557 -- changing the order in which they get applied.
558 --
559 -- A rule of thumb is that we don't want any code to gain new
560 -- annotations. However, there are notable exceptions, for
561 -- example:
562 --
563 -- let f = \y -> foo in tick<...> ... (f x) ...
564 -- ==>
565 -- tick<...> ... foo[x/y] ...
566 --
567 -- In-lining lambdas like this is always legal, because inlining a
568 -- function does not change the cost-centre stack when the
569 -- function is called.
570 | CostCentreScope
571
572 deriving (Eq)
573
574 -- | Returns the intended scoping rule for a Tickish
575 tickishScoped :: Tickish id -> TickishScoping
576 tickishScoped n@ProfNote{}
577 | profNoteScope n = CostCentreScope
578 | otherwise = NoScope
579 tickishScoped HpcTick{} = NoScope
580 tickishScoped Breakpoint{} = CostCentreScope
581 -- Breakpoints are scoped: eventually we're going to do call
582 -- stacks, but also this helps prevent the simplifier from moving
583 -- breakpoints around and changing their result type (see #1531).
584 tickishScoped SourceNote{} = SoftScope
585
586 -- | Returns whether the tick scoping rule is at least as permissive
587 -- as the given scoping rule.
588 tickishScopesLike :: Tickish id -> TickishScoping -> Bool
589 tickishScopesLike t scope = tickishScoped t `like` scope
590 where NoScope `like` _ = True
591 _ `like` NoScope = False
592 SoftScope `like` _ = True
593 _ `like` SoftScope = False
594 CostCentreScope `like` _ = True
595
596 -- | Returns @True@ for ticks that can be floated upwards easily even
597 -- where it might change execution counts, such as:
598 --
599 -- Just (tick<...> foo)
600 -- ==>
601 -- tick<...> (Just foo)
602 --
603 -- This is a combination of @tickishSoftScope@ and
604 -- @tickishCounts@. Note that in principle splittable ticks can become
605 -- floatable using @mkNoTick@ -- even though there's currently no
606 -- tickish for which that is the case.
607 tickishFloatable :: Tickish id -> Bool
608 tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
609
610 -- | Returns @True@ for a tick that is both counting /and/ scoping and
611 -- can be split into its (tick, scope) parts using 'mkNoScope' and
612 -- 'mkNoTick' respectively.
613 tickishCanSplit :: Tickish id -> Bool
614 tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}
615 = True
616 tickishCanSplit _ = False
617
618 mkNoCount :: Tickish id -> Tickish id
619 mkNoCount n | not (tickishCounts n) = n
620 | not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"
621 mkNoCount n@ProfNote{} = n {profNoteCount = False}
622 mkNoCount _ = panic "mkNoCount: Undefined split!"
623
624 mkNoScope :: Tickish id -> Tickish id
625 mkNoScope n | tickishScoped n == NoScope = n
626 | not (tickishCanSplit n) = panic "mkNoScope: Cannot split!"
627 mkNoScope n@ProfNote{} = n {profNoteScope = False}
628 mkNoScope _ = panic "mkNoScope: Undefined split!"
629
630 -- | Return @True@ if this source annotation compiles to some backend
631 -- code. Without this flag, the tickish is seen as a simple annotation
632 -- that does not have any associated evaluation code.
633 --
634 -- What this means that we are allowed to disregard the tick if doing
635 -- so means that we can skip generating any code in the first place. A
636 -- typical example is top-level bindings:
637 --
638 -- foo = tick<...> \y -> ...
639 -- ==>
640 -- foo = \y -> tick<...> ...
641 --
642 -- Here there is just no operational difference between the first and
643 -- the second version. Therefore code generation should simply
644 -- translate the code as if it found the latter.
645 tickishIsCode :: Tickish id -> Bool
646 tickishIsCode SourceNote{} = False
647 tickishIsCode _tickish = True -- all the rest for now
648
649
650 -- | Governs the kind of expression that the tick gets placed on when
651 -- annotating for example using @mkTick@. If we find that we want to
652 -- put a tickish on an expression ruled out here, we try to float it
653 -- inwards until we find a suitable expression.
654 data TickishPlacement =
655
656 -- | Place ticks exactly on run-time expressions. We can still
657 -- move the tick through pure compile-time constructs such as
658 -- other ticks, casts or type lambdas. This is the most
659 -- restrictive placement rule for ticks, as all tickishs have in
660 -- common that they want to track runtime processes. The only
661 -- legal placement rule for counting ticks.
662 PlaceRuntime
663
664 -- | As @PlaceRuntime@, but we float the tick through all
665 -- lambdas. This makes sense where there is little difference
666 -- between annotating the lambda and annotating the lambda's code.
667 | PlaceNonLam
668
669 -- | In addition to floating through lambdas, cost-centre style
670 -- tickishs can also be moved from constructors, non-function
671 -- variables and literals. For example:
672 --
673 -- let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
674 --
675 -- Neither the constructor application, the variable or the
676 -- literal are likely to have any cost worth mentioning. And even
677 -- if y names a thunk, the call would not care about the
678 -- evaluation context. Therefore removing all annotations in the
679 -- above example is safe.
680 | PlaceCostCentre
681
682 deriving (Eq)
683
684 -- | Placement behaviour we want for the ticks
685 tickishPlace :: Tickish id -> TickishPlacement
686 tickishPlace n@ProfNote{}
687 | profNoteCount n = PlaceRuntime
688 | otherwise = PlaceCostCentre
689 tickishPlace HpcTick{} = PlaceRuntime
690 tickishPlace Breakpoint{} = PlaceRuntime
691 tickishPlace SourceNote{} = PlaceNonLam
692
693 -- | Returns whether one tick "contains" the other one, therefore
694 -- making the second tick redundant.
695 tickishContains :: Eq b => Tickish b -> Tickish b -> Bool
696 tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)
697 = n1 == n2 && containsSpan sp1 sp2
698 tickishContains t1 t2
699 = t1 == t2
700
701 {-
702 ************************************************************************
703 * *
704 \subsection{Transformation rules}
705 * *
706 ************************************************************************
707
708 The CoreRule type and its friends are dealt with mainly in CoreRules,
709 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
710 -}
711
712 -- | A 'CoreRule' is:
713 --
714 -- * \"Local\" if the function it is a rule for is defined in the
715 -- same module as the rule itself.
716 --
717 -- * \"Orphan\" if nothing on the LHS is defined in the same module
718 -- as the rule itself
719 data CoreRule
720 = Rule {
721 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
722 ru_act :: Activation, -- ^ When the rule is active
723
724 -- Rough-matching stuff
725 -- see comments with InstEnv.ClsInst( is_cls, is_rough )
726 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
727 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
728
729 -- Proper-matching stuff
730 -- see comments with InstEnv.ClsInst( is_tvs, is_tys )
731 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
732 ru_args :: [CoreExpr], -- ^ Left hand side arguments
733
734 -- And the right-hand side
735 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
736 -- Occurrence info is guaranteed correct
737 -- See Note [OccInfo in unfoldings and rules]
738
739 -- Locality
740 ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
741 -- @False@ <=> generated at the users behest
742 -- Main effect: reporting of orphan-hood
743
744 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
745 -- defined in the same module as the rule
746 -- and is not an implicit 'Id' (like a record selector,
747 -- class operation, or data constructor)
748
749 -- NB: ru_local is *not* used to decide orphan-hood
750 -- c.g. MkIface.coreRuleToIfaceRule
751 }
752
753 -- | Built-in rules are used for constant folding
754 -- and suchlike. They have no free variables.
755 | BuiltinRule {
756 ru_name :: RuleName, -- ^ As above
757 ru_fn :: Name, -- ^ As above
758 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
759 -- if it fires, including type arguments
760 ru_try :: RuleFun
761 -- ^ This function does the rewrite. It given too many
762 -- arguments, it simply discards them; the returned 'CoreExpr'
763 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
764 }
765 -- See Note [Extra args in rule matching] in Rules.lhs
766
767 type RuleFun = DynFlags -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
768 type InScopeEnv = (InScopeSet, IdUnfoldingFun)
769
770 type IdUnfoldingFun = Id -> Unfolding
771 -- A function that embodies how to unfold an Id if you need
772 -- to do that in the Rule. The reason we need to pass this info in
773 -- is that whether an Id is unfoldable depends on the simplifier phase
774
775 isBuiltinRule :: CoreRule -> Bool
776 isBuiltinRule (BuiltinRule {}) = True
777 isBuiltinRule _ = False
778
779 isAutoRule :: CoreRule -> Bool
780 isAutoRule (BuiltinRule {}) = False
781 isAutoRule (Rule { ru_auto = is_auto }) = is_auto
782
783 -- | The number of arguments the 'ru_fn' must be applied
784 -- to before the rule can match on it
785 ruleArity :: CoreRule -> Int
786 ruleArity (BuiltinRule {ru_nargs = n}) = n
787 ruleArity (Rule {ru_args = args}) = length args
788
789 ruleName :: CoreRule -> RuleName
790 ruleName = ru_name
791
792 ruleActivation :: CoreRule -> Activation
793 ruleActivation (BuiltinRule { }) = AlwaysActive
794 ruleActivation (Rule { ru_act = act }) = act
795
796 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
797 ruleIdName :: CoreRule -> Name
798 ruleIdName = ru_fn
799
800 isLocalRule :: CoreRule -> Bool
801 isLocalRule = ru_local
802
803 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
804 setRuleIdName :: Name -> CoreRule -> CoreRule
805 setRuleIdName nm ru = ru { ru_fn = nm }
806
807 {-
808 ************************************************************************
809 * *
810 \subsection{Vectorisation declarations}
811 * *
812 ************************************************************************
813
814 Representation of desugared vectorisation declarations that are fed to the vectoriser (via
815 'ModGuts').
816 -}
817
818 data CoreVect = Vect Id CoreExpr
819 | NoVect Id
820 | VectType Bool TyCon (Maybe TyCon)
821 | VectClass TyCon -- class tycon
822 | VectInst Id -- instance dfun (always SCALAR) !!!FIXME: should be superfluous now
823
824 {-
825 ************************************************************************
826 * *
827 Unfoldings
828 * *
829 ************************************************************************
830
831 The @Unfolding@ type is declared here to avoid numerous loops
832 -}
833
834 -- | Records the /unfolding/ of an identifier, which is approximately the form the
835 -- identifier would have if we substituted its definition in for the identifier.
836 -- This type should be treated as abstract everywhere except in "CoreUnfold"
837 data Unfolding
838 = NoUnfolding -- ^ We have no information about the unfolding
839
840 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
841 -- @OtherCon xs@ also indicates that something has been evaluated
842 -- and hence there's no point in re-evaluating it.
843 -- @OtherCon []@ is used even for non-data-type values
844 -- to indicated evaluated-ness. Notably:
845 --
846 -- > data C = C !(Int -> Int)
847 -- > case x of { C f -> ... }
848 --
849 -- Here, @f@ gets an @OtherCon []@ unfolding.
850
851 | DFunUnfolding { -- The Unfolding of a DFunId
852 -- See Note [DFun unfoldings]
853 -- df = /\a1..am. \d1..dn. MkD t1 .. tk
854 -- (op1 a1..am d1..dn)
855 -- (op2 a1..am d1..dn)
856 df_bndrs :: [Var], -- The bound variables [a1..m],[d1..dn]
857 df_con :: DataCon, -- The dictionary data constructor (never a newtype datacon)
858 df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods,
859 } -- in positional order
860
861 | CoreUnfolding { -- An unfolding for an Id with no pragma,
862 -- or perhaps a NOINLINE pragma
863 -- (For NOINLINE, the phase, if any, is in the
864 -- InlinePragInfo for this Id.)
865 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
866 uf_src :: UnfoldingSource, -- Where the unfolding came from
867 uf_is_top :: Bool, -- True <=> top level binding
868 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
869 -- a `seq` on this variable
870 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
871 -- Cached version of exprIsConLike
872 uf_is_work_free :: Bool, -- True <=> doesn't waste (much) work to expand
873 -- inside an inlining
874 -- Cached version of exprIsCheap
875 uf_expandable :: Bool, -- True <=> can expand in RULE matching
876 -- Cached version of exprIsExpandable
877 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
878 }
879 -- ^ An unfolding with redundant cached information. Parameters:
880 --
881 -- uf_tmpl: Template used to perform unfolding;
882 -- NB: Occurrence info is guaranteed correct:
883 -- see Note [OccInfo in unfoldings and rules]
884 --
885 -- uf_is_top: Is this a top level binding?
886 --
887 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
888 -- this variable
889 --
890 -- uf_is_work_free: Does this waste only a little work if we expand it inside an inlining?
891 -- Basically this is a cached version of 'exprIsWorkFree'
892 --
893 -- uf_guidance: Tells us about the /size/ of the unfolding template
894
895
896 ------------------------------------------------
897 data UnfoldingSource
898 = -- See also Note [Historical note: unfoldings for wrappers]
899
900 InlineRhs -- The current rhs of the function
901 -- Replace uf_tmpl each time around
902
903 | InlineStable -- From an INLINE or INLINABLE pragma
904 -- INLINE if guidance is UnfWhen
905 -- INLINABLE if guidance is UnfIfGoodArgs/UnfoldNever
906 -- (well, technically an INLINABLE might be made
907 -- UnfWhen if it was small enough, and then
908 -- it will behave like INLINE outside the current
909 -- module, but that is the way automatic unfoldings
910 -- work so it is consistent with the intended
911 -- meaning of INLINABLE).
912 --
913 -- uf_tmpl may change, but only as a result of
914 -- gentle simplification, it doesn't get updated
915 -- to the current RHS during compilation as with
916 -- InlineRhs.
917 --
918 -- See Note [InlineRules]
919
920 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
921 -- Only a few primop-like things have this property
922 -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
923 -- Inline absolutely always, however boring the context.
924
925
926
927 -- | 'UnfoldingGuidance' says when unfolding should take place
928 data UnfoldingGuidance
929 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
930 -- Used (a) for small *and* cheap unfoldings
931 -- (b) for INLINE functions
932 -- See Note [INLINE for small functions] in CoreUnfold
933 ug_arity :: Arity, -- Number of value arguments expected
934
935 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
936 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
937 -- So True,True means "always"
938 }
939
940 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
941 -- result of a simple analysis of the RHS
942
943 ug_args :: [Int], -- Discount if the argument is evaluated.
944 -- (i.e., a simplification will definitely
945 -- be possible). One elt of the list per *value* arg.
946
947 ug_size :: Int, -- The "size" of the unfolding.
948
949 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
950 } -- a context (case (thing args) of ...),
951 -- (where there are the right number of arguments.)
952
953 | UnfNever -- The RHS is big, so don't inline it
954 deriving (Eq)
955
956 {-
957 Note [Historical note: unfoldings for wrappers]
958 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
959 We used to have a nice clever scheme in interface files for
960 wrappers. A wrapper's unfolding can be reconstructed from its worker's
961 id and its strictness. This decreased .hi file size (sometimes
962 significantly, for modules like GHC.Classes with many high-arity w/w
963 splits) and had a slight corresponding effect on compile times.
964
965 However, when we added the second demand analysis, this scheme lead to
966 some Core lint errors. The second analysis could change the strictness
967 signatures, which sometimes resulted in a wrapper's regenerated
968 unfolding applying the wrapper to too many arguments.
969
970 Instead of repairing the clever .hi scheme, we abandoned it in favor
971 of simplicity. The .hi sizes are usually insignificant (excluding the
972 +1M for base libraries), and compile time barely increases (~+1% for
973 nofib). The nicer upshot is that the UnfoldingSource no longer mentions
974 an Id, so, eg, substitutions need not traverse them.
975
976
977 Note [DFun unfoldings]
978 ~~~~~~~~~~~~~~~~~~~~~~
979 The Arity in a DFunUnfolding is total number of args (type and value)
980 that the DFun needs to produce a dictionary. That's not necessarily
981 related to the ordinary arity of the dfun Id, esp if the class has
982 one method, so the dictionary is represented by a newtype. Example
983
984 class C a where { op :: a -> Int }
985 instance C a -> C [a] where op xs = op (head xs)
986
987 The instance translates to
988
989 $dfCList :: forall a. C a => C [a] -- Arity 2!
990 $dfCList = /\a.\d. $copList {a} d |> co
991
992 $copList :: forall a. C a => [a] -> Int -- Arity 2!
993 $copList = /\a.\d.\xs. op {a} d (head xs)
994
995 Now we might encounter (op (dfCList {ty} d) a1 a2)
996 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
997 has all its arguments, even though its (value) arity is 2. That's
998 why we record the number of expected arguments in the DFunUnfolding.
999
1000 Note that although it's an Arity, it's most convenient for it to give
1001 the *total* number of arguments, both type and value. See the use
1002 site in exprIsConApp_maybe.
1003 -}
1004
1005 -- Constants for the UnfWhen constructor
1006 needSaturated, unSaturatedOk :: Bool
1007 needSaturated = False
1008 unSaturatedOk = True
1009
1010 boringCxtNotOk, boringCxtOk :: Bool
1011 boringCxtOk = True
1012 boringCxtNotOk = False
1013
1014 ------------------------------------------------
1015 noUnfolding :: Unfolding
1016 -- ^ There is no known 'Unfolding'
1017 evaldUnfolding :: Unfolding
1018 -- ^ This unfolding marks the associated thing as being evaluated
1019
1020 noUnfolding = NoUnfolding
1021 evaldUnfolding = OtherCon []
1022
1023 mkOtherCon :: [AltCon] -> Unfolding
1024 mkOtherCon = OtherCon
1025
1026 seqUnfolding :: Unfolding -> ()
1027 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
1028 uf_is_value = b1, uf_is_work_free = b2,
1029 uf_expandable = b3, uf_is_conlike = b4,
1030 uf_guidance = g})
1031 = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
1032
1033 seqUnfolding _ = ()
1034
1035 seqGuidance :: UnfoldingGuidance -> ()
1036 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
1037 seqGuidance _ = ()
1038
1039 isStableSource :: UnfoldingSource -> Bool
1040 -- Keep the unfolding template
1041 isStableSource InlineCompulsory = True
1042 isStableSource InlineStable = True
1043 isStableSource InlineRhs = False
1044
1045 -- | Retrieves the template of an unfolding: panics if none is known
1046 unfoldingTemplate :: Unfolding -> CoreExpr
1047 unfoldingTemplate = uf_tmpl
1048
1049 -- | Retrieves the template of an unfolding if possible
1050 -- maybeUnfoldingTemplate is used mainly wnen specialising, and we do
1051 -- want to specialise DFuns, so it's important to return a template
1052 -- for DFunUnfoldings
1053 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
1054 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })
1055 = Just expr
1056 maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })
1057 = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args))
1058 maybeUnfoldingTemplate _
1059 = Nothing
1060
1061 -- | The constructors that the unfolding could never be:
1062 -- returns @[]@ if no information is available
1063 otherCons :: Unfolding -> [AltCon]
1064 otherCons (OtherCon cons) = cons
1065 otherCons _ = []
1066
1067 -- | Determines if it is certainly the case that the unfolding will
1068 -- yield a value (something in HNF): returns @False@ if unsure
1069 isValueUnfolding :: Unfolding -> Bool
1070 -- Returns False for OtherCon
1071 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
1072 isValueUnfolding _ = False
1073
1074 -- | Determines if it possibly the case that the unfolding will
1075 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
1076 -- for 'OtherCon'
1077 isEvaldUnfolding :: Unfolding -> Bool
1078 -- Returns True for OtherCon
1079 isEvaldUnfolding (OtherCon _) = True
1080 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
1081 isEvaldUnfolding _ = False
1082
1083 -- | @True@ if the unfolding is a constructor application, the application
1084 -- of a CONLIKE function or 'OtherCon'
1085 isConLikeUnfolding :: Unfolding -> Bool
1086 isConLikeUnfolding (OtherCon _) = True
1087 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
1088 isConLikeUnfolding _ = False
1089
1090 -- | Is the thing we will unfold into certainly cheap?
1091 isCheapUnfolding :: Unfolding -> Bool
1092 isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf
1093 isCheapUnfolding _ = False
1094
1095 isExpandableUnfolding :: Unfolding -> Bool
1096 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
1097 isExpandableUnfolding _ = False
1098
1099 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
1100 -- Expand an expandable unfolding; this is used in rule matching
1101 -- See Note [Expanding variables] in Rules.lhs
1102 -- The key point here is that CONLIKE things can be expanded
1103 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
1104 expandUnfolding_maybe _ = Nothing
1105
1106 hasStableCoreUnfolding_maybe :: Unfolding -> Maybe Bool
1107 -- Just True <=> has stable inlining, very keen to inline (eg. INLINE pragma)
1108 -- Just False <=> has stable inlining, open to inlining it (eg. INLINEABLE pragma)
1109 -- Nothing <=> not stable, or cannot inline it anyway
1110 hasStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
1111 | isStableSource src
1112 = case guide of
1113 UnfWhen {} -> Just True
1114 UnfIfGoodArgs {} -> Just False
1115 UnfNever -> Nothing
1116 hasStableCoreUnfolding_maybe _ = Nothing
1117
1118 isCompulsoryUnfolding :: Unfolding -> Bool
1119 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
1120 isCompulsoryUnfolding _ = False
1121
1122 isStableUnfolding :: Unfolding -> Bool
1123 -- True of unfoldings that should not be overwritten
1124 -- by a CoreUnfolding for the RHS of a let-binding
1125 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
1126 isStableUnfolding (DFunUnfolding {}) = True
1127 isStableUnfolding _ = False
1128
1129 isClosedUnfolding :: Unfolding -> Bool -- No free variables
1130 isClosedUnfolding (CoreUnfolding {}) = False
1131 isClosedUnfolding (DFunUnfolding {}) = False
1132 isClosedUnfolding _ = True
1133
1134 -- | Only returns False if there is no unfolding information available at all
1135 hasSomeUnfolding :: Unfolding -> Bool
1136 hasSomeUnfolding NoUnfolding = False
1137 hasSomeUnfolding _ = True
1138
1139 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
1140 neverUnfoldGuidance UnfNever = True
1141 neverUnfoldGuidance _ = False
1142
1143 canUnfold :: Unfolding -> Bool
1144 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
1145 canUnfold _ = False
1146
1147 {-
1148 Note [InlineRules]
1149 ~~~~~~~~~~~~~~~~~
1150 When you say
1151 {-# INLINE f #-}
1152 f x = <rhs>
1153 you intend that calls (f e) are replaced by <rhs>[e/x] So we
1154 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
1155 with it. Meanwhile, we can optimise <rhs> to our heart's content,
1156 leaving the original unfolding intact in Unfolding of 'f'. For example
1157 all xs = foldr (&&) True xs
1158 any p = all . map p {-# INLINE any #-}
1159 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
1160 which deforests well at the call site.
1161
1162 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
1163
1164 Moreover, it's only used when 'f' is applied to the
1165 specified number of arguments; that is, the number of argument on
1166 the LHS of the '=' sign in the original source definition.
1167 For example, (.) is now defined in the libraries like this
1168 {-# INLINE (.) #-}
1169 (.) f g = \x -> f (g x)
1170 so that it'll inline when applied to two arguments. If 'x' appeared
1171 on the left, thus
1172 (.) f g x = f (g x)
1173 it'd only inline when applied to three arguments. This slightly-experimental
1174 change was requested by Roman, but it seems to make sense.
1175
1176 See also Note [Inlining an InlineRule] in CoreUnfold.
1177
1178
1179 Note [OccInfo in unfoldings and rules]
1180 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1181 In unfoldings and rules, we guarantee that the template is occ-analysed,
1182 so that the occurrence info on the binders is correct. This is important,
1183 because the Simplifier does not re-analyse the template when using it. If
1184 the occurrence info is wrong
1185 - We may get more simpifier iterations than necessary, because
1186 once-occ info isn't there
1187 - More seriously, we may get an infinite loop if there's a Rec
1188 without a loop breaker marked
1189
1190
1191 ************************************************************************
1192 * *
1193 AltCon
1194 * *
1195 ************************************************************************
1196 -}
1197
1198 -- The Ord is needed for the FiniteMap used in the lookForConstructor
1199 -- in SimplEnv. If you declared that lookForConstructor *ignores*
1200 -- constructor-applications with LitArg args, then you could get
1201 -- rid of this Ord.
1202
1203 instance Outputable AltCon where
1204 ppr (DataAlt dc) = ppr dc
1205 ppr (LitAlt lit) = ppr lit
1206 ppr DEFAULT = ptext (sLit "__DEFAULT")
1207
1208 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
1209 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
1210
1211 ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool
1212 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
1213
1214 cmpAltCon :: AltCon -> AltCon -> Ordering
1215 -- ^ Compares 'AltCon's within a single list of alternatives
1216 cmpAltCon DEFAULT DEFAULT = EQ
1217 cmpAltCon DEFAULT _ = LT
1218
1219 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
1220 cmpAltCon (DataAlt _) DEFAULT = GT
1221 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
1222 cmpAltCon (LitAlt _) DEFAULT = GT
1223
1224 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
1225 ppr con1 <+> ppr con2 )
1226 LT
1227
1228 {-
1229 ************************************************************************
1230 * *
1231 \subsection{Useful synonyms}
1232 * *
1233 ************************************************************************
1234
1235 Note [CoreProgram]
1236 ~~~~~~~~~~~~~~~~~~
1237 The top level bindings of a program, a CoreProgram, are represented as
1238 a list of CoreBind
1239
1240 * Later bindings in the list can refer to earlier ones, but not vice
1241 versa. So this is OK
1242 NonRec { x = 4 }
1243 Rec { p = ...q...x...
1244 ; q = ...p...x }
1245 Rec { f = ...p..x..f.. }
1246 NonRec { g = ..f..q...x.. }
1247 But it would NOT be ok for 'f' to refer to 'g'.
1248
1249 * The occurrence analyser does strongly-connected component analysis
1250 on each Rec binding, and splits it into a sequence of smaller
1251 bindings where possible. So the program typically starts life as a
1252 single giant Rec, which is then dependency-analysed into smaller
1253 chunks.
1254 -}
1255
1256 -- If you edit this type, you may need to update the GHC formalism
1257 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
1258 type CoreProgram = [CoreBind] -- See Note [CoreProgram]
1259
1260 -- | The common case for the type of binders and variables when
1261 -- we are manipulating the Core language within GHC
1262 type CoreBndr = Var
1263 -- | Expressions where binders are 'CoreBndr's
1264 type CoreExpr = Expr CoreBndr
1265 -- | Argument expressions where binders are 'CoreBndr's
1266 type CoreArg = Arg CoreBndr
1267 -- | Binding groups where binders are 'CoreBndr's
1268 type CoreBind = Bind CoreBndr
1269 -- | Case alternatives where binders are 'CoreBndr's
1270 type CoreAlt = Alt CoreBndr
1271
1272 {-
1273 ************************************************************************
1274 * *
1275 \subsection{Tagging}
1276 * *
1277 ************************************************************************
1278 -}
1279
1280 -- | Binders are /tagged/ with a t
1281 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
1282
1283 type TaggedBind t = Bind (TaggedBndr t)
1284 type TaggedExpr t = Expr (TaggedBndr t)
1285 type TaggedArg t = Arg (TaggedBndr t)
1286 type TaggedAlt t = Alt (TaggedBndr t)
1287
1288 instance Outputable b => Outputable (TaggedBndr b) where
1289 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
1290
1291 instance Outputable b => OutputableBndr (TaggedBndr b) where
1292 pprBndr _ b = ppr b -- Simple
1293 pprInfixOcc b = ppr b
1294 pprPrefixOcc b = ppr b
1295
1296 deTagExpr :: TaggedExpr t -> CoreExpr
1297 deTagExpr (Var v) = Var v
1298 deTagExpr (Lit l) = Lit l
1299 deTagExpr (Type ty) = Type ty
1300 deTagExpr (Coercion co) = Coercion co
1301 deTagExpr (App e1 e2) = App (deTagExpr e1) (deTagExpr e2)
1302 deTagExpr (Lam (TB b _) e) = Lam b (deTagExpr e)
1303 deTagExpr (Let bind body) = Let (deTagBind bind) (deTagExpr body)
1304 deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)
1305 deTagExpr (Tick t e) = Tick t (deTagExpr e)
1306 deTagExpr (Cast e co) = Cast (deTagExpr e) co
1307
1308 deTagBind :: TaggedBind t -> CoreBind
1309 deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)
1310 deTagBind (Rec prs) = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]
1311
1312 deTagAlt :: TaggedAlt t -> CoreAlt
1313 deTagAlt (con, bndrs, rhs) = (con, [b | TB b _ <- bndrs], deTagExpr rhs)
1314
1315 {-
1316 ************************************************************************
1317 * *
1318 \subsection{Core-constructing functions with checking}
1319 * *
1320 ************************************************************************
1321 -}
1322
1323 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
1324 -- use 'MkCore.mkCoreApps' if possible
1325 mkApps :: Expr b -> [Arg b] -> Expr b
1326 -- | Apply a list of type argument expressions to a function expression in a nested fashion
1327 mkTyApps :: Expr b -> [Type] -> Expr b
1328 -- | Apply a list of coercion argument expressions to a function expression in a nested fashion
1329 mkCoApps :: Expr b -> [Coercion] -> Expr b
1330 -- | Apply a list of type or value variables to a function expression in a nested fashion
1331 mkVarApps :: Expr b -> [Var] -> Expr b
1332 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
1333 -- use 'MkCore.mkCoreConApps' if possible
1334 mkConApp :: DataCon -> [Arg b] -> Expr b
1335
1336 mkApps f args = foldl App f args
1337 mkTyApps f args = foldl (\ e a -> App e (Type a)) f args
1338 mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args
1339 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
1340 mkConApp con args = mkApps (Var (dataConWorkId con)) args
1341
1342 mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
1343 mkConApp2 con tys arg_ids = Var (dataConWorkId con)
1344 `mkApps` map Type tys
1345 `mkApps` map varToCoreExpr arg_ids
1346
1347
1348 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
1349 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1350 mkIntLit :: DynFlags -> Integer -> Expr b
1351 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
1352 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1353 mkIntLitInt :: DynFlags -> Int -> Expr b
1354
1355 mkIntLit dflags n = Lit (mkMachInt dflags n)
1356 mkIntLitInt dflags n = Lit (mkMachInt dflags (toInteger n))
1357
1358 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
1359 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1360 mkWordLit :: DynFlags -> Integer -> Expr b
1361 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
1362 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1363 mkWordLitWord :: DynFlags -> Word -> Expr b
1364
1365 mkWordLit dflags w = Lit (mkMachWord dflags w)
1366 mkWordLitWord dflags w = Lit (mkMachWord dflags (toInteger w))
1367
1368 mkWord64LitWord64 :: Word64 -> Expr b
1369 mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
1370
1371 mkInt64LitInt64 :: Int64 -> Expr b
1372 mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))
1373
1374 -- | Create a machine character literal expression of type @Char#@.
1375 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
1376 mkCharLit :: Char -> Expr b
1377 -- | Create a machine string literal expression of type @Addr#@.
1378 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
1379 mkStringLit :: String -> Expr b
1380
1381 mkCharLit c = Lit (mkMachChar c)
1382 mkStringLit s = Lit (mkMachString s)
1383
1384 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
1385 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1386 mkFloatLit :: Rational -> Expr b
1387 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
1388 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1389 mkFloatLitFloat :: Float -> Expr b
1390
1391 mkFloatLit f = Lit (mkMachFloat f)
1392 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
1393
1394 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
1395 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1396 mkDoubleLit :: Rational -> Expr b
1397 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
1398 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1399 mkDoubleLitDouble :: Double -> Expr b
1400
1401 mkDoubleLit d = Lit (mkMachDouble d)
1402 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
1403
1404 -- | Bind all supplied binding groups over an expression in a nested let expression. Assumes
1405 -- that the rhs satisfies the let/app invariant. Prefer to use 'MkCore.mkCoreLets' if
1406 -- possible, which does guarantee the invariant
1407 mkLets :: [Bind b] -> Expr b -> Expr b
1408 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
1409 -- use 'MkCore.mkCoreLams' if possible
1410 mkLams :: [b] -> Expr b -> Expr b
1411
1412 mkLams binders body = foldr Lam body binders
1413 mkLets binds body = foldr Let body binds
1414
1415
1416 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1417 -- this can only be used to bind something in a non-recursive @let@ expression
1418 mkTyBind :: TyVar -> Type -> CoreBind
1419 mkTyBind tv ty = NonRec tv (Type ty)
1420
1421 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1422 -- this can only be used to bind something in a non-recursive @let@ expression
1423 mkCoBind :: CoVar -> Coercion -> CoreBind
1424 mkCoBind cv co = NonRec cv (Coercion co)
1425
1426 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
1427 varToCoreExpr :: CoreBndr -> Expr b
1428 varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)
1429 | isCoVar v = Coercion (mkCoVarCo v)
1430 | otherwise = ASSERT( isId v ) Var v
1431
1432 varsToCoreExprs :: [CoreBndr] -> [Expr b]
1433 varsToCoreExprs vs = map varToCoreExpr vs
1434
1435 {-
1436 ************************************************************************
1437 * *
1438 \subsection{Simple access functions}
1439 * *
1440 ************************************************************************
1441 -}
1442
1443 -- | Extract every variable by this group
1444 bindersOf :: Bind b -> [b]
1445 -- If you edit this function, you may need to update the GHC formalism
1446 -- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
1447 bindersOf (NonRec binder _) = [binder]
1448 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
1449
1450 -- | 'bindersOf' applied to a list of binding groups
1451 bindersOfBinds :: [Bind b] -> [b]
1452 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
1453
1454 rhssOfBind :: Bind b -> [Expr b]
1455 rhssOfBind (NonRec _ rhs) = [rhs]
1456 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
1457
1458 rhssOfAlts :: [Alt b] -> [Expr b]
1459 rhssOfAlts alts = [e | (_,_,e) <- alts]
1460
1461 -- | Collapse all the bindings in the supplied groups into a single
1462 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
1463 flattenBinds :: [Bind b] -> [(b, Expr b)]
1464 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
1465 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
1466 flattenBinds [] = []
1467
1468 -- | We often want to strip off leading lambdas before getting down to
1469 -- business. This function is your friend.
1470 collectBinders :: Expr b -> ([b], Expr b)
1471 -- | Collect as many type bindings as possible from the front of a nested lambda
1472 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
1473 -- | Collect as many value bindings as possible from the front of a nested lambda
1474 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
1475 -- | Collect type binders from the front of the lambda first,
1476 -- then follow up by collecting as many value bindings as possible
1477 -- from the resulting stripped expression
1478 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
1479
1480 collectBinders expr
1481 = go [] expr
1482 where
1483 go bs (Lam b e) = go (b:bs) e
1484 go bs e = (reverse bs, e)
1485
1486 collectTyAndValBinders expr
1487 = (tvs, ids, body)
1488 where
1489 (tvs, body1) = collectTyBinders expr
1490 (ids, body) = collectValBinders body1
1491
1492 collectTyBinders expr
1493 = go [] expr
1494 where
1495 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
1496 go tvs e = (reverse tvs, e)
1497
1498 collectValBinders expr
1499 = go [] expr
1500 where
1501 go ids (Lam b e) | isId b = go (b:ids) e
1502 go ids body = (reverse ids, body)
1503
1504 -- | Takes a nested application expression and returns the the function
1505 -- being applied and the arguments to which it is applied
1506 collectArgs :: Expr b -> (Expr b, [Arg b])
1507 collectArgs expr
1508 = go expr []
1509 where
1510 go (App f a) as = go f (a:as)
1511 go e as = (e, as)
1512
1513 -- | Like @collectArgs@, but also collects looks through floatable
1514 -- ticks if it means that we can find more arguments.
1515 collectArgsTicks :: (Tickish Id -> Bool) -> Expr b
1516 -> (Expr b, [Arg b], [Tickish Id])
1517 collectArgsTicks skipTick expr
1518 = go expr [] []
1519 where
1520 go (App f a) as ts = go f (a:as) ts
1521 go (Tick t e) as ts
1522 | skipTick t = go e as (t:ts)
1523 go e as ts = (e, as, reverse ts)
1524
1525
1526 {-
1527 ************************************************************************
1528 * *
1529 \subsection{Predicates}
1530 * *
1531 ************************************************************************
1532
1533 At one time we optionally carried type arguments through to runtime.
1534 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1535 i.e. if type applications are actual lambdas because types are kept around
1536 at runtime. Similarly isRuntimeArg.
1537 -}
1538
1539 -- | Will this variable exist at runtime?
1540 isRuntimeVar :: Var -> Bool
1541 isRuntimeVar = isId
1542
1543 -- | Will this argument expression exist at runtime?
1544 isRuntimeArg :: CoreExpr -> Bool
1545 isRuntimeArg = isValArg
1546
1547 -- | Returns @True@ for value arguments, false for type args
1548 -- NB: coercions are value arguments (zero width, to be sure,
1549 -- like State#, but still value args).
1550 isValArg :: Expr b -> Bool
1551 isValArg e = not (isTypeArg e)
1552
1553 -- | Returns @True@ iff the expression is a 'Type' or 'Coercion'
1554 -- expression at its top level
1555 isTyCoArg :: Expr b -> Bool
1556 isTyCoArg (Type {}) = True
1557 isTyCoArg (Coercion {}) = True
1558 isTyCoArg _ = False
1559
1560 -- | Returns @True@ iff the expression is a 'Type' expression at its
1561 -- top level. Note this does NOT include 'Coercion's.
1562 isTypeArg :: Expr b -> Bool
1563 isTypeArg (Type {}) = True
1564 isTypeArg _ = False
1565
1566 -- | The number of binders that bind values rather than types
1567 valBndrCount :: [CoreBndr] -> Int
1568 valBndrCount = count isId
1569
1570 -- | The number of argument expressions that are values rather than types at their top level
1571 valArgCount :: [Arg b] -> Int
1572 valArgCount = count isValArg
1573
1574 {-
1575 ************************************************************************
1576 * *
1577 \subsection{Seq stuff}
1578 * *
1579 ************************************************************************
1580 -}
1581
1582 seqExpr :: CoreExpr -> ()
1583 seqExpr (Var v) = v `seq` ()
1584 seqExpr (Lit lit) = lit `seq` ()
1585 seqExpr (App f a) = seqExpr f `seq` seqExpr a
1586 seqExpr (Lam b e) = seqBndr b `seq` seqExpr e
1587 seqExpr (Let b e) = seqBind b `seq` seqExpr e
1588 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1589 seqExpr (Cast e co) = seqExpr e `seq` seqCo co
1590 seqExpr (Tick n e) = seqTickish n `seq` seqExpr e
1591 seqExpr (Type t) = seqType t
1592 seqExpr (Coercion co) = seqCo co
1593
1594 seqExprs :: [CoreExpr] -> ()
1595 seqExprs [] = ()
1596 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1597
1598 seqTickish :: Tickish Id -> ()
1599 seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
1600 seqTickish HpcTick{} = ()
1601 seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
1602 seqTickish SourceNote{} = ()
1603
1604 seqBndr :: CoreBndr -> ()
1605 seqBndr b = b `seq` ()
1606
1607 seqBndrs :: [CoreBndr] -> ()
1608 seqBndrs [] = ()
1609 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1610
1611 seqBind :: Bind CoreBndr -> ()
1612 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1613 seqBind (Rec prs) = seqPairs prs
1614
1615 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1616 seqPairs [] = ()
1617 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1618
1619 seqAlts :: [CoreAlt] -> ()
1620 seqAlts [] = ()
1621 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1622
1623 seqRules :: [CoreRule] -> ()
1624 seqRules [] = ()
1625 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1626 = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1627 seqRules (BuiltinRule {} : rules) = seqRules rules
1628
1629 {-
1630 ************************************************************************
1631 * *
1632 \subsection{Annotated core}
1633 * *
1634 ************************************************************************
1635 -}
1636
1637 -- | Annotated core: allows annotation at every node in the tree
1638 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1639
1640 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1641 data AnnExpr' bndr annot
1642 = AnnVar Id
1643 | AnnLit Literal
1644 | AnnLam bndr (AnnExpr bndr annot)
1645 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1646 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1647 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1648 | AnnCast (AnnExpr bndr annot) (annot, Coercion)
1649 -- Put an annotation on the (root of) the coercion
1650 | AnnTick (Tickish Id) (AnnExpr bndr annot)
1651 | AnnType Type
1652 | AnnCoercion Coercion
1653
1654 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1655 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1656
1657 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1658 data AnnBind bndr annot
1659 = AnnNonRec bndr (AnnExpr bndr annot)
1660 | AnnRec [(bndr, AnnExpr bndr annot)]
1661
1662 -- | Takes a nested application expression and returns the the function
1663 -- being applied and the arguments to which it is applied
1664 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1665 collectAnnArgs expr
1666 = go expr []
1667 where
1668 go (_, AnnApp f a) as = go f (a:as)
1669 go e as = (e, as)
1670
1671 collectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a
1672 -> (AnnExpr b a, [AnnExpr b a], [Tickish Var])
1673 collectAnnArgsTicks tickishOk expr
1674 = go expr [] []
1675 where
1676 go (_, AnnApp f a) as ts = go f (a:as) ts
1677 go (_, AnnTick t e) as ts | tickishOk t
1678 = go e as (t:ts)
1679 go e as ts = (e, as, reverse ts)
1680
1681 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1682 deAnnotate (_, e) = deAnnotate' e
1683
1684 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1685 deAnnotate' (AnnType t) = Type t
1686 deAnnotate' (AnnCoercion co) = Coercion co
1687 deAnnotate' (AnnVar v) = Var v
1688 deAnnotate' (AnnLit lit) = Lit lit
1689 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1690 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1691 deAnnotate' (AnnCast e (_,co)) = Cast (deAnnotate e) co
1692 deAnnotate' (AnnTick tick body) = Tick tick (deAnnotate body)
1693
1694 deAnnotate' (AnnLet bind body)
1695 = Let (deAnnBind bind) (deAnnotate body)
1696 where
1697 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1698 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1699
1700 deAnnotate' (AnnCase scrut v t alts)
1701 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1702
1703 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1704 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1705
1706 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1707 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1708 collectAnnBndrs e
1709 = collect [] e
1710 where
1711 collect bs (_, AnnLam b body) = collect (b:bs) body
1712 collect bs body = (reverse bs, body)