Typos in comments [ci skip]
[ghc.git] / compiler / coreSyn / CoreSyn.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
7
8 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
9 module CoreSyn (
10 -- * Main data types
11 Expr(..), Alt, Bind(..), AltCon(..), Arg,
12 Tickish(..), TickishScoping(..), TickishPlacement(..),
13 CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
14 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
15
16 -- * In/Out type synonyms
17 InId, InBind, InExpr, InAlt, InArg, InType, InKind,
18 InBndr, InVar, InCoercion, InTyVar, InCoVar,
19 OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind,
20 OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar,
21
22 -- ** 'Expr' construction
23 mkLets, mkLams,
24 mkApps, mkTyApps, mkCoApps, mkVarApps,
25
26 mkIntLit, mkIntLitInt,
27 mkWordLit, mkWordLitWord,
28 mkWord64LitWord64, mkInt64LitInt64,
29 mkCharLit, mkStringLit,
30 mkFloatLit, mkFloatLitFloat,
31 mkDoubleLit, mkDoubleLitDouble,
32
33 mkConApp, mkConApp2, mkTyBind, mkCoBind,
34 varToCoreExpr, varsToCoreExprs,
35
36 isId, cmpAltCon, cmpAlt, ltAlt,
37
38 -- ** Simple 'Expr' access functions and predicates
39 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
40 collectBinders, collectTyBinders, collectTyAndValBinders,
41 collectArgs, collectArgsTicks, flattenBinds,
42
43 exprToType, exprToCoercion_maybe,
44 applyTypeToArg,
45
46 isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
47 isRuntimeArg, isRuntimeVar,
48
49 -- * Tick-related functions
50 tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,
51 tickishCanSplit, mkNoCount, mkNoScope,
52 tickishIsCode, tickishPlace,
53 tickishContains,
54
55 -- * Unfolding data types
56 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
57
58 -- ** Constructing 'Unfolding's
59 noUnfolding, bootUnfolding, evaldUnfolding, mkOtherCon,
60 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
61
62 -- ** Predicates and deconstruction on 'Unfolding'
63 unfoldingTemplate, expandUnfolding_maybe,
64 maybeUnfoldingTemplate, otherCons,
65 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
66 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
67 isStableUnfolding, 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 substitution 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 = containsSpan sp1 sp2 && n1 == n2
813 -- compare the String last
814 tickishContains t1 t2
815 = t1 == t2
816
817 {-
818 ************************************************************************
819 * *
820 Orphans
821 * *
822 ************************************************************************
823 -}
824
825 -- | Is this instance an orphan? If it is not an orphan, contains an 'OccName'
826 -- witnessing the instance's non-orphanhood.
827 -- See Note [Orphans]
828 data IsOrphan
829 = IsOrphan
830 | NotOrphan OccName -- The OccName 'n' witnesses the instance's non-orphanhood
831 -- In that case, the instance is fingerprinted as part
832 -- of the definition of 'n's definition
833 deriving Data
834
835 -- | Returns true if 'IsOrphan' is orphan.
836 isOrphan :: IsOrphan -> Bool
837 isOrphan IsOrphan = True
838 isOrphan _ = False
839
840 -- | Returns true if 'IsOrphan' is not an orphan.
841 notOrphan :: IsOrphan -> Bool
842 notOrphan NotOrphan{} = True
843 notOrphan _ = False
844
845 chooseOrphanAnchor :: NameSet -> IsOrphan
846 -- Something (rule, instance) is relate to all the Names in this
847 -- list. Choose one of them to be an "anchor" for the orphan. We make
848 -- the choice deterministic to avoid gratuitious changes in the ABI
849 -- hash (Trac #4012). Specifically, use lexicographic comparison of
850 -- OccName rather than comparing Uniques
851 --
852 -- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically
853 --
854 chooseOrphanAnchor local_names
855 | isEmptyNameSet local_names = IsOrphan
856 | otherwise = NotOrphan (minimum occs)
857 where
858 occs = map nameOccName $ nonDetEltsUFM local_names
859 -- It's OK to use nonDetEltsUFM here, see comments above
860
861 instance Binary IsOrphan where
862 put_ bh IsOrphan = putByte bh 0
863 put_ bh (NotOrphan n) = do
864 putByte bh 1
865 put_ bh n
866 get bh = do
867 h <- getByte bh
868 case h of
869 0 -> return IsOrphan
870 _ -> do
871 n <- get bh
872 return $ NotOrphan n
873
874 {-
875 Note [Orphans]
876 ~~~~~~~~~~~~~~
877 Class instances, rules, and family instances are divided into orphans
878 and non-orphans. Roughly speaking, an instance/rule is an orphan if
879 its left hand side mentions nothing defined in this module. Orphan-hood
880 has two major consequences
881
882 * A module that contains orphans is called an "orphan module". If
883 the module being compiled depends (transitively) on an oprhan
884 module M, then M.hi is read in regardless of whether M is oherwise
885 needed. This is to ensure that we don't miss any instance decls in
886 M. But it's painful, because it means we need to keep track of all
887 the orphan modules below us.
888
889 * A non-orphan is not finger-printed separately. Instead, for
890 fingerprinting purposes it is treated as part of the entity it
891 mentions on the LHS. For example
892 data T = T1 | T2
893 instance Eq T where ....
894 The instance (Eq T) is incorprated as part of T's fingerprint.
895
896 In constrast, orphans are all fingerprinted together in the
897 mi_orph_hash field of the ModIface.
898
899 See MkIface.addFingerprints.
900
901 Orphan-hood is computed
902 * For class instances:
903 when we make a ClsInst
904 (because it is needed during instance lookup)
905
906 * For rules and family instances:
907 when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)
908 or IfaceFamInst (MkIface.instanceToIfaceInst)
909 -}
910
911 {-
912 ************************************************************************
913 * *
914 \subsection{Transformation rules}
915 * *
916 ************************************************************************
917
918 The CoreRule type and its friends are dealt with mainly in CoreRules,
919 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
920 -}
921
922 -- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules
923 type RuleBase = NameEnv [CoreRule]
924 -- The rules are unordered;
925 -- we sort out any overlaps on lookup
926
927 -- | A full rule environment which we can apply rules from. Like a 'RuleBase',
928 -- but it also includes the set of visible orphans we use to filter out orphan
929 -- rules which are not visible (even though we can see them...)
930 data RuleEnv
931 = RuleEnv { re_base :: RuleBase
932 , re_visible_orphs :: ModuleSet
933 }
934
935 mkRuleEnv :: RuleBase -> [Module] -> RuleEnv
936 mkRuleEnv rules vis_orphs = RuleEnv rules (mkModuleSet vis_orphs)
937
938 emptyRuleEnv :: RuleEnv
939 emptyRuleEnv = RuleEnv emptyNameEnv emptyModuleSet
940
941 -- | A 'CoreRule' is:
942 --
943 -- * \"Local\" if the function it is a rule for is defined in the
944 -- same module as the rule itself.
945 --
946 -- * \"Orphan\" if nothing on the LHS is defined in the same module
947 -- as the rule itself
948 data CoreRule
949 = Rule {
950 ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
951 ru_act :: Activation, -- ^ When the rule is active
952
953 -- Rough-matching stuff
954 -- see comments with InstEnv.ClsInst( is_cls, is_rough )
955 ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
956 ru_rough :: [Maybe Name], -- ^ Name at the head of each argument to the left hand side
957
958 -- Proper-matching stuff
959 -- see comments with InstEnv.ClsInst( is_tvs, is_tys )
960 ru_bndrs :: [CoreBndr], -- ^ Variables quantified over
961 ru_args :: [CoreExpr], -- ^ Left hand side arguments
962
963 -- And the right-hand side
964 ru_rhs :: CoreExpr, -- ^ Right hand side of the rule
965 -- Occurrence info is guaranteed correct
966 -- See Note [OccInfo in unfoldings and rules]
967
968 -- Locality
969 ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
970 -- (notably by Specialise or SpecConstr)
971 -- @False@ <=> generated at the users behest
972 -- See Note [Trimming auto-rules] in TidyPgm
973 -- for the sole purpose of this field.
974
975 ru_origin :: !Module, -- ^ 'Module' the rule was defined in, used
976 -- to test if we should see an orphan rule.
977
978 ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan.
979
980 ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
981 -- defined in the same module as the rule
982 -- and is not an implicit 'Id' (like a record selector,
983 -- class operation, or data constructor). This
984 -- is different from 'ru_orphan', where a rule
985 -- can avoid being an orphan if *any* Name in
986 -- LHS of the rule was defined in the same
987 -- module as the rule.
988 }
989
990 -- | Built-in rules are used for constant folding
991 -- and suchlike. They have no free variables.
992 -- A built-in rule is always visible (there is no such thing as
993 -- an orphan built-in rule.)
994 | BuiltinRule {
995 ru_name :: RuleName, -- ^ As above
996 ru_fn :: Name, -- ^ As above
997 ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
998 -- if it fires, including type arguments
999 ru_try :: RuleFun
1000 -- ^ This function does the rewrite. It given too many
1001 -- arguments, it simply discards them; the returned 'CoreExpr'
1002 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
1003 }
1004 -- See Note [Extra args in rule matching] in Rules.hs
1005
1006 type RuleFun = DynFlags -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
1007 type InScopeEnv = (InScopeSet, IdUnfoldingFun)
1008
1009 type IdUnfoldingFun = Id -> Unfolding
1010 -- A function that embodies how to unfold an Id if you need
1011 -- to do that in the Rule. The reason we need to pass this info in
1012 -- is that whether an Id is unfoldable depends on the simplifier phase
1013
1014 isBuiltinRule :: CoreRule -> Bool
1015 isBuiltinRule (BuiltinRule {}) = True
1016 isBuiltinRule _ = False
1017
1018 isAutoRule :: CoreRule -> Bool
1019 isAutoRule (BuiltinRule {}) = False
1020 isAutoRule (Rule { ru_auto = is_auto }) = is_auto
1021
1022 -- | The number of arguments the 'ru_fn' must be applied
1023 -- to before the rule can match on it
1024 ruleArity :: CoreRule -> Int
1025 ruleArity (BuiltinRule {ru_nargs = n}) = n
1026 ruleArity (Rule {ru_args = args}) = length args
1027
1028 ruleName :: CoreRule -> RuleName
1029 ruleName = ru_name
1030
1031 ruleActivation :: CoreRule -> Activation
1032 ruleActivation (BuiltinRule { }) = AlwaysActive
1033 ruleActivation (Rule { ru_act = act }) = act
1034
1035 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
1036 ruleIdName :: CoreRule -> Name
1037 ruleIdName = ru_fn
1038
1039 isLocalRule :: CoreRule -> Bool
1040 isLocalRule = ru_local
1041
1042 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
1043 setRuleIdName :: Name -> CoreRule -> CoreRule
1044 setRuleIdName nm ru = ru { ru_fn = nm }
1045
1046 {-
1047 ************************************************************************
1048 * *
1049 \subsection{Vectorisation declarations}
1050 * *
1051 ************************************************************************
1052
1053 Representation of desugared vectorisation declarations that are fed to the vectoriser (via
1054 'ModGuts').
1055 -}
1056
1057 data CoreVect = Vect Id CoreExpr
1058 | NoVect Id
1059 | VectType Bool TyCon (Maybe TyCon)
1060 | VectClass TyCon -- class tycon
1061 | VectInst Id -- instance dfun (always SCALAR) !!!FIXME: should be superfluous now
1062
1063 {-
1064 ************************************************************************
1065 * *
1066 Unfoldings
1067 * *
1068 ************************************************************************
1069
1070 The @Unfolding@ type is declared here to avoid numerous loops
1071 -}
1072
1073 -- | Records the /unfolding/ of an identifier, which is approximately the form the
1074 -- identifier would have if we substituted its definition in for the identifier.
1075 -- This type should be treated as abstract everywhere except in "CoreUnfold"
1076 data Unfolding
1077 = NoUnfolding -- ^ We have no information about the unfolding.
1078
1079 | BootUnfolding -- ^ We have no information about the unfolding, because
1080 -- this 'Id' came from an @hi-boot@ file.
1081 -- See Note [Inlining and hs-boot files] in ToIface
1082 -- for what this is used for.
1083
1084 | OtherCon [AltCon] -- ^ It ain't one of these constructors.
1085 -- @OtherCon xs@ also indicates that something has been evaluated
1086 -- and hence there's no point in re-evaluating it.
1087 -- @OtherCon []@ is used even for non-data-type values
1088 -- to indicated evaluated-ness. Notably:
1089 --
1090 -- > data C = C !(Int -> Int)
1091 -- > case x of { C f -> ... }
1092 --
1093 -- Here, @f@ gets an @OtherCon []@ unfolding.
1094
1095 | DFunUnfolding { -- The Unfolding of a DFunId
1096 -- See Note [DFun unfoldings]
1097 -- df = /\a1..am. \d1..dn. MkD t1 .. tk
1098 -- (op1 a1..am d1..dn)
1099 -- (op2 a1..am d1..dn)
1100 df_bndrs :: [Var], -- The bound variables [a1..m],[d1..dn]
1101 df_con :: DataCon, -- The dictionary data constructor (never a newtype datacon)
1102 df_args :: [CoreExpr] -- Args of the data con: types, superclasses and methods,
1103 } -- in positional order
1104
1105 | CoreUnfolding { -- An unfolding for an Id with no pragma,
1106 -- or perhaps a NOINLINE pragma
1107 -- (For NOINLINE, the phase, if any, is in the
1108 -- InlinePragInfo for this Id.)
1109 uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
1110 uf_src :: UnfoldingSource, -- Where the unfolding came from
1111 uf_is_top :: Bool, -- True <=> top level binding
1112 uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
1113 -- a `seq` on this variable
1114 uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
1115 -- Cached version of exprIsConLike
1116 uf_is_work_free :: Bool, -- True <=> doesn't waste (much) work to expand
1117 -- inside an inlining
1118 -- Cached version of exprIsCheap
1119 uf_expandable :: Bool, -- True <=> can expand in RULE matching
1120 -- Cached version of exprIsExpandable
1121 uf_guidance :: UnfoldingGuidance -- Tells about the *size* of the template.
1122 }
1123 -- ^ An unfolding with redundant cached information. Parameters:
1124 --
1125 -- uf_tmpl: Template used to perform unfolding;
1126 -- NB: Occurrence info is guaranteed correct:
1127 -- see Note [OccInfo in unfoldings and rules]
1128 --
1129 -- uf_is_top: Is this a top level binding?
1130 --
1131 -- uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
1132 -- this variable
1133 --
1134 -- uf_is_work_free: Does this waste only a little work if we expand it inside an inlining?
1135 -- Basically this is a cached version of 'exprIsWorkFree'
1136 --
1137 -- uf_guidance: Tells us about the /size/ of the unfolding template
1138
1139
1140 ------------------------------------------------
1141 data UnfoldingSource
1142 = -- See also Note [Historical note: unfoldings for wrappers]
1143
1144 InlineRhs -- The current rhs of the function
1145 -- Replace uf_tmpl each time around
1146
1147 | InlineStable -- From an INLINE or INLINABLE pragma
1148 -- INLINE if guidance is UnfWhen
1149 -- INLINABLE if guidance is UnfIfGoodArgs/UnfoldNever
1150 -- (well, technically an INLINABLE might be made
1151 -- UnfWhen if it was small enough, and then
1152 -- it will behave like INLINE outside the current
1153 -- module, but that is the way automatic unfoldings
1154 -- work so it is consistent with the intended
1155 -- meaning of INLINABLE).
1156 --
1157 -- uf_tmpl may change, but only as a result of
1158 -- gentle simplification, it doesn't get updated
1159 -- to the current RHS during compilation as with
1160 -- InlineRhs.
1161 --
1162 -- See Note [InlineStable]
1163
1164 | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
1165 -- Only a few primop-like things have this property
1166 -- (see MkId.hs, calls to mkCompulsoryUnfolding).
1167 -- Inline absolutely always, however boring the context.
1168
1169
1170
1171 -- | 'UnfoldingGuidance' says when unfolding should take place
1172 data UnfoldingGuidance
1173 = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
1174 -- Used (a) for small *and* cheap unfoldings
1175 -- (b) for INLINE functions
1176 -- See Note [INLINE for small functions] in CoreUnfold
1177 ug_arity :: Arity, -- Number of value arguments expected
1178
1179 ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
1180 ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
1181 -- So True,True means "always"
1182 }
1183
1184 | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
1185 -- result of a simple analysis of the RHS
1186
1187 ug_args :: [Int], -- Discount if the argument is evaluated.
1188 -- (i.e., a simplification will definitely
1189 -- be possible). One elt of the list per *value* arg.
1190
1191 ug_size :: Int, -- The "size" of the unfolding.
1192
1193 ug_res :: Int -- Scrutinee discount: the discount to substract if the thing is in
1194 } -- a context (case (thing args) of ...),
1195 -- (where there are the right number of arguments.)
1196
1197 | UnfNever -- The RHS is big, so don't inline it
1198 deriving (Eq)
1199
1200 {-
1201 Note [Historical note: unfoldings for wrappers]
1202 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1203 We used to have a nice clever scheme in interface files for
1204 wrappers. A wrapper's unfolding can be reconstructed from its worker's
1205 id and its strictness. This decreased .hi file size (sometimes
1206 significantly, for modules like GHC.Classes with many high-arity w/w
1207 splits) and had a slight corresponding effect on compile times.
1208
1209 However, when we added the second demand analysis, this scheme lead to
1210 some Core lint errors. The second analysis could change the strictness
1211 signatures, which sometimes resulted in a wrapper's regenerated
1212 unfolding applying the wrapper to too many arguments.
1213
1214 Instead of repairing the clever .hi scheme, we abandoned it in favor
1215 of simplicity. The .hi sizes are usually insignificant (excluding the
1216 +1M for base libraries), and compile time barely increases (~+1% for
1217 nofib). The nicer upshot is that the UnfoldingSource no longer mentions
1218 an Id, so, eg, substitutions need not traverse them.
1219
1220
1221 Note [DFun unfoldings]
1222 ~~~~~~~~~~~~~~~~~~~~~~
1223 The Arity in a DFunUnfolding is total number of args (type and value)
1224 that the DFun needs to produce a dictionary. That's not necessarily
1225 related to the ordinary arity of the dfun Id, esp if the class has
1226 one method, so the dictionary is represented by a newtype. Example
1227
1228 class C a where { op :: a -> Int }
1229 instance C a -> C [a] where op xs = op (head xs)
1230
1231 The instance translates to
1232
1233 $dfCList :: forall a. C a => C [a] -- Arity 2!
1234 $dfCList = /\a.\d. $copList {a} d |> co
1235
1236 $copList :: forall a. C a => [a] -> Int -- Arity 2!
1237 $copList = /\a.\d.\xs. op {a} d (head xs)
1238
1239 Now we might encounter (op (dfCList {ty} d) a1 a2)
1240 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
1241 has all its arguments, even though its (value) arity is 2. That's
1242 why we record the number of expected arguments in the DFunUnfolding.
1243
1244 Note that although it's an Arity, it's most convenient for it to give
1245 the *total* number of arguments, both type and value. See the use
1246 site in exprIsConApp_maybe.
1247 -}
1248
1249 -- Constants for the UnfWhen constructor
1250 needSaturated, unSaturatedOk :: Bool
1251 needSaturated = False
1252 unSaturatedOk = True
1253
1254 boringCxtNotOk, boringCxtOk :: Bool
1255 boringCxtOk = True
1256 boringCxtNotOk = False
1257
1258 ------------------------------------------------
1259 noUnfolding :: Unfolding
1260 -- ^ There is no known 'Unfolding'
1261 evaldUnfolding :: Unfolding
1262 -- ^ This unfolding marks the associated thing as being evaluated
1263
1264 noUnfolding = NoUnfolding
1265 evaldUnfolding = OtherCon []
1266
1267 -- | There is no known 'Unfolding', because this came from an
1268 -- hi-boot file.
1269 bootUnfolding :: Unfolding
1270 bootUnfolding = BootUnfolding
1271
1272 mkOtherCon :: [AltCon] -> Unfolding
1273 mkOtherCon = OtherCon
1274
1275 isStableSource :: UnfoldingSource -> Bool
1276 -- Keep the unfolding template
1277 isStableSource InlineCompulsory = True
1278 isStableSource InlineStable = True
1279 isStableSource InlineRhs = False
1280
1281 -- | Retrieves the template of an unfolding: panics if none is known
1282 unfoldingTemplate :: Unfolding -> CoreExpr
1283 unfoldingTemplate = uf_tmpl
1284
1285 -- | Retrieves the template of an unfolding if possible
1286 -- maybeUnfoldingTemplate is used mainly wnen specialising, and we do
1287 -- want to specialise DFuns, so it's important to return a template
1288 -- for DFunUnfoldings
1289 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
1290 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })
1291 = Just expr
1292 maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })
1293 = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args))
1294 maybeUnfoldingTemplate _
1295 = Nothing
1296
1297 -- | The constructors that the unfolding could never be:
1298 -- returns @[]@ if no information is available
1299 otherCons :: Unfolding -> [AltCon]
1300 otherCons (OtherCon cons) = cons
1301 otherCons _ = []
1302
1303 -- | Determines if it is certainly the case that the unfolding will
1304 -- yield a value (something in HNF): returns @False@ if unsure
1305 isValueUnfolding :: Unfolding -> Bool
1306 -- Returns False for OtherCon
1307 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
1308 isValueUnfolding _ = False
1309
1310 -- | Determines if it possibly the case that the unfolding will
1311 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
1312 -- for 'OtherCon'
1313 isEvaldUnfolding :: Unfolding -> Bool
1314 -- Returns True for OtherCon
1315 isEvaldUnfolding (OtherCon _) = True
1316 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
1317 isEvaldUnfolding _ = False
1318
1319 -- | @True@ if the unfolding is a constructor application, the application
1320 -- of a CONLIKE function or 'OtherCon'
1321 isConLikeUnfolding :: Unfolding -> Bool
1322 isConLikeUnfolding (OtherCon _) = True
1323 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
1324 isConLikeUnfolding _ = False
1325
1326 -- | Is the thing we will unfold into certainly cheap?
1327 isCheapUnfolding :: Unfolding -> Bool
1328 isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf
1329 isCheapUnfolding _ = False
1330
1331 isExpandableUnfolding :: Unfolding -> Bool
1332 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
1333 isExpandableUnfolding _ = False
1334
1335 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
1336 -- Expand an expandable unfolding; this is used in rule matching
1337 -- See Note [Expanding variables] in Rules.hs
1338 -- The key point here is that CONLIKE things can be expanded
1339 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
1340 expandUnfolding_maybe _ = Nothing
1341
1342 isCompulsoryUnfolding :: Unfolding -> Bool
1343 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
1344 isCompulsoryUnfolding _ = False
1345
1346 isStableUnfolding :: Unfolding -> Bool
1347 -- True of unfoldings that should not be overwritten
1348 -- by a CoreUnfolding for the RHS of a let-binding
1349 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
1350 isStableUnfolding (DFunUnfolding {}) = True
1351 isStableUnfolding _ = False
1352
1353 -- | Only returns False if there is no unfolding information available at all
1354 hasSomeUnfolding :: Unfolding -> Bool
1355 hasSomeUnfolding NoUnfolding = False
1356 hasSomeUnfolding BootUnfolding = False
1357 hasSomeUnfolding _ = True
1358
1359 isBootUnfolding :: Unfolding -> Bool
1360 isBootUnfolding BootUnfolding = True
1361 isBootUnfolding _ = False
1362
1363 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
1364 neverUnfoldGuidance UnfNever = True
1365 neverUnfoldGuidance _ = False
1366
1367 isFragileUnfolding :: Unfolding -> Bool
1368 -- An unfolding is fragile if it mentions free variables or
1369 -- is otherwise subject to change. A robust one can be kept.
1370 -- See Note [Fragile unfoldings]
1371 isFragileUnfolding (CoreUnfolding {}) = True
1372 isFragileUnfolding (DFunUnfolding {}) = True
1373 isFragileUnfolding _ = False
1374 -- NoUnfolding, BootUnfolding, OtherCon are all non-fragile
1375
1376 canUnfold :: Unfolding -> Bool
1377 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
1378 canUnfold _ = False
1379
1380 {- Note [Fragile unfoldings]
1381 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1382 An unfolding is "fragile" if it mentions free variables (and hence would
1383 need substitution) or might be affected by optimisation. The non-fragile
1384 ones are
1385
1386 NoUnfolding, BootUnfolding
1387
1388 OtherCon {} If we know this binder (say a lambda binder) will be
1389 bound to an evaluated thing, we want to retain that
1390 info in simpleOptExpr; see Trac #13077.
1391
1392 We consider even a StableUnfolding as fragile, because it needs substitution.
1393
1394 Note [InlineStable]
1395 ~~~~~~~~~~~~~~~~~
1396 When you say
1397 {-# INLINE f #-}
1398 f x = <rhs>
1399 you intend that calls (f e) are replaced by <rhs>[e/x] So we
1400 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
1401 with it. Meanwhile, we can optimise <rhs> to our heart's content,
1402 leaving the original unfolding intact in Unfolding of 'f'. For example
1403 all xs = foldr (&&) True xs
1404 any p = all . map p {-# INLINE any #-}
1405 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
1406 which deforests well at the call site.
1407
1408 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
1409
1410 Moreover, it's only used when 'f' is applied to the
1411 specified number of arguments; that is, the number of argument on
1412 the LHS of the '=' sign in the original source definition.
1413 For example, (.) is now defined in the libraries like this
1414 {-# INLINE (.) #-}
1415 (.) f g = \x -> f (g x)
1416 so that it'll inline when applied to two arguments. If 'x' appeared
1417 on the left, thus
1418 (.) f g x = f (g x)
1419 it'd only inline when applied to three arguments. This slightly-experimental
1420 change was requested by Roman, but it seems to make sense.
1421
1422 See also Note [Inlining an InlineRule] in CoreUnfold.
1423
1424
1425 Note [OccInfo in unfoldings and rules]
1426 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1427 In unfoldings and rules, we guarantee that the template is occ-analysed,
1428 so that the occurrence info on the binders is correct. This is important,
1429 because the Simplifier does not re-analyse the template when using it. If
1430 the occurrence info is wrong
1431 - We may get more simpifier iterations than necessary, because
1432 once-occ info isn't there
1433 - More seriously, we may get an infinite loop if there's a Rec
1434 without a loop breaker marked
1435
1436
1437 ************************************************************************
1438 * *
1439 AltCon
1440 * *
1441 ************************************************************************
1442 -}
1443
1444 -- The Ord is needed for the FiniteMap used in the lookForConstructor
1445 -- in SimplEnv. If you declared that lookForConstructor *ignores*
1446 -- constructor-applications with LitArg args, then you could get
1447 -- rid of this Ord.
1448
1449 instance Outputable AltCon where
1450 ppr (DataAlt dc) = ppr dc
1451 ppr (LitAlt lit) = ppr lit
1452 ppr DEFAULT = text "__DEFAULT"
1453
1454 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
1455 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
1456
1457 ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool
1458 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
1459
1460 cmpAltCon :: AltCon -> AltCon -> Ordering
1461 -- ^ Compares 'AltCon's within a single list of alternatives
1462 cmpAltCon DEFAULT DEFAULT = EQ
1463 cmpAltCon DEFAULT _ = LT
1464
1465 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
1466 cmpAltCon (DataAlt _) DEFAULT = GT
1467 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
1468 cmpAltCon (LitAlt _) DEFAULT = GT
1469
1470 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
1471 ppr con1 <+> ppr con2 )
1472 LT
1473
1474 {-
1475 ************************************************************************
1476 * *
1477 \subsection{Useful synonyms}
1478 * *
1479 ************************************************************************
1480
1481 Note [CoreProgram]
1482 ~~~~~~~~~~~~~~~~~~
1483 The top level bindings of a program, a CoreProgram, are represented as
1484 a list of CoreBind
1485
1486 * Later bindings in the list can refer to earlier ones, but not vice
1487 versa. So this is OK
1488 NonRec { x = 4 }
1489 Rec { p = ...q...x...
1490 ; q = ...p...x }
1491 Rec { f = ...p..x..f.. }
1492 NonRec { g = ..f..q...x.. }
1493 But it would NOT be ok for 'f' to refer to 'g'.
1494
1495 * The occurrence analyser does strongly-connected component analysis
1496 on each Rec binding, and splits it into a sequence of smaller
1497 bindings where possible. So the program typically starts life as a
1498 single giant Rec, which is then dependency-analysed into smaller
1499 chunks.
1500 -}
1501
1502 -- If you edit this type, you may need to update the GHC formalism
1503 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
1504 type CoreProgram = [CoreBind] -- See Note [CoreProgram]
1505
1506 -- | The common case for the type of binders and variables when
1507 -- we are manipulating the Core language within GHC
1508 type CoreBndr = Var
1509 -- | Expressions where binders are 'CoreBndr's
1510 type CoreExpr = Expr CoreBndr
1511 -- | Argument expressions where binders are 'CoreBndr's
1512 type CoreArg = Arg CoreBndr
1513 -- | Binding groups where binders are 'CoreBndr's
1514 type CoreBind = Bind CoreBndr
1515 -- | Case alternatives where binders are 'CoreBndr's
1516 type CoreAlt = Alt CoreBndr
1517
1518 {-
1519 ************************************************************************
1520 * *
1521 \subsection{Tagging}
1522 * *
1523 ************************************************************************
1524 -}
1525
1526 -- | Binders are /tagged/ with a t
1527 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
1528
1529 type TaggedBind t = Bind (TaggedBndr t)
1530 type TaggedExpr t = Expr (TaggedBndr t)
1531 type TaggedArg t = Arg (TaggedBndr t)
1532 type TaggedAlt t = Alt (TaggedBndr t)
1533
1534 instance Outputable b => Outputable (TaggedBndr b) where
1535 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
1536
1537 instance Outputable b => OutputableBndr (TaggedBndr b) where
1538 pprBndr _ b = ppr b -- Simple
1539 pprInfixOcc b = ppr b
1540 pprPrefixOcc b = ppr b
1541
1542 deTagExpr :: TaggedExpr t -> CoreExpr
1543 deTagExpr (Var v) = Var v
1544 deTagExpr (Lit l) = Lit l
1545 deTagExpr (Type ty) = Type ty
1546 deTagExpr (Coercion co) = Coercion co
1547 deTagExpr (App e1 e2) = App (deTagExpr e1) (deTagExpr e2)
1548 deTagExpr (Lam (TB b _) e) = Lam b (deTagExpr e)
1549 deTagExpr (Let bind body) = Let (deTagBind bind) (deTagExpr body)
1550 deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)
1551 deTagExpr (Tick t e) = Tick t (deTagExpr e)
1552 deTagExpr (Cast e co) = Cast (deTagExpr e) co
1553
1554 deTagBind :: TaggedBind t -> CoreBind
1555 deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)
1556 deTagBind (Rec prs) = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]
1557
1558 deTagAlt :: TaggedAlt t -> CoreAlt
1559 deTagAlt (con, bndrs, rhs) = (con, [b | TB b _ <- bndrs], deTagExpr rhs)
1560
1561 {-
1562 ************************************************************************
1563 * *
1564 \subsection{Core-constructing functions with checking}
1565 * *
1566 ************************************************************************
1567 -}
1568
1569 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
1570 -- use 'MkCore.mkCoreApps' if possible
1571 mkApps :: Expr b -> [Arg b] -> Expr b
1572 -- | Apply a list of type argument expressions to a function expression in a nested fashion
1573 mkTyApps :: Expr b -> [Type] -> Expr b
1574 -- | Apply a list of coercion argument expressions to a function expression in a nested fashion
1575 mkCoApps :: Expr b -> [Coercion] -> Expr b
1576 -- | Apply a list of type or value variables to a function expression in a nested fashion
1577 mkVarApps :: Expr b -> [Var] -> Expr b
1578 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
1579 -- use 'MkCore.mkCoreConApps' if possible
1580 mkConApp :: DataCon -> [Arg b] -> Expr b
1581
1582 mkApps f args = foldl App f args
1583 mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args
1584 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
1585 mkConApp con args = mkApps (Var (dataConWorkId con)) args
1586
1587 mkTyApps f args = foldl (\ e a -> App e (typeOrCoercion a)) f args
1588 where
1589 typeOrCoercion ty
1590 | Just co <- isCoercionTy_maybe ty = Coercion co
1591 | otherwise = Type ty
1592
1593 mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
1594 mkConApp2 con tys arg_ids = Var (dataConWorkId con)
1595 `mkApps` map Type tys
1596 `mkApps` map varToCoreExpr arg_ids
1597
1598
1599 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
1600 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1601 mkIntLit :: DynFlags -> Integer -> Expr b
1602 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
1603 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1604 mkIntLitInt :: DynFlags -> Int -> Expr b
1605
1606 mkIntLit dflags n = Lit (mkMachInt dflags n)
1607 mkIntLitInt dflags n = Lit (mkMachInt dflags (toInteger n))
1608
1609 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
1610 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1611 mkWordLit :: DynFlags -> Integer -> Expr b
1612 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
1613 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1614 mkWordLitWord :: DynFlags -> Word -> Expr b
1615
1616 mkWordLit dflags w = Lit (mkMachWord dflags w)
1617 mkWordLitWord dflags w = Lit (mkMachWord dflags (toInteger w))
1618
1619 mkWord64LitWord64 :: Word64 -> Expr b
1620 mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
1621
1622 mkInt64LitInt64 :: Int64 -> Expr b
1623 mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))
1624
1625 -- | Create a machine character literal expression of type @Char#@.
1626 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
1627 mkCharLit :: Char -> Expr b
1628 -- | Create a machine string literal expression of type @Addr#@.
1629 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
1630 mkStringLit :: String -> Expr b
1631
1632 mkCharLit c = Lit (mkMachChar c)
1633 mkStringLit s = Lit (mkMachString s)
1634
1635 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
1636 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1637 mkFloatLit :: Rational -> Expr b
1638 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
1639 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1640 mkFloatLitFloat :: Float -> Expr b
1641
1642 mkFloatLit f = Lit (mkMachFloat f)
1643 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
1644
1645 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
1646 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1647 mkDoubleLit :: Rational -> Expr b
1648 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
1649 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1650 mkDoubleLitDouble :: Double -> Expr b
1651
1652 mkDoubleLit d = Lit (mkMachDouble d)
1653 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
1654
1655 -- | Bind all supplied binding groups over an expression in a nested let expression. Assumes
1656 -- that the rhs satisfies the let/app invariant. Prefer to use 'MkCore.mkCoreLets' if
1657 -- possible, which does guarantee the invariant
1658 mkLets :: [Bind b] -> Expr b -> Expr b
1659 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
1660 -- use 'MkCore.mkCoreLams' if possible
1661 mkLams :: [b] -> Expr b -> Expr b
1662
1663 mkLams binders body = foldr Lam body binders
1664 mkLets binds body = foldr Let body binds
1665
1666
1667 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1668 -- this can only be used to bind something in a non-recursive @let@ expression
1669 mkTyBind :: TyVar -> Type -> CoreBind
1670 mkTyBind tv ty = NonRec tv (Type ty)
1671
1672 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1673 -- this can only be used to bind something in a non-recursive @let@ expression
1674 mkCoBind :: CoVar -> Coercion -> CoreBind
1675 mkCoBind cv co = NonRec cv (Coercion co)
1676
1677 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
1678 varToCoreExpr :: CoreBndr -> Expr b
1679 varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)
1680 | isCoVar v = Coercion (mkCoVarCo v)
1681 | otherwise = ASSERT( isId v ) Var v
1682
1683 varsToCoreExprs :: [CoreBndr] -> [Expr b]
1684 varsToCoreExprs vs = map varToCoreExpr vs
1685
1686 {-
1687 ************************************************************************
1688 * *
1689 Getting a result type
1690 * *
1691 ************************************************************************
1692
1693 These are defined here to avoid a module loop between CoreUtils and CoreFVs
1694
1695 -}
1696
1697 applyTypeToArg :: Type -> CoreExpr -> Type
1698 -- ^ Determines the type resulting from applying an expression with given type
1699 -- to a given argument expression
1700 applyTypeToArg fun_ty arg = piResultTy fun_ty (exprToType arg)
1701
1702 -- | If the expression is a 'Type', converts. Otherwise,
1703 -- panics. NB: This does /not/ convert 'Coercion' to 'CoercionTy'.
1704 exprToType :: CoreExpr -> Type
1705 exprToType (Type ty) = ty
1706 exprToType _bad = pprPanic "exprToType" empty
1707
1708 -- | If the expression is a 'Coercion', converts.
1709 exprToCoercion_maybe :: CoreExpr -> Maybe Coercion
1710 exprToCoercion_maybe (Coercion co) = Just co
1711 exprToCoercion_maybe _ = Nothing
1712
1713 {-
1714 ************************************************************************
1715 * *
1716 \subsection{Simple access functions}
1717 * *
1718 ************************************************************************
1719 -}
1720
1721 -- | Extract every variable by this group
1722 bindersOf :: Bind b -> [b]
1723 -- If you edit this function, you may need to update the GHC formalism
1724 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
1725 bindersOf (NonRec binder _) = [binder]
1726 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
1727
1728 -- | 'bindersOf' applied to a list of binding groups
1729 bindersOfBinds :: [Bind b] -> [b]
1730 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
1731
1732 rhssOfBind :: Bind b -> [Expr b]
1733 rhssOfBind (NonRec _ rhs) = [rhs]
1734 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
1735
1736 rhssOfAlts :: [Alt b] -> [Expr b]
1737 rhssOfAlts alts = [e | (_,_,e) <- alts]
1738
1739 -- | Collapse all the bindings in the supplied groups into a single
1740 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
1741 flattenBinds :: [Bind b] -> [(b, Expr b)]
1742 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
1743 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
1744 flattenBinds [] = []
1745
1746 -- | We often want to strip off leading lambdas before getting down to
1747 -- business. Variants are 'collectTyBinders', 'collectValBinders',
1748 -- and 'collectTyAndValBinders'
1749 collectBinders :: Expr b -> ([b], Expr b)
1750 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
1751 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
1752 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
1753
1754 collectBinders expr
1755 = go [] expr
1756 where
1757 go bs (Lam b e) = go (b:bs) e
1758 go bs e = (reverse bs, e)
1759
1760 collectTyBinders expr
1761 = go [] expr
1762 where
1763 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
1764 go tvs e = (reverse tvs, e)
1765
1766 collectValBinders expr
1767 = go [] expr
1768 where
1769 go ids (Lam b e) | isId b = go (b:ids) e
1770 go ids body = (reverse ids, body)
1771
1772 collectTyAndValBinders expr
1773 = (tvs, ids, body)
1774 where
1775 (tvs, body1) = collectTyBinders expr
1776 (ids, body) = collectValBinders body1
1777
1778 -- | Takes a nested application expression and returns the the function
1779 -- being applied and the arguments to which it is applied
1780 collectArgs :: Expr b -> (Expr b, [Arg b])
1781 collectArgs expr
1782 = go expr []
1783 where
1784 go (App f a) as = go f (a:as)
1785 go e as = (e, as)
1786
1787 -- | Like @collectArgs@, but also collects looks through floatable
1788 -- ticks if it means that we can find more arguments.
1789 collectArgsTicks :: (Tickish Id -> Bool) -> Expr b
1790 -> (Expr b, [Arg b], [Tickish Id])
1791 collectArgsTicks skipTick expr
1792 = go expr [] []
1793 where
1794 go (App f a) as ts = go f (a:as) ts
1795 go (Tick t e) as ts
1796 | skipTick t = go e as (t:ts)
1797 go e as ts = (e, as, reverse ts)
1798
1799
1800 {-
1801 ************************************************************************
1802 * *
1803 \subsection{Predicates}
1804 * *
1805 ************************************************************************
1806
1807 At one time we optionally carried type arguments through to runtime.
1808 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1809 i.e. if type applications are actual lambdas because types are kept around
1810 at runtime. Similarly isRuntimeArg.
1811 -}
1812
1813 -- | Will this variable exist at runtime?
1814 isRuntimeVar :: Var -> Bool
1815 isRuntimeVar = isId
1816
1817 -- | Will this argument expression exist at runtime?
1818 isRuntimeArg :: CoreExpr -> Bool
1819 isRuntimeArg = isValArg
1820
1821 -- | Returns @True@ for value arguments, false for type args
1822 -- NB: coercions are value arguments (zero width, to be sure,
1823 -- like State#, but still value args).
1824 isValArg :: Expr b -> Bool
1825 isValArg e = not (isTypeArg e)
1826
1827 -- | Returns @True@ iff the expression is a 'Type' or 'Coercion'
1828 -- expression at its top level
1829 isTyCoArg :: Expr b -> Bool
1830 isTyCoArg (Type {}) = True
1831 isTyCoArg (Coercion {}) = True
1832 isTyCoArg _ = False
1833
1834 -- | Returns @True@ iff the expression is a 'Type' expression at its
1835 -- top level. Note this does NOT include 'Coercion's.
1836 isTypeArg :: Expr b -> Bool
1837 isTypeArg (Type {}) = True
1838 isTypeArg _ = False
1839
1840 -- | The number of binders that bind values rather than types
1841 valBndrCount :: [CoreBndr] -> Int
1842 valBndrCount = count isId
1843
1844 -- | The number of argument expressions that are values rather than types at their top level
1845 valArgCount :: [Arg b] -> Int
1846 valArgCount = count isValArg
1847
1848 {-
1849 ************************************************************************
1850 * *
1851 \subsection{Annotated core}
1852 * *
1853 ************************************************************************
1854 -}
1855
1856 -- | Annotated core: allows annotation at every node in the tree
1857 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1858
1859 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1860 data AnnExpr' bndr annot
1861 = AnnVar Id
1862 | AnnLit Literal
1863 | AnnLam bndr (AnnExpr bndr annot)
1864 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1865 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1866 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1867 | AnnCast (AnnExpr bndr annot) (annot, Coercion)
1868 -- Put an annotation on the (root of) the coercion
1869 | AnnTick (Tickish Id) (AnnExpr bndr annot)
1870 | AnnType Type
1871 | AnnCoercion Coercion
1872
1873 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1874 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1875
1876 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1877 data AnnBind bndr annot
1878 = AnnNonRec bndr (AnnExpr bndr annot)
1879 | AnnRec [(bndr, AnnExpr bndr annot)]
1880
1881 -- | Takes a nested application expression and returns the the function
1882 -- being applied and the arguments to which it is applied
1883 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1884 collectAnnArgs expr
1885 = go expr []
1886 where
1887 go (_, AnnApp f a) as = go f (a:as)
1888 go e as = (e, as)
1889
1890 collectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a
1891 -> (AnnExpr b a, [AnnExpr b a], [Tickish Var])
1892 collectAnnArgsTicks tickishOk expr
1893 = go expr [] []
1894 where
1895 go (_, AnnApp f a) as ts = go f (a:as) ts
1896 go (_, AnnTick t e) as ts | tickishOk t
1897 = go e as (t:ts)
1898 go e as ts = (e, as, reverse ts)
1899
1900 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1901 deAnnotate (_, e) = deAnnotate' e
1902
1903 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1904 deAnnotate' (AnnType t) = Type t
1905 deAnnotate' (AnnCoercion co) = Coercion co
1906 deAnnotate' (AnnVar v) = Var v
1907 deAnnotate' (AnnLit lit) = Lit lit
1908 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1909 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1910 deAnnotate' (AnnCast e (_,co)) = Cast (deAnnotate e) co
1911 deAnnotate' (AnnTick tick body) = Tick tick (deAnnotate body)
1912
1913 deAnnotate' (AnnLet bind body)
1914 = Let (deAnnBind bind) (deAnnotate body)
1915 where
1916 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1917 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1918
1919 deAnnotate' (AnnCase scrut v t alts)
1920 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1921
1922 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1923 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1924
1925 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1926 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1927 collectAnnBndrs e
1928 = collect [] e
1929 where
1930 collect bs (_, AnnLam b body) = collect (b:bs) body
1931 collect bs body = (reverse bs, body)