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