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