Allow top-level string literals in Core (#8472)
[ghc.git] / compiler / coreSyn / CoreSyn.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
7
8 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
9 module CoreSyn (
10 -- * Main data types
11 Expr(..), Alt, Bind(..), AltCon(..), Arg,
12 Tickish(..), TickishScoping(..), TickishPlacement(..),
13 CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
14 TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
15
16 -- * In/Out type synonyms
17 InId, InBind, InExpr, InAlt, InArg, InType, InKind,
18 InBndr, InVar, InCoercion, InTyVar, InCoVar,
19 OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind,
20 OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar,
21
22 -- ** 'Expr' construction
23 mkLets, mkLams,
24 mkApps, mkTyApps, mkCoApps, mkVarApps,
25
26 mkIntLit, mkIntLitInt,
27 mkWordLit, mkWordLitWord,
28 mkWord64LitWord64, mkInt64LitInt64,
29 mkCharLit, mkStringLit,
30 mkFloatLit, mkFloatLitFloat,
31 mkDoubleLit, mkDoubleLitDouble,
32
33 mkConApp, mkConApp2, mkTyBind, mkCoBind,
34 varToCoreExpr, varsToCoreExprs,
35
36 isId, cmpAltCon, cmpAlt, ltAlt,
37
38 -- ** Simple 'Expr' access functions and predicates
39 bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
40 collectBinders, collectTyBinders, collectTyAndValBinders,
41 collectArgs, collectArgsTicks, flattenBinds,
42
43 exprToType, exprToCoercion_maybe,
44 applyTypeToArg,
45
46 isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
47 isRuntimeArg, isRuntimeVar,
48
49 -- * Tick-related functions
50 tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,
51 tickishCanSplit, mkNoCount, mkNoScope,
52 tickishIsCode, tickishPlace,
53 tickishContains,
54
55 -- * Unfolding data types
56 Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
57
58 -- ** Constructing 'Unfolding's
59 noUnfolding, bootUnfolding, evaldUnfolding, mkOtherCon,
60 unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
61
62 -- ** Predicates and deconstruction on 'Unfolding'
63 unfoldingTemplate, expandUnfolding_maybe,
64 maybeUnfoldingTemplate, otherCons,
65 isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
66 isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
67 isStableUnfolding,
68 isClosedUnfolding, hasSomeUnfolding,
69 isBootUnfolding,
70 canUnfold, neverUnfoldGuidance, isStableSource,
71
72 -- * Annotated expression data types
73 AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
74
75 -- ** Operations on annotated expressions
76 collectAnnArgs, collectAnnArgsTicks,
77
78 -- ** Operations on annotations
79 deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
80
81 -- * Orphanhood
82 IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor,
83
84 -- * Core rule data types
85 CoreRule(..), RuleBase,
86 RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
87 RuleEnv(..), mkRuleEnv, emptyRuleEnv,
88
89 -- ** Operations on 'CoreRule's
90 ruleArity, ruleName, ruleIdName, ruleActivation,
91 setRuleIdName,
92 isBuiltinRule, isLocalRule, isAutoRule,
93
94 -- * Core vectorisation declarations data type
95 CoreVect(..)
96 ) where
97
98 #include "HsVersions.h"
99
100 import CostCentre
101 import VarEnv( InScopeSet )
102 import Var
103 import Type
104 import Coercion
105 import Name
106 import NameSet
107 import NameEnv( NameEnv, emptyNameEnv )
108 import Literal
109 import DataCon
110 import Module
111 import TyCon
112 import BasicTypes
113 import DynFlags
114 import Outputable
115 import Util
116 import UniqFM
117 import SrcLoc ( RealSrcSpan, containsSpan )
118 import Binary
119
120 import Data.Data hiding (TyCon)
121 import Data.Int
122 import Data.Word
123
124 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
125 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
126
127 {-
128 ************************************************************************
129 * *
130 \subsection{The main data types}
131 * *
132 ************************************************************************
133
134 These data types are the heart of the compiler
135 -}
136
137 -- | This is the data type that represents GHCs core intermediate language. Currently
138 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
139 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
140 --
141 -- We get from Haskell source to this Core language in a number of stages:
142 --
143 -- 1. The source code is parsed into an abstract syntax tree, which is represented
144 -- by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
145 --
146 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
147 -- (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
148 -- For example, this program:
149 --
150 -- @
151 -- f x = let f x = x + 1
152 -- in f (x - 2)
153 -- @
154 --
155 -- Would be renamed by having 'Unique's attached so it looked something like this:
156 --
157 -- @
158 -- f_1 x_2 = let f_3 x_4 = x_4 + 1
159 -- in f_3 (x_2 - 2)
160 -- @
161 -- But see Note [Shadowing] below.
162 --
163 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
164 -- type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
165 --
166 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
167 -- this 'Expr' type, which has far fewer constructors and hence is easier to perform
168 -- optimization, analysis and code generation on.
169 --
170 -- The type parameter @b@ is for the type of binders in the expression tree.
171 --
172 -- The language consists of the following elements:
173 --
174 -- * Variables
175 --
176 -- * Primitive literals
177 --
178 -- * Applications: note that the argument may be a 'Type'.
179 -- See Note [CoreSyn let/app invariant]
180 -- See Note [Levity polymorphism invariants]
181 --
182 -- * Lambda abstraction
183 -- See Note [Levity polymorphism invariants]
184 --
185 -- * Recursive and non recursive @let@s. Operationally
186 -- this corresponds to allocating a thunk for the things
187 -- bound and then executing the sub-expression.
188 --
189 -- #top_level_invariant#
190 -- #letrec_invariant#
191 --
192 -- The right hand sides of all top-level and recursive @let@s
193 -- /must/ be of lifted type (see "Type#type_classification" for
194 -- the meaning of /lifted/ vs. /unlifted/). There is one exception
195 -- to this rule, top-level @let@s are allowed to bind primitive
196 -- string literals, see Note [CoreSyn top-level string literals].
197 --
198 -- See Note [CoreSyn let/app invariant]
199 -- See Note [Levity polymorphism invariants]
200 --
201 -- #type_let#
202 -- We allow a /non-recursive/ let to bind a type variable, thus:
203 --
204 -- > Let (NonRec tv (Type ty)) body
205 --
206 -- This can be very convenient for postponing type substitutions until
207 -- the next run of the simplifier.
208 --
209 -- At the moment, the rest of the compiler only deals with type-let
210 -- in a Let expression, rather than at top level. We may want to revist
211 -- this choice.
212 --
213 -- * Case expression. Operationally this corresponds to evaluating
214 -- the scrutinee (expression examined) to weak head normal form
215 -- and then examining at most one level of resulting constructor (i.e. you
216 -- cannot do nested pattern matching directly with this).
217 --
218 -- The binder gets bound to the value of the scrutinee,
219 -- and the 'Type' must be that of all the case alternatives
220 --
221 -- #case_invariants#
222 -- This is one of the more complicated elements of the Core language,
223 -- and comes with a number of restrictions:
224 --
225 -- 1. The list of alternatives may be empty;
226 -- See Note [Empty case alternatives]
227 --
228 -- 2. The 'DEFAULT' case alternative must be first in the list,
229 -- if it occurs at all.
230 --
231 -- 3. The remaining cases are in order of increasing
232 -- tag (for 'DataAlts') or
233 -- lit (for 'LitAlts').
234 -- This makes finding the relevant constructor easy,
235 -- and makes comparison easier too.
236 --
237 -- 4. The list of alternatives must be exhaustive. An /exhaustive/ case
238 -- does not necessarily mention all constructors:
239 --
240 -- @
241 -- data Foo = Red | Green | Blue
242 -- ... case x of
243 -- Red -> True
244 -- other -> f (case x of
245 -- Green -> ...
246 -- Blue -> ... ) ...
247 -- @
248 --
249 -- The inner case does not need a @Red@ alternative, because @x@
250 -- can't be @Red@ at that program point.
251 --
252 -- 5. Floating-point values must not be scrutinised against literals.
253 -- See Trac #9238 and Note [Rules for floating-point comparisons]
254 -- in PrelRules for rationale.
255 --
256 -- * Cast an expression to a particular type.
257 -- This is used to implement @newtype@s (a @newtype@ constructor or
258 -- destructor just becomes a 'Cast' in Core) and GADTs.
259 --
260 -- * Notes. These allow general information to be added to expressions
261 -- in the syntax tree
262 --
263 -- * A type: this should only show up at the top level of an Arg
264 --
265 -- * A coercion
266
267 -- If you edit this type, you may need to update the GHC formalism
268 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
269 data Expr b
270 = Var Id
271 | Lit Literal
272 | App (Expr b) (Arg b)
273 | Lam b (Expr b)
274 | Let (Bind b) (Expr b)
275 | Case (Expr b) b Type [Alt b] -- See #case_invariant#
276 | Cast (Expr b) Coercion
277 | Tick (Tickish Id) (Expr b)
278 | Type Type
279 | Coercion Coercion
280 deriving Data
281
282 -- | Type synonym for expressions that occur in function argument positions.
283 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
284 type Arg b = Expr b
285
286 -- | A case split alternative. Consists of the constructor leading to the alternative,
287 -- the variables bound from the constructor, and the expression to be executed given that binding.
288 -- The default alternative is @(DEFAULT, [], rhs)@
289
290 -- If you edit this type, you may need to update the GHC formalism
291 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
292 type Alt b = (AltCon, [b], Expr b)
293
294 -- | A case alternative constructor (i.e. pattern match)
295
296 -- If you edit this type, you may need to update the GHC formalism
297 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
298 data AltCon
299 = DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
300 -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
301
302 | LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
303 -- Invariant: always an *unlifted* literal
304 -- See Note [Literal alternatives]
305
306 | DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
307 deriving (Eq, Data)
308
309 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
310
311 -- If you edit this type, you may need to update the GHC formalism
312 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
313 data Bind b = NonRec b (Expr b)
314 | Rec [(b, (Expr b))]
315 deriving Data
316
317 {-
318 Note [Shadowing]
319 ~~~~~~~~~~~~~~~~
320 While various passes attempt to rename on-the-fly in a manner that
321 avoids "shadowing" (thereby simplifying downstream optimizations),
322 neither the simplifier nor any other pass GUARANTEES that shadowing is
323 avoided. Thus, all passes SHOULD work fine even in the presence of
324 arbitrary shadowing in their inputs.
325
326 In particular, scrutinee variables `x` in expressions of the form
327 `Case e x t` are often renamed to variables with a prefix
328 "wild_". These "wild" variables may appear in the body of the
329 case-expression, and further, may be shadowed within the body.
330
331 So the Unique in an Var is not really unique at all. Still, it's very
332 useful to give a constant-time equality/ordering for Vars, and to give
333 a key that can be used to make sets of Vars (VarSet), or mappings from
334 Vars to other things (VarEnv). Moreover, if you do want to eliminate
335 shadowing, you can give a new Unique to an Id without changing its
336 printable name, which makes debugging easier.
337
338 Note [Literal alternatives]
339 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
340 Literal alternatives (LitAlt lit) are always for *un-lifted* literals.
341 We have one literal, a literal Integer, that is lifted, and we don't
342 allow in a LitAlt, because LitAlt cases don't do any evaluation. Also
343 (see Trac #5603) if you say
344 case 3 of
345 S# x -> ...
346 J# _ _ -> ...
347 (where S#, J# are the constructors for Integer) we don't want the
348 simplifier calling findAlt with argument (LitAlt 3). No no. Integer
349 literals are an opaque encoding of an algebraic data type, not of
350 an unlifted literal, like all the others.
351
352 Also, we do not permit case analysis with literal patterns on floating-point
353 types. See Trac #9238 and Note [Rules for floating-point comparisons] in
354 PrelRules for the rationale for this restriction.
355
356 -------------------------- CoreSyn INVARIANTS ---------------------------
357
358 Note [CoreSyn top-level invariant]
359 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
360 See #toplevel_invariant#
361
362 Note [CoreSyn letrec invariant]
363 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
364 See #letrec_invariant#
365
366 Note [CoreSyn top-level string literals]
367 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
368 As an exception to the usual rule that top-level binders must be lifted,
369 we allow binding primitive string literals (of type Addr#) of type Addr# at the
370 top level. This allows us to share string literals earlier in the pipeline and
371 crucially allows other optimizations in the Core2Core pipeline to fire.
372 Consider,
373
374 f n = let a::Addr# = "foo"#
375 in \x -> blah
376
377 In order to be able to inline `f`, we would like to float `a` to the top.
378 Another option would be to inline `a`, but that would lead to duplicating string
379 literals, which we want to avoid. See Trac #8472.
380
381 The solution is simply to allow top-level unlifted binders. We can't allow
382 arbitrary unlifted expression at the top-level though, unlifted binders cannot
383 be thunks, so we just allow string literals.
384
385 Also see Note [Compilation plan for top-level string literals].
386
387 Note [Compilation plan for top-level string literals]
388 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
389 Here is a summary on how top-level string literals are handled by various
390 parts of the compilation pipeline.
391
392 * In the source language, there is no way to bind a primitive string literal
393 at the top leve.
394
395 * In Core, we have a special rule that permits top-level Addr# bindings. See
396 Note [CoreSyn top-level string literals]. Core-to-core passes may introduce
397 new top-level string literals.
398
399 * In STG, top-level string literals are explicitly represented in the syntax
400 tree.
401
402 * A top-level string literal may end up exported from a module. In this case,
403 in the object file, the content of the exported literal is given a label with
404 the _bytes suffix.
405
406 Note [CoreSyn let/app invariant]
407 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
408 The let/app invariant
409 the right hand side of a non-recursive 'Let', and
410 the argument of an 'App',
411 /may/ be of unlifted type, but only if
412 the expression is ok-for-speculation.
413
414 This means that the let can be floated around
415 without difficulty. For example, this is OK:
416
417 y::Int# = x +# 1#
418
419 But this is not, as it may affect termination if the
420 expression is floated out:
421
422 y::Int# = fac 4#
423
424 In this situation you should use @case@ rather than a @let@. The function
425 'CoreUtils.needsCaseBinding' can help you determine which to generate, or
426 alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
427 which will generate a @case@ if necessary
428
429 The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in
430 coreSyn/MkCore.
431
432 Note [CoreSyn case invariants]
433 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
434 See #case_invariants#
435
436 Note [Levity polymorphism invariants]
437 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
438 The levity-polymorphism invariants are these:
439
440 * The type of a term-binder must not be levity-polymorphic
441 * The type of the argument of an App must not be levity-polymorphic.
442
443 A type (t::TYPE r) is "levity polymorphic" if 'r' has any free variables.
444
445 For example
446 \(r::RuntimeRep). \(a::TYPE r). \(x::a). e
447 is illegal because x's type has kind (TYPE r), which has 'r' free.
448
449 See Note [Levity polymorphism checking] in DsMonad to see where these
450 invariants are established for user-written code.
451
452 Note [CoreSyn let goal]
453 ~~~~~~~~~~~~~~~~~~~~~~~
454 * The simplifier tries to ensure that if the RHS of a let is a constructor
455 application, its arguments are trivial, so that the constructor can be
456 inlined vigorously.
457
458 Note [Type let]
459 ~~~~~~~~~~~~~~~
460 See #type_let#
461
462 Note [Empty case alternatives]
463 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
464 The alternatives of a case expression should be exhaustive. But
465 this exhaustive list can be empty!
466
467 * A case expression can have empty alternatives if (and only if) the
468 scrutinee is bound to raise an exception or diverge. When do we know
469 this? See Note [Bottoming expressions] in CoreUtils.
470
471 * The possiblity of empty alternatives is one reason we need a type on
472 the case expression: if the alternatives are empty we can't get the
473 type from the alternatives!
474
475 * In the case of empty types (see Note [Bottoming expressions]), say
476 data T
477 we do NOT want to replace
478 case (x::T) of Bool {} --> error Bool "Inaccessible case"
479 because x might raise an exception, and *that*'s what we want to see!
480 (Trac #6067 is an example.) To preserve semantics we'd have to say
481 x `seq` error Bool "Inaccessible case"
482 but the 'seq' is just a case, so we are back to square 1. Or I suppose
483 we could say
484 x |> UnsafeCoerce T Bool
485 but that loses all trace of the fact that this originated with an empty
486 set of alternatives.
487
488 * We can use the empty-alternative construct to coerce error values from
489 one type to another. For example
490
491 f :: Int -> Int
492 f n = error "urk"
493
494 g :: Int -> (# Char, Bool #)
495 g x = case f x of { 0 -> ..., n -> ... }
496
497 Then if we inline f in g's RHS we get
498 case (error Int "urk") of (# Char, Bool #) { ... }
499 and we can discard the alternatives since the scrutinee is bottom to give
500 case (error Int "urk") of (# Char, Bool #) {}
501
502 This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
503 if for no other reason that we don't need to instantiate the (~) at an
504 unboxed type.
505
506 * We treat a case expression with empty alternatives as trivial iff
507 its scrutinee is (see CoreUtils.exprIsTrivial). This is actually
508 important; see Note [Empty case is trivial] in CoreUtils
509
510 * An empty case is replaced by its scrutinee during the CoreToStg
511 conversion; remember STG is un-typed, so there is no need for
512 the empty case to do the type conversion.
513
514
515 ************************************************************************
516 * *
517 In/Out type synonyms
518 * *
519 ********************************************************************* -}
520
521 {- Many passes apply a substitution, and it's very handy to have type
522 synonyms to remind us whether or not the subsitution has been applied -}
523
524 -- Pre-cloning or substitution
525 type InBndr = CoreBndr
526 type InType = Type
527 type InKind = Kind
528 type InBind = CoreBind
529 type InExpr = CoreExpr
530 type InAlt = CoreAlt
531 type InArg = CoreArg
532 type InCoercion = Coercion
533
534 -- Post-cloning or substitution
535 type OutBndr = CoreBndr
536 type OutType = Type
537 type OutKind = Kind
538 type OutCoercion = Coercion
539 type OutBind = CoreBind
540 type OutExpr = CoreExpr
541 type OutAlt = CoreAlt
542 type OutArg = CoreArg
543
544
545 {- *********************************************************************
546 * *
547 Ticks
548 * *
549 ************************************************************************
550 -}
551
552 -- | Allows attaching extra information to points in expressions
553
554 -- If you edit this type, you may need to update the GHC formalism
555 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
556 data Tickish id =
557 -- | An @{-# SCC #-}@ profiling annotation, either automatically
558 -- added by the desugarer as a result of -auto-all, or added by
559 -- the user.
560 ProfNote {
561 profNoteCC :: CostCentre, -- ^ the cost centre
562 profNoteCount :: !Bool, -- ^ bump the entry count?
563 profNoteScope :: !Bool -- ^ scopes over the enclosed expression
564 -- (i.e. not just a tick)
565 }
566
567 -- | A "tick" used by HPC to track the execution of each
568 -- subexpression in the original source code.
569 | HpcTick {
570 tickModule :: Module,
571 tickId :: !Int
572 }
573
574 -- | A breakpoint for the GHCi debugger. This behaves like an HPC
575 -- tick, but has a list of free variables which will be available
576 -- for inspection in GHCi when the program stops at the breakpoint.
577 --
578 -- NB. we must take account of these Ids when (a) counting free variables,
579 -- and (b) substituting (don't substitute for them)
580 | Breakpoint
581 { breakpointId :: !Int
582 , breakpointFVs :: [id] -- ^ the order of this list is important:
583 -- it matches the order of the lists in the
584 -- appropriate entry in HscTypes.ModBreaks.
585 --
586 -- Careful about substitution! See
587 -- Note [substTickish] in CoreSubst.
588 }
589
590 -- | A source note.
591 --
592 -- Source notes are pure annotations: Their presence should neither
593 -- influence compilation nor execution. The semantics are given by
594 -- causality: The presence of a source note means that a local
595 -- change in the referenced source code span will possibly provoke
596 -- the generated code to change. On the flip-side, the functionality
597 -- of annotated code *must* be invariant against changes to all
598 -- source code *except* the spans referenced in the source notes
599 -- (see "Causality of optimized Haskell" paper for details).
600 --
601 -- Therefore extending the scope of any given source note is always
602 -- valid. Note that it is still undesirable though, as this reduces
603 -- their usefulness for debugging and profiling. Therefore we will
604 -- generally try only to make use of this property where it is
605 -- necessary to enable optimizations.
606 | SourceNote
607 { sourceSpan :: RealSrcSpan -- ^ Source covered
608 , sourceName :: String -- ^ Name for source location
609 -- (uses same names as CCs)
610 }
611
612 deriving (Eq, Ord, Data)
613
614 -- | A "counting tick" (where tickishCounts is True) is one that
615 -- counts evaluations in some way. We cannot discard a counting tick,
616 -- and the compiler should preserve the number of counting ticks as
617 -- far as possible.
618 --
619 -- However, we still allow the simplifier to increase or decrease
620 -- sharing, so in practice the actual number of ticks may vary, except
621 -- that we never change the value from zero to non-zero or vice versa.
622 tickishCounts :: Tickish id -> Bool
623 tickishCounts n@ProfNote{} = profNoteCount n
624 tickishCounts HpcTick{} = True
625 tickishCounts Breakpoint{} = True
626 tickishCounts _ = False
627
628
629 -- | Specifies the scoping behaviour of ticks. This governs the
630 -- behaviour of ticks that care about the covered code and the cost
631 -- associated with it. Important for ticks relating to profiling.
632 data TickishScoping =
633 -- | No scoping: The tick does not care about what code it
634 -- covers. Transformations can freely move code inside as well as
635 -- outside without any additional annotation obligations
636 NoScope
637
638 -- | Soft scoping: We want all code that is covered to stay
639 -- covered. Note that this scope type does not forbid
640 -- transformations from happening, as as long as all results of
641 -- the transformations are still covered by this tick or a copy of
642 -- it. For example
643 --
644 -- let x = tick<...> (let y = foo in bar) in baz
645 -- ===>
646 -- let x = tick<...> bar; y = tick<...> foo in baz
647 --
648 -- Is a valid transformation as far as "bar" and "foo" is
649 -- concerned, because both still are scoped over by the tick.
650 --
651 -- Note though that one might object to the "let" not being
652 -- covered by the tick any more. However, we are generally lax
653 -- with this - constant costs don't matter too much, and given
654 -- that the "let" was effectively merged we can view it as having
655 -- lost its identity anyway.
656 --
657 -- Also note that this scoping behaviour allows floating a tick
658 -- "upwards" in pretty much any situation. For example:
659 --
660 -- case foo of x -> tick<...> bar
661 -- ==>
662 -- tick<...> case foo of x -> bar
663 --
664 -- While this is always leagl, we want to make a best effort to
665 -- only make us of this where it exposes transformation
666 -- opportunities.
667 | SoftScope
668
669 -- | Cost centre scoping: We don't want any costs to move to other
670 -- cost-centre stacks. This means we not only want no code or cost
671 -- to get moved out of their cost centres, but we also object to
672 -- code getting associated with new cost-centre ticks - or
673 -- changing the order in which they get applied.
674 --
675 -- A rule of thumb is that we don't want any code to gain new
676 -- annotations. However, there are notable exceptions, for
677 -- example:
678 --
679 -- let f = \y -> foo in tick<...> ... (f x) ...
680 -- ==>
681 -- tick<...> ... foo[x/y] ...
682 --
683 -- In-lining lambdas like this is always legal, because inlining a
684 -- function does not change the cost-centre stack when the
685 -- function is called.
686 | CostCentreScope
687
688 deriving (Eq)
689
690 -- | Returns the intended scoping rule for a Tickish
691 tickishScoped :: Tickish id -> TickishScoping
692 tickishScoped n@ProfNote{}
693 | profNoteScope n = CostCentreScope
694 | otherwise = NoScope
695 tickishScoped HpcTick{} = NoScope
696 tickishScoped Breakpoint{} = CostCentreScope
697 -- Breakpoints are scoped: eventually we're going to do call
698 -- stacks, but also this helps prevent the simplifier from moving
699 -- breakpoints around and changing their result type (see #1531).
700 tickishScoped SourceNote{} = SoftScope
701
702 -- | Returns whether the tick scoping rule is at least as permissive
703 -- as the given scoping rule.
704 tickishScopesLike :: Tickish id -> TickishScoping -> Bool
705 tickishScopesLike t scope = tickishScoped t `like` scope
706 where NoScope `like` _ = True
707 _ `like` NoScope = False
708 SoftScope `like` _ = True
709 _ `like` SoftScope = False
710 CostCentreScope `like` _ = True
711
712 -- | Returns @True@ for ticks that can be floated upwards easily even
713 -- where it might change execution counts, such as:
714 --
715 -- Just (tick<...> foo)
716 -- ==>
717 -- tick<...> (Just foo)
718 --
719 -- This is a combination of @tickishSoftScope@ and
720 -- @tickishCounts@. Note that in principle splittable ticks can become
721 -- floatable using @mkNoTick@ -- even though there's currently no
722 -- tickish for which that is the case.
723 tickishFloatable :: Tickish id -> Bool
724 tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
725
726 -- | Returns @True@ for a tick that is both counting /and/ scoping and
727 -- can be split into its (tick, scope) parts using 'mkNoScope' and
728 -- 'mkNoTick' respectively.
729 tickishCanSplit :: Tickish id -> Bool
730 tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}
731 = True
732 tickishCanSplit _ = False
733
734 mkNoCount :: Tickish id -> Tickish id
735 mkNoCount n | not (tickishCounts n) = n
736 | not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"
737 mkNoCount n@ProfNote{} = n {profNoteCount = False}
738 mkNoCount _ = panic "mkNoCount: Undefined split!"
739
740 mkNoScope :: Tickish id -> Tickish id
741 mkNoScope n | tickishScoped n == NoScope = n
742 | not (tickishCanSplit n) = panic "mkNoScope: Cannot split!"
743 mkNoScope n@ProfNote{} = n {profNoteScope = False}
744 mkNoScope _ = panic "mkNoScope: Undefined split!"
745
746 -- | Return @True@ if this source annotation compiles to some backend
747 -- code. Without this flag, the tickish is seen as a simple annotation
748 -- that does not have any associated evaluation code.
749 --
750 -- What this means that we are allowed to disregard the tick if doing
751 -- so means that we can skip generating any code in the first place. A
752 -- typical example is top-level bindings:
753 --
754 -- foo = tick<...> \y -> ...
755 -- ==>
756 -- foo = \y -> tick<...> ...
757 --
758 -- Here there is just no operational difference between the first and
759 -- the second version. Therefore code generation should simply
760 -- translate the code as if it found the latter.
761 tickishIsCode :: Tickish id -> Bool
762 tickishIsCode SourceNote{} = False
763 tickishIsCode _tickish = True -- all the rest for now
764
765
766 -- | Governs the kind of expression that the tick gets placed on when
767 -- annotating for example using @mkTick@. If we find that we want to
768 -- put a tickish on an expression ruled out here, we try to float it
769 -- inwards until we find a suitable expression.
770 data TickishPlacement =
771
772 -- | Place ticks exactly on run-time expressions. We can still
773 -- move the tick through pure compile-time constructs such as
774 -- other ticks, casts or type lambdas. This is the most
775 -- restrictive placement rule for ticks, as all tickishs have in
776 -- common that they want to track runtime processes. The only
777 -- legal placement rule for counting ticks.
778 PlaceRuntime
779
780 -- | As @PlaceRuntime@, but we float the tick through all
781 -- lambdas. This makes sense where there is little difference
782 -- between annotating the lambda and annotating the lambda's code.
783 | PlaceNonLam
784
785 -- | In addition to floating through lambdas, cost-centre style
786 -- tickishs can also be moved from constructors, non-function
787 -- variables and literals. For example:
788 --
789 -- let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
790 --
791 -- Neither the constructor application, the variable or the
792 -- literal are likely to have any cost worth mentioning. And even
793 -- if y names a thunk, the call would not care about the
794 -- evaluation context. Therefore removing all annotations in the
795 -- above example is safe.
796 | PlaceCostCentre
797
798 deriving (Eq)
799
800 -- | Placement behaviour we want for the ticks
801 tickishPlace :: Tickish id -> TickishPlacement
802 tickishPlace n@ProfNote{}
803 | profNoteCount n = PlaceRuntime
804 | otherwise = PlaceCostCentre
805 tickishPlace HpcTick{} = PlaceRuntime
806 tickishPlace Breakpoint{} = PlaceRuntime
807 tickishPlace SourceNote{} = PlaceNonLam
808
809 -- | Returns whether one tick "contains" the other one, therefore
810 -- making the second tick redundant.
811 tickishContains :: Eq b => Tickish b -> Tickish b -> Bool
812 tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)
813 = n1 == n2 && containsSpan sp1 sp2
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 [InlineRules]
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 isClosedUnfolding :: Unfolding -> Bool -- No free variables
1354 isClosedUnfolding (CoreUnfolding {}) = False
1355 isClosedUnfolding (DFunUnfolding {}) = False
1356 isClosedUnfolding _ = True
1357
1358 -- | Only returns False if there is no unfolding information available at all
1359 hasSomeUnfolding :: Unfolding -> Bool
1360 hasSomeUnfolding NoUnfolding = False
1361 hasSomeUnfolding BootUnfolding = False
1362 hasSomeUnfolding _ = True
1363
1364 isBootUnfolding :: Unfolding -> Bool
1365 isBootUnfolding BootUnfolding = True
1366 isBootUnfolding _ = False
1367
1368 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
1369 neverUnfoldGuidance UnfNever = True
1370 neverUnfoldGuidance _ = False
1371
1372 canUnfold :: Unfolding -> Bool
1373 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
1374 canUnfold _ = False
1375
1376 {-
1377 Note [InlineRules]
1378 ~~~~~~~~~~~~~~~~~
1379 When you say
1380 {-# INLINE f #-}
1381 f x = <rhs>
1382 you intend that calls (f e) are replaced by <rhs>[e/x] So we
1383 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
1384 with it. Meanwhile, we can optimise <rhs> to our heart's content,
1385 leaving the original unfolding intact in Unfolding of 'f'. For example
1386 all xs = foldr (&&) True xs
1387 any p = all . map p {-# INLINE any #-}
1388 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
1389 which deforests well at the call site.
1390
1391 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
1392
1393 Moreover, it's only used when 'f' is applied to the
1394 specified number of arguments; that is, the number of argument on
1395 the LHS of the '=' sign in the original source definition.
1396 For example, (.) is now defined in the libraries like this
1397 {-# INLINE (.) #-}
1398 (.) f g = \x -> f (g x)
1399 so that it'll inline when applied to two arguments. If 'x' appeared
1400 on the left, thus
1401 (.) f g x = f (g x)
1402 it'd only inline when applied to three arguments. This slightly-experimental
1403 change was requested by Roman, but it seems to make sense.
1404
1405 See also Note [Inlining an InlineRule] in CoreUnfold.
1406
1407
1408 Note [OccInfo in unfoldings and rules]
1409 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1410 In unfoldings and rules, we guarantee that the template is occ-analysed,
1411 so that the occurrence info on the binders is correct. This is important,
1412 because the Simplifier does not re-analyse the template when using it. If
1413 the occurrence info is wrong
1414 - We may get more simpifier iterations than necessary, because
1415 once-occ info isn't there
1416 - More seriously, we may get an infinite loop if there's a Rec
1417 without a loop breaker marked
1418
1419
1420 ************************************************************************
1421 * *
1422 AltCon
1423 * *
1424 ************************************************************************
1425 -}
1426
1427 -- The Ord is needed for the FiniteMap used in the lookForConstructor
1428 -- in SimplEnv. If you declared that lookForConstructor *ignores*
1429 -- constructor-applications with LitArg args, then you could get
1430 -- rid of this Ord.
1431
1432 instance Outputable AltCon where
1433 ppr (DataAlt dc) = ppr dc
1434 ppr (LitAlt lit) = ppr lit
1435 ppr DEFAULT = text "__DEFAULT"
1436
1437 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
1438 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
1439
1440 ltAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Bool
1441 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
1442
1443 cmpAltCon :: AltCon -> AltCon -> Ordering
1444 -- ^ Compares 'AltCon's within a single list of alternatives
1445 cmpAltCon DEFAULT DEFAULT = EQ
1446 cmpAltCon DEFAULT _ = LT
1447
1448 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
1449 cmpAltCon (DataAlt _) DEFAULT = GT
1450 cmpAltCon (LitAlt l1) (LitAlt l2) = l1 `compare` l2
1451 cmpAltCon (LitAlt _) DEFAULT = GT
1452
1453 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
1454 ppr con1 <+> ppr con2 )
1455 LT
1456
1457 {-
1458 ************************************************************************
1459 * *
1460 \subsection{Useful synonyms}
1461 * *
1462 ************************************************************************
1463
1464 Note [CoreProgram]
1465 ~~~~~~~~~~~~~~~~~~
1466 The top level bindings of a program, a CoreProgram, are represented as
1467 a list of CoreBind
1468
1469 * Later bindings in the list can refer to earlier ones, but not vice
1470 versa. So this is OK
1471 NonRec { x = 4 }
1472 Rec { p = ...q...x...
1473 ; q = ...p...x }
1474 Rec { f = ...p..x..f.. }
1475 NonRec { g = ..f..q...x.. }
1476 But it would NOT be ok for 'f' to refer to 'g'.
1477
1478 * The occurrence analyser does strongly-connected component analysis
1479 on each Rec binding, and splits it into a sequence of smaller
1480 bindings where possible. So the program typically starts life as a
1481 single giant Rec, which is then dependency-analysed into smaller
1482 chunks.
1483 -}
1484
1485 -- If you edit this type, you may need to update the GHC formalism
1486 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
1487 type CoreProgram = [CoreBind] -- See Note [CoreProgram]
1488
1489 -- | The common case for the type of binders and variables when
1490 -- we are manipulating the Core language within GHC
1491 type CoreBndr = Var
1492 -- | Expressions where binders are 'CoreBndr's
1493 type CoreExpr = Expr CoreBndr
1494 -- | Argument expressions where binders are 'CoreBndr's
1495 type CoreArg = Arg CoreBndr
1496 -- | Binding groups where binders are 'CoreBndr's
1497 type CoreBind = Bind CoreBndr
1498 -- | Case alternatives where binders are 'CoreBndr's
1499 type CoreAlt = Alt CoreBndr
1500
1501 {-
1502 ************************************************************************
1503 * *
1504 \subsection{Tagging}
1505 * *
1506 ************************************************************************
1507 -}
1508
1509 -- | Binders are /tagged/ with a t
1510 data TaggedBndr t = TB CoreBndr t -- TB for "tagged binder"
1511
1512 type TaggedBind t = Bind (TaggedBndr t)
1513 type TaggedExpr t = Expr (TaggedBndr t)
1514 type TaggedArg t = Arg (TaggedBndr t)
1515 type TaggedAlt t = Alt (TaggedBndr t)
1516
1517 instance Outputable b => Outputable (TaggedBndr b) where
1518 ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
1519
1520 instance Outputable b => OutputableBndr (TaggedBndr b) where
1521 pprBndr _ b = ppr b -- Simple
1522 pprInfixOcc b = ppr b
1523 pprPrefixOcc b = ppr b
1524
1525 deTagExpr :: TaggedExpr t -> CoreExpr
1526 deTagExpr (Var v) = Var v
1527 deTagExpr (Lit l) = Lit l
1528 deTagExpr (Type ty) = Type ty
1529 deTagExpr (Coercion co) = Coercion co
1530 deTagExpr (App e1 e2) = App (deTagExpr e1) (deTagExpr e2)
1531 deTagExpr (Lam (TB b _) e) = Lam b (deTagExpr e)
1532 deTagExpr (Let bind body) = Let (deTagBind bind) (deTagExpr body)
1533 deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)
1534 deTagExpr (Tick t e) = Tick t (deTagExpr e)
1535 deTagExpr (Cast e co) = Cast (deTagExpr e) co
1536
1537 deTagBind :: TaggedBind t -> CoreBind
1538 deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)
1539 deTagBind (Rec prs) = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]
1540
1541 deTagAlt :: TaggedAlt t -> CoreAlt
1542 deTagAlt (con, bndrs, rhs) = (con, [b | TB b _ <- bndrs], deTagExpr rhs)
1543
1544 {-
1545 ************************************************************************
1546 * *
1547 \subsection{Core-constructing functions with checking}
1548 * *
1549 ************************************************************************
1550 -}
1551
1552 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
1553 -- use 'MkCore.mkCoreApps' if possible
1554 mkApps :: Expr b -> [Arg b] -> Expr b
1555 -- | Apply a list of type argument expressions to a function expression in a nested fashion
1556 mkTyApps :: Expr b -> [Type] -> Expr b
1557 -- | Apply a list of coercion argument expressions to a function expression in a nested fashion
1558 mkCoApps :: Expr b -> [Coercion] -> Expr b
1559 -- | Apply a list of type or value variables to a function expression in a nested fashion
1560 mkVarApps :: Expr b -> [Var] -> Expr b
1561 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
1562 -- use 'MkCore.mkCoreConApps' if possible
1563 mkConApp :: DataCon -> [Arg b] -> Expr b
1564
1565 mkApps f args = foldl App f args
1566 mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args
1567 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
1568 mkConApp con args = mkApps (Var (dataConWorkId con)) args
1569
1570 mkTyApps f args = foldl (\ e a -> App e (typeOrCoercion a)) f args
1571 where
1572 typeOrCoercion ty
1573 | Just co <- isCoercionTy_maybe ty = Coercion co
1574 | otherwise = Type ty
1575
1576 mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
1577 mkConApp2 con tys arg_ids = Var (dataConWorkId con)
1578 `mkApps` map Type tys
1579 `mkApps` map varToCoreExpr arg_ids
1580
1581
1582 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
1583 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1584 mkIntLit :: DynFlags -> Integer -> Expr b
1585 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
1586 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1587 mkIntLitInt :: DynFlags -> Int -> Expr b
1588
1589 mkIntLit dflags n = Lit (mkMachInt dflags n)
1590 mkIntLitInt dflags n = Lit (mkMachInt dflags (toInteger n))
1591
1592 -- | Create a machine word literal expression of type @Word#@ from an @Integer@.
1593 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1594 mkWordLit :: DynFlags -> Integer -> Expr b
1595 -- | Create a machine word literal expression of type @Word#@ from a @Word@.
1596 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1597 mkWordLitWord :: DynFlags -> Word -> Expr b
1598
1599 mkWordLit dflags w = Lit (mkMachWord dflags w)
1600 mkWordLitWord dflags w = Lit (mkMachWord dflags (toInteger w))
1601
1602 mkWord64LitWord64 :: Word64 -> Expr b
1603 mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
1604
1605 mkInt64LitInt64 :: Int64 -> Expr b
1606 mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))
1607
1608 -- | Create a machine character literal expression of type @Char#@.
1609 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
1610 mkCharLit :: Char -> Expr b
1611 -- | Create a machine string literal expression of type @Addr#@.
1612 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
1613 mkStringLit :: String -> Expr b
1614
1615 mkCharLit c = Lit (mkMachChar c)
1616 mkStringLit s = Lit (mkMachString s)
1617
1618 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
1619 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1620 mkFloatLit :: Rational -> Expr b
1621 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
1622 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1623 mkFloatLitFloat :: Float -> Expr b
1624
1625 mkFloatLit f = Lit (mkMachFloat f)
1626 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
1627
1628 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
1629 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1630 mkDoubleLit :: Rational -> Expr b
1631 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
1632 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1633 mkDoubleLitDouble :: Double -> Expr b
1634
1635 mkDoubleLit d = Lit (mkMachDouble d)
1636 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
1637
1638 -- | Bind all supplied binding groups over an expression in a nested let expression. Assumes
1639 -- that the rhs satisfies the let/app invariant. Prefer to use 'MkCore.mkCoreLets' if
1640 -- possible, which does guarantee the invariant
1641 mkLets :: [Bind b] -> Expr b -> Expr b
1642 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
1643 -- use 'MkCore.mkCoreLams' if possible
1644 mkLams :: [b] -> Expr b -> Expr b
1645
1646 mkLams binders body = foldr Lam body binders
1647 mkLets binds body = foldr Let body binds
1648
1649
1650 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1651 -- this can only be used to bind something in a non-recursive @let@ expression
1652 mkTyBind :: TyVar -> Type -> CoreBind
1653 mkTyBind tv ty = NonRec tv (Type ty)
1654
1655 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1656 -- this can only be used to bind something in a non-recursive @let@ expression
1657 mkCoBind :: CoVar -> Coercion -> CoreBind
1658 mkCoBind cv co = NonRec cv (Coercion co)
1659
1660 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
1661 varToCoreExpr :: CoreBndr -> Expr b
1662 varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)
1663 | isCoVar v = Coercion (mkCoVarCo v)
1664 | otherwise = ASSERT( isId v ) Var v
1665
1666 varsToCoreExprs :: [CoreBndr] -> [Expr b]
1667 varsToCoreExprs vs = map varToCoreExpr vs
1668
1669 {-
1670 ************************************************************************
1671 * *
1672 Getting a result type
1673 * *
1674 ************************************************************************
1675
1676 These are defined here to avoid a module loop between CoreUtils and CoreFVs
1677
1678 -}
1679
1680 applyTypeToArg :: Type -> CoreExpr -> Type
1681 -- ^ Determines the type resulting from applying an expression with given type
1682 -- to a given argument expression
1683 applyTypeToArg fun_ty arg = piResultTy fun_ty (exprToType arg)
1684
1685 -- | If the expression is a 'Type', converts. Otherwise,
1686 -- panics. NB: This does /not/ convert 'Coercion' to 'CoercionTy'.
1687 exprToType :: CoreExpr -> Type
1688 exprToType (Type ty) = ty
1689 exprToType _bad = pprPanic "exprToType" empty
1690
1691 -- | If the expression is a 'Coercion', converts.
1692 exprToCoercion_maybe :: CoreExpr -> Maybe Coercion
1693 exprToCoercion_maybe (Coercion co) = Just co
1694 exprToCoercion_maybe _ = Nothing
1695
1696 {-
1697 ************************************************************************
1698 * *
1699 \subsection{Simple access functions}
1700 * *
1701 ************************************************************************
1702 -}
1703
1704 -- | Extract every variable by this group
1705 bindersOf :: Bind b -> [b]
1706 -- If you edit this function, you may need to update the GHC formalism
1707 -- See Note [GHC Formalism] in coreSyn/CoreLint.hs
1708 bindersOf (NonRec binder _) = [binder]
1709 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
1710
1711 -- | 'bindersOf' applied to a list of binding groups
1712 bindersOfBinds :: [Bind b] -> [b]
1713 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
1714
1715 rhssOfBind :: Bind b -> [Expr b]
1716 rhssOfBind (NonRec _ rhs) = [rhs]
1717 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
1718
1719 rhssOfAlts :: [Alt b] -> [Expr b]
1720 rhssOfAlts alts = [e | (_,_,e) <- alts]
1721
1722 -- | Collapse all the bindings in the supplied groups into a single
1723 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
1724 flattenBinds :: [Bind b] -> [(b, Expr b)]
1725 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
1726 flattenBinds (Rec prs1 : binds) = prs1 ++ flattenBinds binds
1727 flattenBinds [] = []
1728
1729 -- | We often want to strip off leading lambdas before getting down to
1730 -- business. Variants are 'collectTyBinders', 'collectValBinders',
1731 -- and 'collectTyAndValBinders'
1732 collectBinders :: Expr b -> ([b], Expr b)
1733 collectTyBinders :: CoreExpr -> ([TyVar], CoreExpr)
1734 collectValBinders :: CoreExpr -> ([Id], CoreExpr)
1735 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
1736
1737 collectBinders expr
1738 = go [] expr
1739 where
1740 go bs (Lam b e) = go (b:bs) e
1741 go bs e = (reverse bs, e)
1742
1743 collectTyBinders expr
1744 = go [] expr
1745 where
1746 go tvs (Lam b e) | isTyVar b = go (b:tvs) e
1747 go tvs e = (reverse tvs, e)
1748
1749 collectValBinders expr
1750 = go [] expr
1751 where
1752 go ids (Lam b e) | isId b = go (b:ids) e
1753 go ids body = (reverse ids, body)
1754
1755 collectTyAndValBinders expr
1756 = (tvs, ids, body)
1757 where
1758 (tvs, body1) = collectTyBinders expr
1759 (ids, body) = collectValBinders body1
1760
1761 -- | Takes a nested application expression and returns the the function
1762 -- being applied and the arguments to which it is applied
1763 collectArgs :: Expr b -> (Expr b, [Arg b])
1764 collectArgs expr
1765 = go expr []
1766 where
1767 go (App f a) as = go f (a:as)
1768 go e as = (e, as)
1769
1770 -- | Like @collectArgs@, but also collects looks through floatable
1771 -- ticks if it means that we can find more arguments.
1772 collectArgsTicks :: (Tickish Id -> Bool) -> Expr b
1773 -> (Expr b, [Arg b], [Tickish Id])
1774 collectArgsTicks skipTick expr
1775 = go expr [] []
1776 where
1777 go (App f a) as ts = go f (a:as) ts
1778 go (Tick t e) as ts
1779 | skipTick t = go e as (t:ts)
1780 go e as ts = (e, as, reverse ts)
1781
1782
1783 {-
1784 ************************************************************************
1785 * *
1786 \subsection{Predicates}
1787 * *
1788 ************************************************************************
1789
1790 At one time we optionally carried type arguments through to runtime.
1791 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1792 i.e. if type applications are actual lambdas because types are kept around
1793 at runtime. Similarly isRuntimeArg.
1794 -}
1795
1796 -- | Will this variable exist at runtime?
1797 isRuntimeVar :: Var -> Bool
1798 isRuntimeVar = isId
1799
1800 -- | Will this argument expression exist at runtime?
1801 isRuntimeArg :: CoreExpr -> Bool
1802 isRuntimeArg = isValArg
1803
1804 -- | Returns @True@ for value arguments, false for type args
1805 -- NB: coercions are value arguments (zero width, to be sure,
1806 -- like State#, but still value args).
1807 isValArg :: Expr b -> Bool
1808 isValArg e = not (isTypeArg e)
1809
1810 -- | Returns @True@ iff the expression is a 'Type' or 'Coercion'
1811 -- expression at its top level
1812 isTyCoArg :: Expr b -> Bool
1813 isTyCoArg (Type {}) = True
1814 isTyCoArg (Coercion {}) = True
1815 isTyCoArg _ = False
1816
1817 -- | Returns @True@ iff the expression is a 'Type' expression at its
1818 -- top level. Note this does NOT include 'Coercion's.
1819 isTypeArg :: Expr b -> Bool
1820 isTypeArg (Type {}) = True
1821 isTypeArg _ = False
1822
1823 -- | The number of binders that bind values rather than types
1824 valBndrCount :: [CoreBndr] -> Int
1825 valBndrCount = count isId
1826
1827 -- | The number of argument expressions that are values rather than types at their top level
1828 valArgCount :: [Arg b] -> Int
1829 valArgCount = count isValArg
1830
1831 {-
1832 ************************************************************************
1833 * *
1834 \subsection{Annotated core}
1835 * *
1836 ************************************************************************
1837 -}
1838
1839 -- | Annotated core: allows annotation at every node in the tree
1840 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1841
1842 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1843 data AnnExpr' bndr annot
1844 = AnnVar Id
1845 | AnnLit Literal
1846 | AnnLam bndr (AnnExpr bndr annot)
1847 | AnnApp (AnnExpr bndr annot) (AnnExpr bndr annot)
1848 | AnnCase (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1849 | AnnLet (AnnBind bndr annot) (AnnExpr bndr annot)
1850 | AnnCast (AnnExpr bndr annot) (annot, Coercion)
1851 -- Put an annotation on the (root of) the coercion
1852 | AnnTick (Tickish Id) (AnnExpr bndr annot)
1853 | AnnType Type
1854 | AnnCoercion Coercion
1855
1856 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1857 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1858
1859 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1860 data AnnBind bndr annot
1861 = AnnNonRec bndr (AnnExpr bndr annot)
1862 | AnnRec [(bndr, AnnExpr bndr annot)]
1863
1864 -- | Takes a nested application expression and returns the the function
1865 -- being applied and the arguments to which it is applied
1866 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1867 collectAnnArgs expr
1868 = go expr []
1869 where
1870 go (_, AnnApp f a) as = go f (a:as)
1871 go e as = (e, as)
1872
1873 collectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a
1874 -> (AnnExpr b a, [AnnExpr b a], [Tickish Var])
1875 collectAnnArgsTicks tickishOk expr
1876 = go expr [] []
1877 where
1878 go (_, AnnApp f a) as ts = go f (a:as) ts
1879 go (_, AnnTick t e) as ts | tickishOk t
1880 = go e as (t:ts)
1881 go e as ts = (e, as, reverse ts)
1882
1883 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1884 deAnnotate (_, e) = deAnnotate' e
1885
1886 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1887 deAnnotate' (AnnType t) = Type t
1888 deAnnotate' (AnnCoercion co) = Coercion co
1889 deAnnotate' (AnnVar v) = Var v
1890 deAnnotate' (AnnLit lit) = Lit lit
1891 deAnnotate' (AnnLam binder body) = Lam binder (deAnnotate body)
1892 deAnnotate' (AnnApp fun arg) = App (deAnnotate fun) (deAnnotate arg)
1893 deAnnotate' (AnnCast e (_,co)) = Cast (deAnnotate e) co
1894 deAnnotate' (AnnTick tick body) = Tick tick (deAnnotate body)
1895
1896 deAnnotate' (AnnLet bind body)
1897 = Let (deAnnBind bind) (deAnnotate body)
1898 where
1899 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1900 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1901
1902 deAnnotate' (AnnCase scrut v t alts)
1903 = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1904
1905 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1906 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1907
1908 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1909 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1910 collectAnnBndrs e
1911 = collect [] e
1912 where
1913 collect bs (_, AnnLam b body) = collect (b:bs) body
1914 collect bs body = (reverse bs, body)