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