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