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