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