CoreSyn.hs 71.5 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1
2
3
4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
Simon Marlow's avatar
Simon Marlow committed
5

6
{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
Ian Lynagh's avatar
Ian Lynagh committed
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
Peter Wortmann's avatar
Peter Wortmann committed
11
12
        Expr(..), Alt, Bind(..), AltCon(..), Arg,
        Tickish(..), TickishScoping(..), TickishPlacement(..),
13
        CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
14
        TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
15

16
        -- ** 'Expr' construction
17
18
19
20
21
22
23
24
25
26
27
28
        mkLets, mkLams,
        mkApps, mkTyApps, mkCoApps, mkVarApps,

        mkIntLit, mkIntLitInt,
        mkWordLit, mkWordLitWord,
        mkWord64LitWord64, mkInt64LitInt64,
        mkCharLit, mkStringLit,
        mkFloatLit, mkFloatLitFloat,
        mkDoubleLit, mkDoubleLitDouble,

        mkConApp, mkConApp2, mkTyBind, mkCoBind,
        varToCoreExpr, varsToCoreExprs,
29

30
        isId, cmpAltCon, cmpAlt, ltAlt,
31
32
33

        -- ** Simple 'Expr' access functions and predicates
        bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
34
        collectBinders, collectTyBinders, collectTyAndValBinders,
Peter Wortmann's avatar
Peter Wortmann committed
35
        collectArgs, collectArgsTicks, flattenBinds,
36

37
38
39
        exprToType, exprToCoercion_maybe,
        applyTypeToArg,

40
41
        isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
        isRuntimeArg, isRuntimeVar,
42

Peter Wortmann's avatar
Peter Wortmann committed
43
44
45
46
        tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,
        tickishCanSplit, mkNoCount, mkNoScope,
        tickishIsCode, tickishPlace,
        tickishContains,
47
48

        -- * Unfolding data types
49
50
        Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),

51
52
        -- ** Constructing 'Unfolding's
        noUnfolding, evaldUnfolding, mkOtherCon,
53
        unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
54
55
56
57
58

        -- ** Predicates and deconstruction on 'Unfolding'
        unfoldingTemplate, expandUnfolding_maybe,
        maybeUnfoldingTemplate, otherCons,
        isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
59
        isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
60
        isStableUnfolding, hasStableCoreUnfolding_maybe,
61
62
63
64
65
        isClosedUnfolding, hasSomeUnfolding,
        canUnfold, neverUnfoldGuidance, isStableSource,

        -- * Annotated expression data types
        AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
66

Simon Marlow's avatar
Simon Marlow committed
67
        -- ** Operations on annotated expressions
Peter Wortmann's avatar
Peter Wortmann committed
68
        collectAnnArgs, collectAnnArgsTicks,
Simon Marlow's avatar
Simon Marlow committed
69

70
71
72
        -- ** Operations on annotations
        deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,

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
84
        setRuleIdName,
        isBuiltinRule, isLocalRule, isAutoRule,
85

86
87
        -- * Core vectorisation declarations data type
        CoreVect(..)
88
89
    ) where

90
#include "HsVersions.h"
91

Simon Marlow's avatar
Simon Marlow committed
92
import CostCentre
93
import VarEnv( InScopeSet )
Simon Marlow's avatar
Simon Marlow committed
94
95
96
97
import Var
import Type
import Coercion
import Name
98
import NameSet
99
import NameEnv( NameEnv, emptyNameEnv )
Simon Marlow's avatar
Simon Marlow committed
100
101
import Literal
import DataCon
102
import Module
103
import TyCon
Simon Marlow's avatar
Simon Marlow committed
104
import BasicTypes
105
import DynFlags
106
import Outputable
twanvl's avatar
twanvl committed
107
import Util
108
import UniqFM
Peter Wortmann's avatar
Peter Wortmann committed
109
import SrcLoc     ( RealSrcSpan, containsSpan )
110
import Binary
111

112
import Data.Data hiding (TyCon)
113
import Data.Int
114
115
import Data.Word

116
infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
117
-- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
118

Austin Seipp's avatar
Austin Seipp committed
119
120
121
{-
************************************************************************
*                                                                      *
122
\subsection{The main data types}
Austin Seipp's avatar
Austin Seipp committed
123
124
*                                                                      *
************************************************************************
125

126
These data types are the heart of the compiler
Austin Seipp's avatar
Austin Seipp committed
127
-}
128

129
130
131
132
133
134
135
136
137
138
-- | This is the data type that represents GHCs core intermediate language. Currently
-- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
-- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
--
-- We get from Haskell source to this Core language in a number of stages:
--
-- 1. The source code is parsed into an abstract syntax tree, which is represented
--    by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
--
-- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
139
--    (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical.
140
141
142
143
144
145
146
147
148
149
150
151
152
--    For example, this program:
--
-- @
--      f x = let f x = x + 1
--            in f (x - 2)
-- @
--
--    Would be renamed by having 'Unique's attached so it looked something like this:
--
-- @
--      f_1 x_2 = let f_3 x_4 = x_4 + 1
--                in f_3 (x_2 - 2)
-- @
Simon Peyton Jones's avatar
Simon Peyton Jones committed
153
--    But see Note [Shadowing] below.
154
155
156
157
158
159
160
161
162
--
-- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
--    type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
--
-- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
--    this 'Expr' type, which has far fewer constructors and hence is easier to perform
--    optimization, analysis and code generation on.
--
-- The type parameter @b@ is for the type of binders in the expression tree.
batterseapower's avatar
batterseapower committed
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
--
-- The language consists of the following elements:
--
-- *  Variables
--
-- *  Primitive literals
--
-- *  Applications: note that the argument may be a 'Type'.
--
--    See "CoreSyn#let_app_invariant" for another invariant
--
-- *  Lambda abstraction
--
-- *  Recursive and non recursive @let@s. Operationally
--    this corresponds to allocating a thunk for the things
--    bound and then executing the sub-expression.
179
--
batterseapower's avatar
batterseapower committed
180
181
--    #top_level_invariant#
--    #letrec_invariant#
182
--
batterseapower's avatar
batterseapower committed
183
184
185
--    The right hand sides of all top-level and recursive @let@s
--    /must/ be of lifted type (see "Type#type_classification" for
--    the meaning of /lifted/ vs. /unlifted/).
186
--
Simon Peyton Jones's avatar
Simon Peyton Jones committed
187
188
--    See Note [CoreSyn let/app invariant]
--
batterseapower's avatar
batterseapower committed
189
190
--    #type_let#
--    We allow a /non-recursive/ let to bind a type variable, thus:
191
--
batterseapower's avatar
batterseapower committed
192
--    > Let (NonRec tv (Type ty)) body
193
--
batterseapower's avatar
batterseapower committed
194
195
--    This can be very convenient for postponing type substitutions until
--    the next run of the simplifier.
196
--
batterseapower's avatar
batterseapower committed
197
198
199
200
201
202
203
204
--    At the moment, the rest of the compiler only deals with type-let
--    in a Let expression, rather than at top level.  We may want to revist
--    this choice.
--
-- *  Case split. Operationally this corresponds to evaluating
--    the scrutinee (expression examined) to weak head normal form
--    and then examining at most one level of resulting constructor (i.e. you
--    cannot do nested pattern matching directly with this).
205
--
batterseapower's avatar
batterseapower committed
206
207
--    The binder gets bound to the value of the scrutinee,
--    and the 'Type' must be that of all the case alternatives
208
--
batterseapower's avatar
batterseapower committed
209
--    #case_invariants#
210
--    This is one of the more complicated elements of the Core language,
batterseapower's avatar
batterseapower committed
211
--    and comes with a number of restrictions:
212
213
--
--    1. The list of alternatives may be empty;
214
--       See Note [Empty case alternatives]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
215
--
216
--    2. The 'DEFAULT' case alternative must be first in the list,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
217
--       if it occurs at all.
218
219
220
221
222
--
--    3. The remaining cases are in order of increasing
--         tag  (for 'DataAlts') or
--         lit  (for 'LitAlts').
--       This makes finding the relevant constructor easy,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
223
--       and makes comparison easier too.
224
225
--
--    4. The list of alternatives must be exhaustive. An /exhaustive/ case
Simon Peyton Jones's avatar
Simon Peyton Jones committed
226
--       does not necessarily mention all constructors:
batterseapower's avatar
batterseapower committed
227
--
228
229
230
231
232
233
234
235
236
237
238
239
--       @
--            data Foo = Red | Green | Blue
--       ... case x of
--            Red   -> True
--            other -> f (case x of
--                            Green -> ...
--                            Blue  -> ... ) ...
--       @
--
--       The inner case does not need a @Red@ alternative, because @x@
--       can't be @Red@ at that program point.
--
Ben Gamari's avatar
Ben Gamari committed
240
241
242
243
--    5. Floating-point values must not be scrutinised against literals.
--       See Trac #9238 and Note [Rules for floating-point comparisons]
--       in PrelRules for rationale.
--
244
245
-- *  Cast an expression to a particular type.
--    This is used to implement @newtype@s (a @newtype@ constructor or
batterseapower's avatar
batterseapower committed
246
247
248
249
250
251
252
253
--    destructor just becomes a 'Cast' in Core) and GADTs.
--
-- *  Notes. These allow general information to be added to expressions
--    in the syntax tree
--
-- *  A type: this should only show up at the top level of an Arg
--
-- *  A coercion
254
255

-- If you edit this type, you may need to update the GHC formalism
256
-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
257
data Expr b
258
  = Var   Id
batterseapower's avatar
batterseapower committed
259
260
261
262
  | Lit   Literal
  | App   (Expr b) (Arg b)
  | Lam   b (Expr b)
  | Let   (Bind b) (Expr b)
263
  | Case  (Expr b) b Type [Alt b]       -- See #case_invariant#
batterseapower's avatar
batterseapower committed
264
  | Cast  (Expr b) Coercion
265
  | Tick  (Tickish Id) (Expr b)
batterseapower's avatar
batterseapower committed
266
267
  | Type  Type
  | Coercion Coercion
268
  deriving Data
269
270
271
272
273
274
275
276

-- | Type synonym for expressions that occur in function argument positions.
-- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
type Arg b = Expr b

-- | A case split alternative. Consists of the constructor leading to the alternative,
-- the variables bound from the constructor, and the expression to be executed given that binding.
-- The default alternative is @(DEFAULT, [], rhs)@
277
278

-- If you edit this type, you may need to update the GHC formalism
279
-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
280
281
282
type Alt b = (AltCon, [b], Expr b)

-- | A case alternative constructor (i.e. pattern match)
283
284

-- If you edit this type, you may need to update the GHC formalism
285
-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
286
data AltCon
287
288
289
290
291
  = DataAlt DataCon   --  ^ A plain data constructor: @case e of { Foo x -> ... }@.
                      -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@

  | LitAlt  Literal   -- ^ A literal: @case e of { 1 -> ... }@
                      -- Invariant: always an *unlifted* literal
292
293
                      -- See Note [Literal alternatives]

294
  | DEFAULT           -- ^ Trivial alternative: @case e of { _ -> ... }@
niteria's avatar
niteria committed
295
   deriving (Eq, Data)
296

297
-- | Binding, used for top level bindings in a module and local bindings in a @let@.
298
299

-- If you edit this type, you may need to update the GHC formalism
300
-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
301
data Bind b = NonRec b (Expr b)
302
            | Rec [(b, (Expr b))]
303
  deriving Data
304

Austin Seipp's avatar
Austin Seipp committed
305
{-
Simon Peyton Jones's avatar
Simon Peyton Jones committed
306
307
308
309
310
311
312
313
314
315
316
317
318
Note [Shadowing]
~~~~~~~~~~~~~~~~
While various passes attempt to rename on-the-fly in a manner that
avoids "shadowing" (thereby simplifying downstream optimizations),
neither the simplifier nor any other pass GUARANTEES that shadowing is
avoided. Thus, all passes SHOULD work fine even in the presence of
arbitrary shadowing in their inputs.

In particular, scrutinee variables `x` in expressions of the form
`Case e x t` are often renamed to variables with a prefix
"wild_". These "wild" variables may appear in the body of the
case-expression, and further, may be shadowed within the body.

Simon Peyton Jones's avatar
Simon Peyton Jones committed
319
320
321
322
323
324
325
So the Unique in an Var is not really unique at all.  Still, it's very
useful to give a constant-time equality/ordering for Vars, and to give
a key that can be used to make sets of Vars (VarSet), or mappings from
Vars to other things (VarEnv).   Moreover, if you do want to eliminate
shadowing, you can give a new Unique to an Id without changing its
printable name, which makes debugging easier.

326
327
328
329
330
331
332
333
334
335
336
337
338
339
Note [Literal alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Literal alternatives (LitAlt lit) are always for *un-lifted* literals.
We have one literal, a literal Integer, that is lifted, and we don't
allow in a LitAlt, because LitAlt cases don't do any evaluation. Also
(see Trac #5603) if you say
    case 3 of
      S# x -> ...
      J# _ _ -> ...
(where S#, J# are the constructors for Integer) we don't want the
simplifier calling findAlt with argument (LitAlt 3).  No no.  Integer
literals are an opaque encoding of an algebraic data type, not of
an unlifted literal, like all the others.

Ben Gamari's avatar
Ben Gamari committed
340
341
342
Also, we do not permit case analysis with literal patterns on floating-point
types. See Trac #9238 and Note [Rules for floating-point comparisons] in
PrelRules for the rationale for this restriction.
343

344
345
346
347
-------------------------- CoreSyn INVARIANTS ---------------------------

Note [CoreSyn top-level invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
348
See #toplevel_invariant#
349
350
351

Note [CoreSyn letrec invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
352
See #letrec_invariant#
353
354
355

Note [CoreSyn let/app invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Simon Peyton Jones's avatar
Simon Peyton Jones committed
356
The let/app invariant
Javran Cheng's avatar
Javran Cheng committed
357
     the right hand side of a non-recursive 'Let', and
Simon Peyton Jones's avatar
Simon Peyton Jones committed
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
     the argument of an 'App',
    /may/ be of unlifted type, but only if
    the expression is ok-for-speculation.

This means that the let can be floated around
without difficulty. For example, this is OK:

   y::Int# = x +# 1#

But this is not, as it may affect termination if the
expression is floated out:

   y::Int# = fac 4#

In this situation you should use @case@ rather than a @let@. The function
'CoreUtils.needsCaseBinding' can help you determine which to generate, or
alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
which will generate a @case@ if necessary
376

377
Th let/app invariant is initially enforced by DsUtils.mkCoreLet and mkCoreApp
378
379
380

Note [CoreSyn case invariants]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
381
See #case_invariants#
382
383

Note [CoreSyn let goal]
384
~~~~~~~~~~~~~~~~~~~~~~~
385
386
387
388
* The simplifier tries to ensure that if the RHS of a let is a constructor
  application, its arguments are trivial, so that the constructor can be
  inlined vigorously.

389
390
Note [Type let]
~~~~~~~~~~~~~~~
391
See #type_let#
392

393
394
Note [Empty case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Simon Peyton Jones's avatar
Simon Peyton Jones committed
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
The alternatives of a case expression should be exhaustive.  But
this exhaustive list can be empty!

* A case expression can have empty alternatives if (and only if) the
  scrutinee is bound to raise an exception or diverge. When do we know
  this?  See Note [Bottoming expressions] in CoreUtils.

* The possiblity of empty alternatives is one reason we need a type on
  the case expression: if the alternatives are empty we can't get the
  type from the alternatives!

* In the case of empty types (see Note [Bottoming expressions]), say
    data T
  we do NOT want to replace
    case (x::T) of Bool {}   -->   error Bool "Inaccessible case"
  because x might raise an exception, and *that*'s what we want to see!
  (Trac #6067 is an example.) To preserve semantics we'd have to say
     x `seq` error Bool "Inaccessible case"
  but the 'seq' is just a case, so we are back to square 1.  Or I suppose
  we could say
     x |> UnsafeCoerce T Bool
  but that loses all trace of the fact that this originated with an empty
  set of alternatives.

* We can use the empty-alternative construct to coerce error values from
  one type to another.  For example
421
422
423

    f :: Int -> Int
    f n = error "urk"
424

425
426
427
    g :: Int -> (# Char, Bool #)
    g x = case f x of { 0 -> ..., n -> ... }

Simon Peyton Jones's avatar
Simon Peyton Jones committed
428
  Then if we inline f in g's RHS we get
429
    case (error Int "urk") of (# Char, Bool #) { ... }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
430
  and we can discard the alternatives since the scrutinee is bottom to give
431
432
    case (error Int "urk") of (# Char, Bool #) {}

Simon Peyton Jones's avatar
Simon Peyton Jones committed
433
434
435
436
437
438
439
440
441
442
443
  This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
  if for no other reason that we don't need to instantiate the (~) at an
  unboxed type.

* We treat a case expression with empty alternatives as trivial iff
  its scrutinee is (see CoreUtils.exprIsTrivial).  This is actually
  important; see Note [Empty case is trivial] in CoreUtils

* An empty case is replaced by its scrutinee during the CoreToStg
  conversion; remember STG is un-typed, so there is no need for
  the empty case to do the type conversion.
444
445


Austin Seipp's avatar
Austin Seipp committed
446
447
************************************************************************
*                                                                      *
Simon Peyton Jones's avatar
Simon Peyton Jones committed
448
              Ticks
Austin Seipp's avatar
Austin Seipp committed
449
450
451
*                                                                      *
************************************************************************
-}
Simon Peyton Jones's avatar
Simon Peyton Jones committed
452

453
-- | Allows attaching extra information to points in expressions
454
455

-- If you edit this type, you may need to update the GHC formalism
456
-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
457
458
459
460
461
462
463
464
465
466
data Tickish id =
    -- | An @{-# SCC #-}@ profiling annotation, either automatically
    -- added by the desugarer as a result of -auto-all, or added by
    -- the user.
    ProfNote {
      profNoteCC    :: CostCentre, -- ^ the cost centre
      profNoteCount :: !Bool,      -- ^ bump the entry count?
      profNoteScope :: !Bool       -- ^ scopes over the enclosed expression
                                   -- (i.e. not just a tick)
    }
467

468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
  -- | A "tick" used by HPC to track the execution of each
  -- subexpression in the original source code.
  | HpcTick {
      tickModule :: Module,
      tickId     :: !Int
    }

  -- | A breakpoint for the GHCi debugger.  This behaves like an HPC
  -- tick, but has a list of free variables which will be available
  -- for inspection in GHCi when the program stops at the breakpoint.
  --
  -- NB. we must take account of these Ids when (a) counting free variables,
  -- and (b) substituting (don't substitute for them)
  | Breakpoint
    { breakpointId     :: !Int
    , breakpointFVs    :: [id]  -- ^ the order of this list is important:
                                -- it matches the order of the lists in the
                                -- appropriate entry in HscTypes.ModBreaks.
                                --
                                -- Careful about substitution!  See
                                -- Note [substTickish] in CoreSubst.
    }

Peter Wortmann's avatar
Peter Wortmann committed
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
  -- | A source note.
  --
  -- Source notes are pure annotations: Their presence should neither
  -- influence compilation nor execution. The semantics are given by
  -- causality: The presence of a source note means that a local
  -- change in the referenced source code span will possibly provoke
  -- the generated code to change. On the flip-side, the functionality
  -- of annotated code *must* be invariant against changes to all
  -- source code *except* the spans referenced in the source notes
  -- (see "Causality of optimized Haskell" paper for details).
  --
  -- Therefore extending the scope of any given source note is always
  -- valid. Note that it is still undesirable though, as this reduces
  -- their usefulness for debugging and profiling. Therefore we will
  -- generally try only to make use of this property where it is
  -- neccessary to enable optimizations.
  | SourceNote
    { sourceSpan :: RealSrcSpan -- ^ Source covered
    , sourceName :: String      -- ^ Name for source location
                                --   (uses same names as CCs)
    }

513
  deriving (Eq, Ord, Data)
514

Simon Marlow's avatar
Simon Marlow committed
515
516
517
518
-- | A "counting tick" (where tickishCounts is True) is one that
-- counts evaluations in some way.  We cannot discard a counting tick,
-- and the compiler should preserve the number of counting ticks as
-- far as possible.
519
--
Gabor Greif's avatar
Gabor Greif committed
520
-- However, we still allow the simplifier to increase or decrease
521
522
523
524
525
526
-- sharing, so in practice the actual number of ticks may vary, except
-- that we never change the value from zero to non-zero or vice versa.
tickishCounts :: Tickish id -> Bool
tickishCounts n@ProfNote{} = profNoteCount n
tickishCounts HpcTick{}    = True
tickishCounts Breakpoint{} = True
Peter Wortmann's avatar
Peter Wortmann committed
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
tickishCounts _            = False


-- | Specifies the scoping behaviour of ticks. This governs the
-- behaviour of ticks that care about the covered code and the cost
-- associated with it. Important for ticks relating to profiling.
data TickishScoping =
    -- | No scoping: The tick does not care about what code it
    -- covers. Transformations can freely move code inside as well as
    -- outside without any additional annotation obligations
    NoScope

    -- | Soft scoping: We want all code that is covered to stay
    -- covered.  Note that this scope type does not forbid
    -- transformations from happening, as as long as all results of
    -- the transformations are still covered by this tick or a copy of
    -- it. For example
    --
    --   let x = tick<...> (let y = foo in bar) in baz
    --     ===>
    --   let x = tick<...> bar; y = tick<...> foo in baz
    --
    -- Is a valid transformation as far as "bar" and "foo" is
    -- concerned, because both still are scoped over by the tick.
    --
    -- Note though that one might object to the "let" not being
    -- covered by the tick any more. However, we are generally lax
    -- with this - constant costs don't matter too much, and given
    -- that the "let" was effectively merged we can view it as having
    -- lost its identity anyway.
    --
    -- Also note that this scoping behaviour allows floating a tick
    -- "upwards" in pretty much any situation. For example:
    --
    --   case foo of x -> tick<...> bar
    --     ==>
    --   tick<...> case foo of x -> bar
    --
    -- While this is always leagl, we want to make a best effort to
    -- only make us of this where it exposes transformation
    -- opportunities.
  | SoftScope

    -- | Cost centre scoping: We don't want any costs to move to other
    -- cost-centre stacks. This means we not only want no code or cost
    -- to get moved out of their cost centres, but we also object to
    -- code getting associated with new cost-centre ticks - or
    -- changing the order in which they get applied.
    --
    -- A rule of thumb is that we don't want any code to gain new
    -- annotations. However, there are notable exceptions, for
    -- example:
    --
    --   let f = \y -> foo in tick<...> ... (f x) ...
    --     ==>
    --   tick<...> ... foo[x/y] ...
    --
    -- In-lining lambdas like this is always legal, because inlining a
    -- function does not change the cost-centre stack when the
    -- function is called.
  | CostCentreScope

  deriving (Eq)

-- | Returns the intended scoping rule for a Tickish
tickishScoped :: Tickish id -> TickishScoping
tickishScoped n@ProfNote{}
  | profNoteScope n        = CostCentreScope
  | otherwise              = NoScope
tickishScoped HpcTick{}    = NoScope
tickishScoped Breakpoint{} = CostCentreScope
598
599
600
   -- Breakpoints are scoped: eventually we're going to do call
   -- stacks, but also this helps prevent the simplifier from moving
   -- breakpoints around and changing their result type (see #1531).
Peter Wortmann's avatar
Peter Wortmann committed
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
tickishScoped SourceNote{} = SoftScope

-- | Returns whether the tick scoping rule is at least as permissive
-- as the given scoping rule.
tickishScopesLike :: Tickish id -> TickishScoping -> Bool
tickishScopesLike t scope = tickishScoped t `like` scope
  where NoScope         `like` _               = True
        _               `like` NoScope         = False
        SoftScope       `like` _               = True
        _               `like` SoftScope       = False
        CostCentreScope `like` _               = True

-- | Returns @True@ for ticks that can be floated upwards easily even
-- where it might change execution counts, such as:
--
--   Just (tick<...> foo)
--     ==>
--   tick<...> (Just foo)
--
-- This is a combination of @tickishSoftScope@ and
-- @tickishCounts@. Note that in principle splittable ticks can become
-- floatable using @mkNoTick@ -- even though there's currently no
-- tickish for which that is the case.
tickishFloatable :: Tickish id -> Bool
tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)

-- | Returns @True@ for a tick that is both counting /and/ scoping and
-- can be split into its (tick, scope) parts using 'mkNoScope' and
-- 'mkNoTick' respectively.
tickishCanSplit :: Tickish id -> Bool
tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}
                   = True
tickishCanSplit _  = False
634

Simon Marlow's avatar
Simon Marlow committed
635
mkNoCount :: Tickish id -> Tickish id
Peter Wortmann's avatar
Peter Wortmann committed
636
637
638
639
mkNoCount n | not (tickishCounts n)   = n
            | not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"
mkNoCount n@ProfNote{}                = n {profNoteCount = False}
mkNoCount _                           = panic "mkNoCount: Undefined split!"
640
641

mkNoScope :: Tickish id -> Tickish id
Peter Wortmann's avatar
Peter Wortmann committed
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
mkNoScope n | tickishScoped n == NoScope  = n
            | not (tickishCanSplit n)     = panic "mkNoScope: Cannot split!"
mkNoScope n@ProfNote{}                    = n {profNoteScope = False}
mkNoScope _                               = panic "mkNoScope: Undefined split!"

-- | Return @True@ if this source annotation compiles to some backend
-- code. Without this flag, the tickish is seen as a simple annotation
-- that does not have any associated evaluation code.
--
-- What this means that we are allowed to disregard the tick if doing
-- so means that we can skip generating any code in the first place. A
-- typical example is top-level bindings:
--
--   foo = tick<...> \y -> ...
--     ==>
--   foo = \y -> tick<...> ...
--
-- Here there is just no operational difference between the first and
-- the second version. Therefore code generation should simply
-- translate the code as if it found the latter.
662
tickishIsCode :: Tickish id -> Bool
Peter Wortmann's avatar
Peter Wortmann committed
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
tickishIsCode SourceNote{} = False
tickishIsCode _tickish     = True  -- all the rest for now


-- | Governs the kind of expression that the tick gets placed on when
-- annotating for example using @mkTick@. If we find that we want to
-- put a tickish on an expression ruled out here, we try to float it
-- inwards until we find a suitable expression.
data TickishPlacement =

    -- | Place ticks exactly on run-time expressions. We can still
    -- move the tick through pure compile-time constructs such as
    -- other ticks, casts or type lambdas. This is the most
    -- restrictive placement rule for ticks, as all tickishs have in
    -- common that they want to track runtime processes. The only
    -- legal placement rule for counting ticks.
    PlaceRuntime

    -- | As @PlaceRuntime@, but we float the tick through all
    -- lambdas. This makes sense where there is little difference
    -- between annotating the lambda and annotating the lambda's code.
  | PlaceNonLam

    -- | In addition to floating through lambdas, cost-centre style
    -- tickishs can also be moved from constructors, non-function
    -- variables and literals. For example:
    --
    --   let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
    --
    -- Neither the constructor application, the variable or the
    -- literal are likely to have any cost worth mentioning. And even
    -- if y names a thunk, the call would not care about the
    -- evaluation context. Therefore removing all annotations in the
    -- above example is safe.
  | PlaceCostCentre

  deriving (Eq)

-- | Placement behaviour we want for the ticks
tickishPlace :: Tickish id -> TickishPlacement
tickishPlace n@ProfNote{}
  | profNoteCount n        = PlaceRuntime
  | otherwise              = PlaceCostCentre
tickishPlace HpcTick{}     = PlaceRuntime
tickishPlace Breakpoint{}  = PlaceRuntime
tickishPlace SourceNote{}  = PlaceNonLam

-- | Returns whether one tick "contains" the other one, therefore
-- making the second tick redundant.
tickishContains :: Eq b => Tickish b -> Tickish b -> Bool
tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)
  = n1 == n2 && containsSpan sp1 sp2
tickishContains t1 t2
  = t1 == t2
717

718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
{-
************************************************************************
*                                                                      *
                Orphans
*                                                                      *
************************************************************************
-}

-- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'
-- witnessing the instance's non-orphanhood.
-- See Note [Orphans]
data IsOrphan
  = IsOrphan
  | NotOrphan OccName -- The OccName 'n' witnesses the instance's non-orphanhood
                      -- In that case, the instance is fingerprinted as part
                      -- of the definition of 'n's definition
734
    deriving Data
735
736
737
738
739
740
741
742
743
744
745

-- | Returns true if 'IsOrphan' is orphan.
isOrphan :: IsOrphan -> Bool
isOrphan IsOrphan = True
isOrphan _ = False

-- | Returns true if 'IsOrphan' is not an orphan.
notOrphan :: IsOrphan -> Bool
notOrphan NotOrphan{} = True
notOrphan _ = False

746
chooseOrphanAnchor :: NameSet -> IsOrphan
747
748
749
750
751
752
753
754
755
-- Something (rule, instance) is relate to all the Names in this
-- list. Choose one of them to be an "anchor" for the orphan.  We make
-- the choice deterministic to avoid gratuitious changes in the ABI
-- hash (Trac #4012).  Specficially, use lexicographic comparison of
-- OccName rather than comparing Uniques
--
-- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically
--
chooseOrphanAnchor local_names
756
757
  | isEmptyNameSet local_names = IsOrphan
  | otherwise                  = NotOrphan (minimum occs)
758
  where
759
760
    occs = map nameOccName $ nonDetEltsUFM local_names
    -- It's OK to use nonDetEltsUFM here, see comments above
761

762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
instance Binary IsOrphan where
    put_ bh IsOrphan = putByte bh 0
    put_ bh (NotOrphan n) = do
        putByte bh 1
        put_ bh n
    get bh = do
        h <- getByte bh
        case h of
            0 -> return IsOrphan
            _ -> do
                n <- get bh
                return $ NotOrphan n

{-
Note [Orphans]
~~~~~~~~~~~~~~
Class instances, rules, and family instances are divided into orphans
and non-orphans.  Roughly speaking, an instance/rule is an orphan if
its left hand side mentions nothing defined in this module.  Orphan-hood
has two major consequences

 * A module that contains orphans is called an "orphan module".  If
   the module being compiled depends (transitively) on an oprhan
   module M, then M.hi is read in regardless of whether M is oherwise
   needed. This is to ensure that we don't miss any instance decls in
   M.  But it's painful, because it means we need to keep track of all
   the orphan modules below us.

 * A non-orphan is not finger-printed separately.  Instead, for
   fingerprinting purposes it is treated as part of the entity it
   mentions on the LHS.  For example
      data T = T1 | T2
      instance Eq T where ....
   The instance (Eq T) is incorprated as part of T's fingerprint.

   In constrast, orphans are all fingerprinted together in the
   mi_orph_hash field of the ModIface.

   See MkIface.addFingerprints.

Orphan-hood is computed
  * For class instances:
      when we make a ClsInst
    (because it is needed during instance lookup)

  * For rules and family instances:
       when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)
                     or IfaceFamInst (MkIface.instanceToIfaceInst)
-}

Austin Seipp's avatar
Austin Seipp committed
812
813
814
{-
************************************************************************
*                                                                      *
815
\subsection{Transformation rules}
Austin Seipp's avatar
Austin Seipp committed
816
817
*                                                                      *
************************************************************************
818
819
820

The CoreRule type and its friends are dealt with mainly in CoreRules,
but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
Austin Seipp's avatar
Austin Seipp committed
821
-}
822

823
824
-- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules
type RuleBase = NameEnv [CoreRule]
Gabor Greif's avatar
Gabor Greif committed
825
        -- The rules are unordered;
826
827
        -- we sort out any overlaps on lookup

828
829
830
831
832
833
834
835
836
837
838
839
840
841
-- | A full rule environment which we can apply rules from.  Like a 'RuleBase',
-- but it also includes the set of visible orphans we use to filter out orphan
-- rules which are not visible (even though we can see them...)
data RuleEnv
    = RuleEnv { re_base          :: RuleBase
              , re_visible_orphs :: ModuleSet
              }

mkRuleEnv :: RuleBase -> [Module] -> RuleEnv
mkRuleEnv rules vis_orphs = RuleEnv rules (mkModuleSet vis_orphs)

emptyRuleEnv :: RuleEnv
emptyRuleEnv = RuleEnv emptyNameEnv emptyModuleSet

842
843
844
845
846
847
848
-- | A 'CoreRule' is:
--
-- * \"Local\" if the function it is a rule for is defined in the
--   same module as the rule itself.
--
-- * \"Orphan\" if nothing on the LHS is defined in the same module
--   as the rule itself
849
data CoreRule
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
  = Rule {
        ru_name :: RuleName,            -- ^ Name of the rule, for communication with the user
        ru_act  :: Activation,          -- ^ When the rule is active

        -- Rough-matching stuff
        -- see comments with InstEnv.ClsInst( is_cls, is_rough )
        ru_fn    :: Name,               -- ^ Name of the 'Id.Id' at the head of this rule
        ru_rough :: [Maybe Name],       -- ^ Name at the head of each argument to the left hand side

        -- Proper-matching stuff
        -- see comments with InstEnv.ClsInst( is_tvs, is_tys )
        ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over
        ru_args  :: [CoreExpr],         -- ^ Left hand side arguments

        -- And the right-hand side
        ru_rhs   :: CoreExpr,           -- ^ Right hand side of the rule
                                        -- Occurrence info is guaranteed correct
                                        -- See Note [OccInfo in unfoldings and rules]

        -- Locality
Simon Peyton Jones's avatar
Simon Peyton Jones committed
870
871
872
873
874
        ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated
                           --               (notably by Specialise or SpecConstr)
                           --   @False@ <=> generated at the users behest
                           -- See Note [Trimming auto-rules] in TidyPgm
                           -- for the sole purpose of this field.
875

Simon Peyton Jones's avatar
Simon Peyton Jones committed
876
        ru_origin :: !Module,   -- ^ 'Module' the rule was defined in, used
877
878
                                -- to test if we should see an orphan rule.

Simon Peyton Jones's avatar
Simon Peyton Jones committed
879
        ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan.
880

881
882
883
        ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is
                                -- defined in the same module as the rule
                                -- and is not an implicit 'Id' (like a record selector,
884
885
886
887
888
                                -- class operation, or data constructor).  This
                                -- is different from 'ru_orphan', where a rule
                                -- can avoid being an orphan if *any* Name in
                                -- LHS of the rule was defined in the same
                                -- module as the rule.
889
    }
890

891
892
  -- | Built-in rules are used for constant folding
  -- and suchlike.  They have no free variables.
893
894
  -- A built-in rule is always visible (there is no such thing as
  -- an orphan built-in rule.)
895
896
897
898
899
900
901
902
903
  | BuiltinRule {
        ru_name  :: RuleName,   -- ^ As above
        ru_fn    :: Name,       -- ^ As above
        ru_nargs :: Int,        -- ^ Number of arguments that 'ru_try' consumes,
                                -- if it fires, including type arguments
        ru_try   :: RuleFun
                -- ^ This function does the rewrite.  It given too many
                -- arguments, it simply discards them; the returned 'CoreExpr'
                -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
904
    }
905
                -- See Note [Extra args in rule matching] in Rules.hs
906

907
908
909
type RuleFun = DynFlags -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
type InScopeEnv = (InScopeSet, IdUnfoldingFun)

910
911
912
913
914
type IdUnfoldingFun = Id -> Unfolding
-- A function that embodies how to unfold an Id if you need
-- to do that in the Rule.  The reason we need to pass this info in
-- is that whether an Id is unfoldable depends on the simplifier phase

twanvl's avatar
twanvl committed
915
isBuiltinRule :: CoreRule -> Bool
916
isBuiltinRule (BuiltinRule {}) = True
917
isBuiltinRule _                = False
918

919
920
921
922
isAutoRule :: CoreRule -> Bool
isAutoRule (BuiltinRule {}) = False
isAutoRule (Rule { ru_auto = is_auto }) = is_auto

923
-- | The number of arguments the 'ru_fn' must be applied
924
-- to before the rule can match on it
925
926
927
928
ruleArity :: CoreRule -> Int
ruleArity (BuiltinRule {ru_nargs = n}) = n
ruleArity (Rule {ru_args = args})      = length args

929
930
ruleName :: CoreRule -> RuleName
ruleName = ru_name
931

932
933
934
ruleActivation :: CoreRule -> Activation
ruleActivation (BuiltinRule { })       = AlwaysActive
ruleActivation (Rule { ru_act = act }) = act
935
936

-- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
937
938
ruleIdName :: CoreRule -> Name
ruleIdName = ru_fn
939

940
941
isLocalRule :: CoreRule -> Bool
isLocalRule = ru_local
942

943
-- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
944
945
setRuleIdName :: Name -> CoreRule -> CoreRule
setRuleIdName nm ru = ru { ru_fn = nm }
946

Austin Seipp's avatar
Austin Seipp committed
947
948
949
{-
************************************************************************
*                                                                      *
950
\subsection{Vectorisation declarations}
Austin Seipp's avatar
Austin Seipp committed
951
952
*                                                                      *
************************************************************************
953
954
955

Representation of desugared vectorisation declarations that are fed to the vectoriser (via
'ModGuts').
Austin Seipp's avatar
Austin Seipp committed
956
-}
957

958
data CoreVect = Vect      Id   CoreExpr
959
960
961
              | NoVect    Id
              | VectType  Bool TyCon (Maybe TyCon)
              | VectClass TyCon                     -- class tycon
962
              | VectInst  Id                        -- instance dfun (always SCALAR)  !!!FIXME: should be superfluous now
963

Austin Seipp's avatar
Austin Seipp committed
964
965
966
{-
************************************************************************
*                                                                      *
967
                Unfoldings
Austin Seipp's avatar
Austin Seipp committed
968
969
*                                                                      *
************************************************************************
970

971
The @Unfolding@ type is declared here to avoid numerous loops
Austin Seipp's avatar
Austin Seipp committed
972
-}
973

974
975
976
-- | Records the /unfolding/ of an identifier, which is approximately the form the
-- identifier would have if we substituted its definition in for the identifier.
-- This type should be treated as abstract everywhere except in "CoreUnfold"
977
data Unfolding
978
979
980
  = NoUnfolding        -- ^ We have no information about the unfolding

  | OtherCon [AltCon]  -- ^ It ain't one of these constructors.
981
982
983
984
985
986
987
988
989
990
991
992
993
                       -- @OtherCon xs@ also indicates that something has been evaluated
                       -- and hence there's no point in re-evaluating it.
                       -- @OtherCon []@ is used even for non-data-type values
                       -- to indicated evaluated-ness.  Notably:
                       --
                       -- > data C = C !(Int -> Int)
                       -- > case x of { C f -> ... }
                       --
                       -- Here, @f@ gets an @OtherCon []@ unfolding.

  | DFunUnfolding {     -- The Unfolding of a DFunId
                        -- See Note [DFun unfoldings]
                        --     df = /\a1..am. \d1..dn. MkD t1 .. tk
994
                        --                                 (op1 a1..am d1..dn)
995
                        --                                 (op2 a1..am d1..dn)
996
997
998
999
        df_bndrs :: [Var],      -- The bound variables [a1..m],[d1..dn]
        df_con   :: DataCon,    -- The dictionary data constructor (never a newtype datacon)
        df_args  :: [CoreExpr]  -- Args of the data con: types, superclasses and methods,
    }                           -- in positional order
1000

1001
  | CoreUnfolding {             -- An unfolding for an Id with no pragma,
1002
                                -- or perhaps a NOINLINE pragma
1003
                                -- (For NOINLINE, the phase, if any, is in the
1004
                                -- InlinePragInfo for this Id.)
1005
1006
1007
1008
1009
        uf_tmpl       :: CoreExpr,        -- Template; occurrence info is correct
        uf_src        :: UnfoldingSource, -- Where the unfolding came from
        uf_is_top     :: Bool,          -- True <=> top level binding
        uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard
                                        --      a `seq` on this variable
1010
        uf_is_conlike :: Bool,          -- True <=> applicn of constructor or CONLIKE function
1011
                                        --      Cached version of exprIsConLike
1012
        uf_is_work_free :: Bool,                -- True <=> doesn't waste (much) work to expand
1013
                                        --          inside an inlining
1014
1015
1016
1017
                                        --      Cached version of exprIsCheap
        uf_expandable :: Bool,          -- True <=> can expand in RULE matching
                                        --      Cached version of exprIsExpandable
        uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.
1018
    }
1019
1020
  -- ^ An unfolding with redundant cached information. Parameters:
  --
1021
1022
1023
  --  uf_tmpl: Template used to perform unfolding;
  --           NB: Occurrence info is guaranteed correct:
  --               see Note [OccInfo in unfoldings and rules]
1024
  --
1025
  --  uf_is_top: Is this a top level binding?
1026
  --
1027
  --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
1028
1029
  --     this variable
  --
1030
1031
  --  uf_is_work_free:  Does this waste only a little work if we expand it inside an inlining?
  --     Basically this is a cached version of 'exprIsWorkFree'
1032
  --
1033
  --  uf_guidance:  Tells us about the /size/ of the unfolding template
1034

1035

1036
1037
------------------------------------------------
data UnfoldingSource
1038
  = -- See also Note [Historical note: unfoldings for wrappers]
1039

1040
    InlineRhs          -- The current rhs of the function
1041
                       -- Replace uf_tmpl each time around
1042

1043
  | InlineStable       -- From an INLINE or INLINABLE pragma
1044
                       --   INLINE     if guidance is UnfWhen
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
1045
                       --   INLINABLE  if guidance is UnfIfGoodArgs/UnfoldNever
1046
1047
1048
1049
1050
1051
1052
                       -- (well, technically an INLINABLE might be made
                       -- UnfWhen if it was small enough, and then
                       -- it will behave like INLINE outside the current
                       -- module, but that is the way automatic unfoldings
                       -- work so it is consistent with the intended
                       -- meaning of INLINABLE).
                       --
1053
                       -- uf_tmpl may change, but only as a result of
1054
1055
1056
1057
                       -- gentle simplification, it doesn't get updated
                       -- to the current RHS during compilation as with
                       -- InlineRhs.
                       --
1058
                       -- See Note [InlineRules]
1059
1060

  | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
1061
                       -- Only a few primop-like things have this property
1062
                       -- (see MkId.hs, calls to mkCompulsoryUnfolding).
1063
1064
1065
1066
                       -- Inline absolutely always, however boring the context.



1067
-- | 'UnfoldingGuidance' says when unfolding should take place
1068
data UnfoldingGuidance
1069
1070
1071
  = UnfWhen {   -- Inline without thinking about the *size* of the uf_tmpl
                -- Used (a) for small *and* cheap unfoldings
                --      (b) for INLINE functions
1072
                -- See Note [INLINE for small functions] in CoreUnfold
1073
      ug_arity    :: Arity,             -- Number of value arguments expected
Simon Peyton Jones's avatar
Simon Peyton Jones committed
1074

1075
      ug_unsat_ok  :: Bool,     -- True <=> ok to inline even if unsaturated
1076
      ug_boring_ok :: Bool      -- True <=> ok to inline even if the context is boring
1077
                -- So True,True means "always"
1078
    }
1079

1080
1081
  | UnfIfGoodArgs {     -- Arose from a normal Id; the info here is the
                        -- result of a simple analysis of the RHS
1082
1083

      ug_args ::  [Int],  -- Discount if the argument is evaluated.
1084
1085
                          -- (i.e., a simplification will definitely
                          -- be possible).  One elt of the list per *value* arg.
1086

1087
      ug_size :: Int,     -- The "size" of the unfolding.
1088

1089
1090
1091
      ug_res :: Int       -- Scrutinee discount: the discount to substract if the thing is in
    }                     -- a context (case (thing args) of ...),
                          -- (where there are the right number of arguments.)
1092

1093
  | UnfNever        -- The RHS is big, so don't inline it
Peter Wortmann's avatar
Peter Wortmann committed
1094
  deriving (Eq)
1095

Austin Seipp's avatar
Austin Seipp committed
1096
{-
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
Note [Historical note: unfoldings for wrappers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used to have a nice clever scheme in interface files for
wrappers. A wrapper's unfolding can be reconstructed from its worker's
id and its strictness. This decreased .hi file size (sometimes
significantly, for modules like GHC.Classes with many high-arity w/w
splits) and had a slight corresponding effect on compile times.

However, when we added the second demand analysis, this scheme lead to
some Core lint errors. The second analysis could change the strictness
signatures, which sometimes resulted in a wrapper's regenerated
unfolding applying the wrapper to too many arguments.

Instead of repairing the clever .hi scheme, we abandoned it in favor
of simplicity. The .hi sizes are usually insignificant (excluding the
+1M for base libraries), and compile time barely increases (~+1% for
nofib). The nicer upshot is that the UnfoldingSource no longer mentions
an Id, so, eg, substitutions need not traverse them.

1116
1117
1118
1119

Note [DFun unfoldings]
~~~~~~~~~~~~~~~~~~~~~~
The Arity in a DFunUnfolding is total number of args (type and value)
1120
that the DFun needs to produce a dictionary.  That's not necessarily
1121
1122
related to the ordinary arity of the dfun Id, esp if the class has
one method, so the dictionary is represented by a newtype.  Example
1123

1124
1125
1126
1127
1128
1129
1130
     class C a where { op :: a -> Int }
     instance C a -> C [a] where op xs = op (head xs)

The instance translates to

     $dfCList :: forall a. C a => C [a]  -- Arity 2!
     $dfCList = /\a.\d. $copList {a} d |> co
1131

1132
1133
1134
1135
1136
1137
     $copList :: forall a. C a => [a] -> Int  -- Arity 2!
     $copList = /\a.\d.\xs. op {a} d (head xs)

Now we might encounter (op (dfCList {ty} d) a1 a2)
and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
has all its arguments, even though its (value) arity is 2.  That's
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
1138
why we record the number of expected arguments in the DFunUnfolding.
1139

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
1140
1141
1142
Note that although it's an Arity, it's most convenient for it to give
the *total* number of arguments, both type and value.  See the use
site in exprIsConApp_maybe.
Austin Seipp's avatar
Austin Seipp committed
1143
-}
1144

1145
1146
1147
1148
-- Constants for the UnfWhen constructor
needSaturated, unSaturatedOk :: Bool
needSaturated = False
unSaturatedOk = True
1149

1150
1151
1152
boringCxtNotOk, boringCxtOk :: Bool
boringCxtOk    = True
boringCxtNotOk = False
1153
1154

------------------------------------------------
1155
1156
1157
1158
1159
noUnfolding :: Unfolding
-- ^ There is no known 'Unfolding'
evaldUnfolding :: Unfolding
-- ^ This unfolding marks the associated thing as being evaluated

1160
1161
1162
noUnfolding    = NoUnfolding
evaldUnfolding = OtherCon []

twanvl's avatar
twanvl committed
1163
mkOtherCon :: [AltCon] -> Unfolding
1164
mkOtherCon = OtherCon
1165

1166
1167
1168
1169
1170
isStableSource :: UnfoldingSource -> Bool
-- Keep the unfolding template
isStableSource InlineCompulsory   = True
isStableSource InlineStable       = True
isStableSource InlineRhs          = False
1171

1172
-- | Retrieves the template of an unfolding: panics if none is known
1173
unfoldingTemplate :: Unfolding -> CoreExpr
1174
1175
unfoldingTemplate = uf_tmpl

1176
-- | Retrieves the template of an unfolding if possible
1177
1178
1179
-- maybeUnfoldingTemplate is used mainly wnen specialising, and we do
-- want to specialise DFuns, so it's important to return a template
-- for DFunUnfoldings
1180
maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
1181
1182
1183
1184
1185
1186
maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })
  = Just expr
maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })
  = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args))
maybeUnfoldingTemplate _
  = Nothing
1187

1188
-- | The constructors that the unfolding could never be:
1189
-- returns @[]@ if no information is available
1190
1191
otherCons :: Unfolding -> [AltCon]
otherCons (OtherCon cons) = cons
twanvl's avatar
twanvl committed
1192
otherCons _               = []
1193

1194
1195
-- | Determines if it is certainly the case that the unfolding will
-- yield a value (something in HNF): returns @False@ if unsure
1196
isValueUnfolding :: Unfolding -> Bool
1197
        -- Returns False for OtherCon
1198
1199
isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
isValueUnfolding _                                          = False
1200

1201
1202
1203
-- | Determines if it possibly the case that the unfolding will
-- yield a value. Unlike 'isValueUnfolding' it returns @True@
-- for 'OtherCon'
1204
isEvaldUnfolding :: Unfolding -> Bool
1205
1206
        -- Returns True for OtherCon
isEvaldUnfolding (OtherCon _)                               = True
1207
1208
isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
isEvaldUnfolding _                                          = False
1209

1210
1211
1212
1213
1214
1215
1216
-- | @True@ if the unfolding is a constructor application, the application
-- of a CONLIKE function or 'OtherCon'
isConLikeUnfolding :: Unfolding -> Bool
isConLikeUnfolding (OtherCon _)                             = True
isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
isConLikeUnfolding _                                        = False

1217
-- | Is the thing we will unfold into certainly cheap?
1218
isCheapUnfolding :: Unfolding -> Bool
1219
1220
isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf
isCheapUnfolding _                                           = False
1221
1222

isExpandableUnfolding :: Unfolding -> Bool
1223
1224
1225
isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
isExpandableUnfolding _                                              = False

1226
expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
1227
-- Expand an expandable unfolding; this is used in rule matching
1228
--   See Note [Expanding variables] in Rules.hs
1229
1230
1231
1232
-- The key point here is that CONLIKE things can be expanded
expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
expandUnfolding_maybe _                                                       = Nothing

1233
1234
1235
hasStableCoreUnfolding_maybe :: Unfolding -> Maybe Bool
-- Just True  <=> has stable inlining, very keen to inline (eg. INLINE pragma)
-- Just False <=> has stable inlining, open to inlining it (eg. INLINEABLE pragma)
Gabor Greif's avatar
Gabor Greif committed
1236
-- Nothing    <=> not stable, or cannot inline it anyway
1237
1238
1239
1240
1241
1242
1243
hasStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
   | isStableSource src
   = case guide of
       UnfWhen {}       -> Just True
       UnfIfGoodArgs {} -> Just False
       UnfNever         -> Nothing
hasStableCoreUnfolding_maybe _ = Nothing
1244
1245
1246
1247

isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
isCompulsoryUnfolding _                                             = False
1248

1249
isStableUnfolding :: Unfolding -> Bool
1250
-- True of unfoldings that should not be overwritten
1251
-- by a CoreUnfolding for the RHS of a let-binding
1252
isStableUnfolding (CoreUnfolding {