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