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