DataCon.hs 47.7 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, 1998

5
\section[DataCon]{@DataCon@: Data Constructors}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP, DeriveDataTypeable #-}
Ian Lynagh's avatar
Ian Lynagh committed
9

10
module DataCon (
batterseapower's avatar
batterseapower committed
11
        -- * Main data types
Simon Peyton Jones's avatar
Simon Peyton Jones committed
12
        DataCon, DataConRep(..),
13
14
        SrcStrictness(..), SrcUnpackedness(..),
        HsSrcBang(..), HsImplBang(..),
Simon Peyton Jones's avatar
Simon Peyton Jones committed
15
        StrictnessMark(..),
Edward Z. Yang's avatar
Edward Z. Yang committed
16
17
        ConTag,

18
19
20
21
22
        -- ** Equality specs
        EqSpec, mkEqSpec, eqSpecTyVar, eqSpecType,
        eqSpecPair, eqSpecPreds,
        substEqSpec,

Adam Gundry's avatar
Adam Gundry committed
23
24
25
        -- ** Field labels
        FieldLbl(..), FieldLabel, FieldLabelString,

Edward Z. Yang's avatar
Edward Z. Yang committed
26
        -- ** Type construction
27
        mkDataCon, buildAlgTyCon, fIRST_TAG,
Edward Z. Yang's avatar
Edward Z. Yang committed
28
29

        -- ** Type deconstruction
Simon Peyton Jones's avatar
Simon Peyton Jones committed
30
        dataConRepType, dataConSig, dataConInstSig, dataConFullSig,
Edward Z. Yang's avatar
Edward Z. Yang committed
31
        dataConName, dataConIdentity, dataConTag, dataConTyCon,
32
        dataConOrigTyCon, dataConUserType,
Edward Z. Yang's avatar
Edward Z. Yang committed
33
        dataConUnivTyVars, dataConExTyVars, dataConAllTyVars,
34
        dataConEqSpec, dataConTheta,
Edward Z. Yang's avatar
Edward Z. Yang committed
35
36
37
38
        dataConStupidTheta,
        dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
        dataConInstOrigArgTys, dataConRepArgTys,
        dataConFieldLabels, dataConFieldType,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
39
        dataConSrcBangs,
Edward Z. Yang's avatar
Edward Z. Yang committed
40
41
        dataConSourceArity, dataConRepArity, dataConRepRepArity,
        dataConIsInfix,
42
43
        dataConWorkId, dataConWrapId, dataConWrapId_maybe,
        dataConImplicitTyThings,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
44
        dataConRepStrictness, dataConImplBangs, dataConBoxer,
Edward Z. Yang's avatar
Edward Z. Yang committed
45
46

        splitDataProductType_maybe,
47

Edward Z. Yang's avatar
Edward Z. Yang committed
48
49
50
        -- ** Predicates on DataCons
        isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon,
        isVanillaDataCon, classDataCon, dataConCannotMatch,
51
        isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
52
        specialPromotedDc, isLegacyPromotableDataCon, isLegacyPromotableTyCon,
53

54
        -- ** Promotion related functions
55
        promoteDataCon
56
57
58
59
    ) where

#include "HsVersions.h"

60
import {-# SOURCE #-} MkId( DataConBoxer )
Simon Marlow's avatar
Simon Marlow committed
61
import Type
62
import ForeignCall ( CType )
63
import Coercion
64
import Unify
Simon Marlow's avatar
Simon Marlow committed
65
import TyCon
Adam Gundry's avatar
Adam Gundry committed
66
import FieldLabel
Simon Marlow's avatar
Simon Marlow committed
67
68
import Class
import Name
69
70
import PrelNames
import NameEnv
Simon Marlow's avatar
Simon Marlow committed
71
import Var
72
import Outputable
Simon Marlow's avatar
Simon Marlow committed
73
74
import ListSetOps
import Util
batterseapower's avatar
batterseapower committed
75
import BasicTypes
76
import FastString
77
import Module
78
import Binary
79

80
import qualified Data.Data as Data
81
import qualified Data.Typeable
82
83
import Data.Char
import Data.Word
Adam Gundry's avatar
Adam Gundry committed
84
import Data.List( mapAccumL, find )
85

Austin Seipp's avatar
Austin Seipp committed
86
{-
87
88
89
Data constructor representation
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the following Haskell data type declaration
90

Edward Z. Yang's avatar
Edward Z. Yang committed
91
        data T = T !Int ![Int]
92
93
94

Using the strictness annotations, GHC will represent this as

Edward Z. Yang's avatar
Edward Z. Yang committed
95
        data T = T Int# [Int]
96
97
98

That is, the Int has been unboxed.  Furthermore, the Haskell source construction

Edward Z. Yang's avatar
Edward Z. Yang committed
99
        T e1 e2
100
101
102

is translated to

Edward Z. Yang's avatar
Edward Z. Yang committed
103
104
105
        case e1 of { I# x ->
        case e2 of { r ->
        T x r }}
106
107
108
109

That is, the first argument is unboxed, and the second is evaluated.  Finally,
pattern matching is translated too:

Edward Z. Yang's avatar
Edward Z. Yang committed
110
        case e of { T a b -> ... }
111
112
113

becomes

Edward Z. Yang's avatar
Edward Z. Yang committed
114
        case e of { T a' b -> let a = I# a' in ... }
115
116
117
118
119
120
121

To keep ourselves sane, we name the different versions of the data constructor
differently, as follows.


Note [Data Constructor Naming]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
122
Each data constructor C has two, and possibly up to four, Names associated with it:
123

Edward Z. Yang's avatar
Edward Z. Yang committed
124
                   OccName   Name space   Name of   Notes
125
 ---------------------------------------------------------------------------
Edward Z. Yang's avatar
Edward Z. Yang committed
126
127
128
 The "data con itself"   C     DataName   DataCon   In dom( GlobalRdrEnv )
 The "worker data con"   C     VarName    Id        The worker
 The "wrapper data con"  $WC   VarName    Id        The wrapper
129
 The "newtype coercion"  :CoT  TcClsName  TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
130

131
132
133
134
135
EVERY data constructor (incl for newtypes) has the former two (the
data con itself, and its worker.  But only some data constructors have a
wrapper (see Note [The need for a wrapper]).

Each of these three has a distinct Unique.  The "data con itself" name
136
137
138
139
140
141
appears in the output of the renamer, and names the Haskell-source
data constructor.  The type checker translates it into either the wrapper Id
(if it exists) or worker Id (otherwise).

The data con has one or two Ids associated with it:

142
143
The "worker Id", is the actual data constructor.
* Every data constructor (newtype or data type) has a worker
144

145
* The worker is very like a primop, in that it has no binding.
146

147
148
* For a *data* type, the worker *is* the data constructor;
  it has no unfolding
149

Edward Z. Yang's avatar
Edward Z. Yang committed
150
* For a *newtype*, the worker has a compulsory unfolding which
151
  does a cast, e.g.
Edward Z. Yang's avatar
Edward Z. Yang committed
152
153
154
        newtype T = MkT Int
        The worker for MkT has unfolding
                \\(x:Int). x `cast` sym CoT
155
  Here CoT is the type constructor, witnessing the FC axiom
Edward Z. Yang's avatar
Edward Z. Yang committed
156
        axiom CoT : T = Int
157

batterseapower's avatar
batterseapower committed
158
The "wrapper Id", \$WC, goes as follows
159

Edward Z. Yang's avatar
Edward Z. Yang committed
160
* Its type is exactly what it looks like in the source program.
161

Edward Z. Yang's avatar
Edward Z. Yang committed
162
* It is an ordinary function, and it gets a top-level binding
163
164
165
166
  like any other function.

* The wrapper Id isn't generated for a data type if there is
  nothing for the wrapper to do.  That is, if its defn would be
Edward Z. Yang's avatar
Edward Z. Yang committed
167
        \$wC = C
168

169
170
Note [The need for a wrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
171
172
173
Why might the wrapper have anything to do?  Two reasons:

* Unboxing strict fields (with -funbox-strict-fields)
Edward Z. Yang's avatar
Edward Z. Yang committed
174
175
176
177
        data T = MkT !(Int,Int)
        \$wMkT :: (Int,Int) -> T
        \$wMkT (x,y) = MkT x y
  Notice that the worker has two fields where the wapper has
178
  just one.  That is, the worker has type
Edward Z. Yang's avatar
Edward Z. Yang committed
179
                MkT :: Int -> Int -> T
180
181

* Equality constraints for GADTs
Edward Z. Yang's avatar
Edward Z. Yang committed
182
        data T a where { MkT :: a -> T [a] }
183
184
185

  The worker gets a type with explicit equality
  constraints, thus:
Edward Z. Yang's avatar
Edward Z. Yang committed
186
        MkT :: forall a b. (a=[b]) => b -> T a
187
188

  The wrapper has the programmer-specified type:
Edward Z. Yang's avatar
Edward Z. Yang committed
189
190
        \$wMkT :: a -> T [a]
        \$wMkT a x = MkT [a] a [a] x
191
  The third argument is a coercion
Edward Z. Yang's avatar
Edward Z. Yang committed
192
        [a] :: [a]~[a]
193

194
INVARIANT: the dictionary constructor for a class
Edward Z. Yang's avatar
Edward Z. Yang committed
195
           never has a wrapper.
196
197


198
199
200
A note about the stupid context
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Data types can have a context:
Edward Z. Yang's avatar
Edward Z. Yang committed
201
202

        data (Eq a, Ord b) => T a b = T1 a b | T2 a
203
204
205
206

and that makes the constructors have a context too
(notice that T2's context is "thinned"):

Edward Z. Yang's avatar
Edward Z. Yang committed
207
208
        T1 :: (Eq a, Ord b) => a -> b -> T a b
        T2 :: (Eq a) => a -> T a b
209
210
211
212
213

Furthermore, this context pops up when pattern matching
(though GHC hasn't implemented this, but it is in H98, and
I've fixed GHC so that it now does):

Edward Z. Yang's avatar
Edward Z. Yang committed
214
        f (T2 x) = x
215
gets inferred type
Edward Z. Yang's avatar
Edward Z. Yang committed
216
        f :: Eq a => T a b -> a
217
218
219
220
221

I say the context is "stupid" because the dictionaries passed
are immediately discarded -- they do nothing and have no benefit.
It's a flaw in the language.

Edward Z. Yang's avatar
Edward Z. Yang committed
222
223
224
225
226
        Up to now [March 2002] I have put this stupid context into the
        type of the "wrapper" constructors functions, T1 and T2, but
        that turned out to be jolly inconvenient for generics, and
        record update, and other functions that build values of type T
        (because they don't have suitable dictionaries available).
227

Edward Z. Yang's avatar
Edward Z. Yang committed
228
229
230
        So now I've taken the stupid context out.  I simply deal with
        it separately in the type checker on occurrences of a
        constructor, either in an expression or in a pattern.
231

Edward Z. Yang's avatar
Edward Z. Yang committed
232
233
234
235
236
237
        [May 2003: actually I think this decision could evasily be
        reversed now, and probably should be.  Generics could be
        disabled for types with a stupid context; record updates now
        (H98) needs the context too; etc.  It's an unforced change, so
        I'm leaving it for now --- but it does seem odd that the
        wrapper doesn't include the stupid context.]
238

239
240
[July 04] With the advent of generalised data types, it's less obvious
what the "stupid context" is.  Consider
Edward Z. Yang's avatar
Edward Z. Yang committed
241
        C :: forall a. Ord a => a -> a -> T (Foo a)
242
Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
243

Edward Z. Yang's avatar
Edward Z. Yang committed
244
245
246
247
        f :: T b -> Ordering
        f = /\b. \x:T b.
            case x of
                C a (d:Ord a) (p:a) (q:a) -> compare d p q
248

249
Note that (Foo a) might not be an instance of Ord.
250

Austin Seipp's avatar
Austin Seipp committed
251
252
************************************************************************
*                                                                      *
253
\subsection{Data constructors}
Austin Seipp's avatar
Austin Seipp committed
254
255
256
*                                                                      *
************************************************************************
-}
257

batterseapower's avatar
batterseapower committed
258
-- | A data constructor
Alan Zimmerman's avatar
Alan Zimmerman committed
259
260
261
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
--             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma'
262
263

-- For details on above see note [Api annotations] in ApiAnnotation
264
data DataCon
265
  = MkData {
Edward Z. Yang's avatar
Edward Z. Yang committed
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
        dcName    :: Name,      -- This is the name of the *source data con*
                                -- (see "Note [Data Constructor Naming]" above)
        dcUnique :: Unique,     -- Cached from Name
        dcTag    :: ConTag,     -- ^ Tag, used for ordering 'DataCon's

        -- Running example:
        --
        --      *** As declared by the user
        --  data T a where
        --    MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)

        --      *** As represented internally
        --  data T a where
        --    MkT :: forall a. forall x y. (a~(x,y),x~y,Ord x) => x -> y -> T a
        --
        -- The next six fields express the type of the constructor, in pieces
        -- e.g.
        --
        --      dcUnivTyVars  = [a]
        --      dcExTyVars    = [x,y]
        --      dcEqSpec      = [a~(x,y)]
        --      dcOtherTheta  = [x~y, Ord x]
        --      dcOrigArgTys  = [x,y]
        --      dcRepTyCon       = T

        dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor
                                --          Its type is of form
                                --              forall a1..an . t1 -> ... tm -> T a1..an
                                --          No existentials, no coercions, nothing.
                                -- That is: dcExTyVars = dcEqSpec = dcOtherTheta = []
                -- NB 1: newtypes always have a vanilla data con
                -- NB 2: a vanilla constructor can still be declared in GADT-style
                --       syntax, provided its type looks like the above.
                --       The declaration format is held in the TyCon (algTcGadtSyntax)

301
        dcUnivTyVars   :: [TyVar],      -- Universally-quantified type vars [a,b,c]
Edward Z. Yang's avatar
Edward Z. Yang committed
302
303
304
                                        -- INVARIANT: length matches arity of the dcRepTyCon
                                        ---           result type of (rep) data con is exactly (T a b c)

305
        dcExTyVars     :: [TyVar],    -- Existentially-quantified type vars
Edward Z. Yang's avatar
Edward Z. Yang committed
306
307
308
309
310
311
312
313
314
                -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
                -- FOR THE PARENT TyCon. With GADTs the data con might not even have
                -- the same number of type variables.
                -- [This is a change (Oct05): previously, vanilla datacons guaranteed to
                --  have the same type variables as their parent TyCon, but that seems ugly.]

        -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
        -- Reason: less confusing, and easier to generate IfaceSyn

315
316
317
        dcEqSpec :: [EqSpec],   -- Equalities derived from the result type,
                                -- _as written by the programmer_

Edward Z. Yang's avatar
Edward Z. Yang committed
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
                -- This field allows us to move conveniently between the two ways
                -- of representing a GADT constructor's type:
                --      MkT :: forall a b. (a ~ [b]) => b -> T a
                --      MkT :: forall b. b -> T [b]
                -- Each equality is of the form (a ~ ty), where 'a' is one of
                -- the universally quantified type variables

                -- The next two fields give the type context of the data constructor
                --      (aside from the GADT constraints,
                --       which are given by the dcExpSpec)
                -- In GADT form, this is *exactly* what the programmer writes, even if
                -- the context constrains only universally quantified variables
                --      MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
        dcOtherTheta :: ThetaType,  -- The other constraints in the data con's type
                                    -- other than those in the dcEqSpec

        dcStupidTheta :: ThetaType,     -- The context of the data type declaration
                                        --      data Eq a => T a = ...
                                        -- or, rather, a "thinned" version thereof
                -- "Thinned", because the Report says
                -- to eliminate any constraints that don't mention
                -- tyvars free in the arg types for this constructor
                --
                -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
                -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
                --
                -- "Stupid", because the dictionaries aren't used for anything.
                -- Indeed, [as of March 02] they are no longer in the type of
                -- the wrapper Id, because that makes it harder to use the wrap-id
                -- to rebuild values after record selection or in generics.

        dcOrigArgTys :: [Type],         -- Original argument types
                                        -- (before unboxing and flattening of strict fields)
        dcOrigResTy :: Type,            -- Original result type, as seen by the user
                -- NB: for a data instance, the original user result type may
                -- differ from the DataCon's representation TyCon.  Example
                --      data instance T [a] where MkT :: a -> T [a]
                -- The OrigResTy is T [a], but the dcRepTyCon might be :T123

        -- Now the strictness annotations and field labels of the constructor
358
        dcSrcBangs :: [HsSrcBang],
Simon Peyton Jones's avatar
Simon Peyton Jones committed
359
                -- See Note [Bangs on data constructor arguments]
360
361
                --
                -- The [HsSrcBang] as written by the programmer.
362
                --
Edward Z. Yang's avatar
Edward Z. Yang committed
363
364
365
366
367
368
369
370
371
372
373
374
375
376
                -- Matches 1-1 with dcOrigArgTys
                -- Hence length = dataConSourceArity dataCon

        dcFields  :: [FieldLabel],
                -- Field labels for this constructor, in the
                -- same order as the dcOrigArgTys;
                -- length = 0 (if not a record) or dataConSourceArity.

        -- The curried worker function that corresponds to the constructor:
        -- It doesn't have an unfolding; the code generator saturates these Ids
        -- and allocates a real constructor when it finds one.
        dcWorkId :: Id,

        -- Constructor representation
377
        dcRep      :: DataConRep,
378

379
        -- Cached
380
381
382
383
          -- dcRepArity == length dataConRepArgTys
        dcRepArity    :: Arity,
          -- dcSourceArity == length dcOrigArgTys
        dcSourceArity :: Arity,
384

Edward Z. Yang's avatar
Edward Z. Yang committed
385
386
        -- Result type of constructor is T t1..tn
        dcRepTyCon  :: TyCon,           -- Result tycon, T
387

Edward Z. Yang's avatar
Edward Z. Yang committed
388
389
        dcRepType   :: Type,    -- Type of the constructor
                                --      forall a x y. (a~(x,y), x~y, Ord x) =>
390
                                --        x -> y -> T a
Edward Z. Yang's avatar
Edward Z. Yang committed
391
392
393
394
395
                                -- (this is *not* of the constructor wrapper Id:
                                --  see Note [Data con representation] below)
        -- Notice that the existential type parameters come *second*.
        -- Reason: in a case expression we may find:
        --      case (e :: T t) of
396
        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
Edward Z. Yang's avatar
Edward Z. Yang committed
397
398
399
400
        -- It's convenient to apply the rep-type of MkT to 't', to get
        --      forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
        -- and use that to check the pattern.  Mind you, this is really only
        -- used in CoreLint.
401
402


Edward Z. Yang's avatar
Edward Z. Yang committed
403
404
405
        dcInfix :: Bool,        -- True <=> declared infix
                                -- Used for Template Haskell and 'deriving' only
                                -- The actual fixity is stored elsewhere
406

407
408
        dcPromoted :: TyCon    -- The promoted TyCon
                               -- See Note [Promoted data constructors] in TyCon
409
  }
410
  deriving Data.Typeable.Typeable
411

Edward Z. Yang's avatar
Edward Z. Yang committed
412
data DataConRep
413
414
  = NoDataConRep              -- No wrapper

Edward Z. Yang's avatar
Edward Z. Yang committed
415
  | DCR { dcr_wrap_id :: Id   -- Takes src args, unboxes/flattens,
416
417
418
419
                              -- and constructs the representation

        , dcr_boxer   :: DataConBoxer

Edward Z. Yang's avatar
Edward Z. Yang committed
420
        , dcr_arg_tys :: [Type]  -- Final, representation argument types,
421
422
423
424
                                 -- after unboxing and flattening,
                                 -- and *including* all evidence args

        , dcr_stricts :: [StrictnessMark]  -- 1-1 with dcr_arg_tys
425
                -- See also Note [Data-con worker strictness] in MkId.hs
426

Simon Peyton Jones's avatar
Simon Peyton Jones committed
427
428
429
        , dcr_bangs :: [HsImplBang]  -- The actual decisions made (including failures)
                                     -- about the original arguments; 1-1 with orig_arg_tys
                                     -- See Note [Bangs on data constructor arguments]
430

431
432
433
    }
-- Algebraic data types always have a worker, and
-- may or may not have a wrapper, depending on whether
Edward Z. Yang's avatar
Edward Z. Yang committed
434
-- the wrapper does anything.
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
--
-- Data types have a worker with no unfolding
-- Newtypes just have a worker, which has a compulsory unfolding (just a cast)

-- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments

-- The wrapper (if it exists) takes dcOrigArgTys as its arguments
-- The worker takes dataConRepArgTys as its arguments
-- If the worker is absent, dataConRepArgTys is the same as dcOrigArgTys

-- The 'NoDataConRep' case is important
-- Not only is this efficient,
-- but it also ensures that the wrapper is replaced
-- by the worker (because it *is* the worker)
-- even when there are no args. E.g. in
Edward Z. Yang's avatar
Edward Z. Yang committed
450
--              f (:) x
451
452
453
454
455
456
-- the (:) *is* the worker.
-- This is really important in rule matching,
-- (We could match on the wrappers,
-- but that makes it less likely that rules will match
-- when we bring bits of unfoldings together.)

457
458
-------------------------

459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
-- | Bangs on data constructor arguments as the user wrote them in the
-- source code.
--
-- (HsSrcBang _ SrcUnpack SrcLazy) and
-- (HsSrcBang _ SrcUnpack NoSrcStrict) (without StrictData) makes no sense, we
-- emit a warning (in checkValidDataCon) and treat it like
-- (HsSrcBang _ NoSrcUnpack SrcLazy)
data HsSrcBang =
  HsSrcBang (Maybe SourceText) -- Note [Pragma source text] in BasicTypes
            SrcUnpackedness
            SrcStrictness
  deriving (Data.Data, Data.Typeable)

-- | Bangs of data constructor arguments as generated by the compiler
-- after consulting HsSrcBang, flags, etc.
data HsImplBang
  = HsLazy  -- ^ Lazy field
  | HsStrict  -- ^ Strict but not unpacked field
  | HsUnpack (Maybe Coercion)
    -- ^ Strict and unpacked field
    -- co :: arg-ty ~ product-ty HsBang
480
481
  deriving (Data.Data, Data.Typeable)

482
483
484
-- | What strictness annotation the user wrote
data SrcStrictness = SrcLazy -- ^ Lazy, ie '~'
                   | SrcStrict -- ^ Strict, ie '!'
485
                   | NoSrcStrict -- ^ no strictness annotation
486
487
488
489
490
491
492
493
494
     deriving (Eq, Data.Data, Data.Typeable)

-- | What unpackedness the user requested
data SrcUnpackedness = SrcUnpack -- ^ {-# UNPACK #-} specified
                     | SrcNoUnpack -- ^ {-# NOUNPACK #-} specified
                     | NoSrcUnpack -- ^ no unpack pragma
     deriving (Eq, Data.Data, Data.Typeable)


Simon Peyton Jones's avatar
Simon Peyton Jones committed
495

496
-------------------------
Edward Z. Yang's avatar
Edward Z. Yang committed
497
-- StrictnessMark is internal only, used to indicate strictness
498
-- of the DataCon *worker* fields
Edward Z. Yang's avatar
Edward Z. Yang committed
499
data StrictnessMark = MarkedStrict | NotMarkedStrict
500

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
-- | An 'EqSpec' is a tyvar/type pair representing an equality made in
-- rejigging a GADT constructor
data EqSpec = EqSpec TyVar
                     Type

-- | Make an 'EqSpec'
mkEqSpec :: TyVar -> Type -> EqSpec
mkEqSpec tv ty = EqSpec tv ty

eqSpecTyVar :: EqSpec -> TyVar
eqSpecTyVar (EqSpec tv _) = tv

eqSpecType :: EqSpec -> Type
eqSpecType (EqSpec _ ty) = ty

eqSpecPair :: EqSpec -> (TyVar, Type)
eqSpecPair (EqSpec tv ty) = (tv, ty)

eqSpecPreds :: [EqSpec] -> ThetaType
eqSpecPreds spec = [ mkPrimEqPred (mkTyVarTy tv) ty
                   | EqSpec tv ty <- spec ]

-- | Substitute in an 'EqSpec'. Precondition: if the LHS of the EqSpec
-- is mapped in the substitution, it is mapped to a type variable, not
-- a full type.
substEqSpec :: TCvSubst -> EqSpec -> EqSpec
substEqSpec subst (EqSpec tv ty)
  = EqSpec tv' (substTy subst ty)
  where
    tv' = getTyVar "substEqSpec" (substTyVar subst tv)

instance Outputable EqSpec where
  ppr (EqSpec tv ty) = ppr (tv, ty)

Simon Peyton Jones's avatar
Simon Peyton Jones committed
535
536
537
538
539
540
541
{- Note [Bangs on data constructor arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
  data T = MkT !Int {-# UNPACK #-} !Int Bool

When compiling the module, GHC will decide how to represent
MkT, depending on the optimisation level, and settings of
542
flags like -funbox-small-strict-fields.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
543
544
545

Terminology:
  * HsSrcBang:  What the user wrote
546
                Constructors: HsSrcBang
Simon Peyton Jones's avatar
Simon Peyton Jones committed
547
548

  * HsImplBang: What GHC decided
549
                Constructors: HsLazy, HsStrict, HsUnpack
Simon Peyton Jones's avatar
Simon Peyton Jones committed
550

551
* If T was defined in this module, MkT's dcSrcBangs field
Simon Peyton Jones's avatar
Simon Peyton Jones committed
552
  records the [HsSrcBang] of what the user wrote; in the example
553
554
555
    [ HsSrcBang _ NoSrcUnpack SrcStrict
    , HsSrcBang _ SrcUnpack SrcStrict
    , HsSrcBang _ NoSrcUnpack NoSrcStrictness]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
556

557
558
559
560
* However, if T was defined in an imported module, the importing module
  must follow the decisions made in the original module, regardless of
  the flag settings in the importing module.
  Also see Note [Bangs on imported data constructors] in MkId
Simon Peyton Jones's avatar
Simon Peyton Jones committed
561
562
563

* The dcr_bangs field of the dcRep field records the [HsImplBang]
  If T was defined in this module, Without -O the dcr_bangs might be
564
    [HsStrict, HsStrict, HsLazy]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
565
  With -O it might be
566
    [HsStrict, HsUnpack _, HsLazy]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
567
  With -funbox-small-strict-fields it might be
568
569
570
    [HsUnpack, HsUnpack _, HsLazy]
  With -XStrictData it might be
    [HsStrict, HsUnpack _, HsStrict]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
571

572
573
Note [Data con representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
574
The dcRepType field contains the type of the representation of a contructor
575
This may differ from the type of the constructor *Id* (built
576
by MkId.mkDataConId) for two reasons:
Edward Z. Yang's avatar
Edward Z. Yang committed
577
578
        a) the constructor Id may be overloaded, but the dictionary isn't stored
           e.g.    data Eq a => T a = MkT a a
579

Edward Z. Yang's avatar
Edward Z. Yang committed
580
        b) the constructor may store an unboxed version of a strict field.
581
582

Here's an example illustrating both:
Edward Z. Yang's avatar
Edward Z. Yang committed
583
        data Ord a => T a = MkT Int! a
584
Here
Edward Z. Yang's avatar
Edward Z. Yang committed
585
        T :: Ord a => Int -> a -> T a
586
but the rep type is
Edward Z. Yang's avatar
Edward Z. Yang committed
587
        Trep :: Int# -> a -> T a
588
589
Actually, the unboxed part isn't implemented yet!

590

591

Austin Seipp's avatar
Austin Seipp committed
592
593
************************************************************************
*                                                                      *
594
\subsection{Instances}
Austin Seipp's avatar
Austin Seipp committed
595
596
597
*                                                                      *
************************************************************************
-}
598

599
600
601
602
603
604
instance Eq DataCon where
    a == b = getUnique a == getUnique b
    a /= b = getUnique a /= getUnique b

instance Ord DataCon where
    a <= b = getUnique a <= getUnique b
Edward Z. Yang's avatar
Edward Z. Yang committed
605
    a <  b = getUnique a <  getUnique b
606
    a >= b = getUnique a >= getUnique b
Edward Z. Yang's avatar
Edward Z. Yang committed
607
    a >  b = getUnique a > getUnique b
608
609
610
611
612
613
614
615
616
617
618
    compare a b = getUnique a `compare` getUnique b

instance Uniquable DataCon where
    getUnique = dcUnique

instance NamedThing DataCon where
    getName = dcName

instance Outputable DataCon where
    ppr con = ppr (dataConName con)

619
620
621
622
instance OutputableBndr DataCon where
    pprInfixOcc con = pprInfixName (dataConName con)
    pprPrefixOcc con = pprPrefixName (dataConName con)

623
624
625
626
627
instance Data.Data DataCon where
    -- don't traverse?
    toConstr _   = abstractConstr "DataCon"
    gunfold _ _  = error "gunfold"
    dataTypeOf _ = mkNoRepType "DataCon"
628

629
instance Outputable HsSrcBang where
630
    ppr (HsSrcBang _ prag mark) = ppr prag <+> ppr mark
631
632

instance Outputable HsImplBang where
633
634
635
636
    ppr HsLazy                  = text "Lazy"
    ppr (HsUnpack Nothing)      = text "Unpacked"
    ppr (HsUnpack (Just co))    = text "Unpacked" <> parens (ppr co)
    ppr HsStrict                = text "StrictNotUnpacked"
637
638

instance Outputable SrcStrictness where
639
640
641
    ppr SrcLazy     = char '~'
    ppr SrcStrict   = char '!'
    ppr NoSrcStrict = empty
642
643

instance Outputable SrcUnpackedness where
644
645
    ppr SrcUnpack   = text "{-# UNPACK #-}"
    ppr SrcNoUnpack = text "{-# NOUNPACK #-}"
646
    ppr NoSrcUnpack = empty
647
648

instance Outputable StrictnessMark where
649
    ppr MarkedStrict    = text "!"
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
    ppr NotMarkedStrict = empty

instance Binary SrcStrictness where
    put_ bh SrcLazy     = putByte bh 0
    put_ bh SrcStrict   = putByte bh 1
    put_ bh NoSrcStrict = putByte bh 2

    get bh =
      do h <- getByte bh
         case h of
           0 -> return SrcLazy
           1 -> return SrcLazy
           _ -> return NoSrcStrict

instance Binary SrcUnpackedness where
    put_ bh SrcNoUnpack = putByte bh 0
    put_ bh SrcUnpack   = putByte bh 1
    put_ bh NoSrcUnpack = putByte bh 2

    get bh =
      do h <- getByte bh
         case h of
           0 -> return SrcNoUnpack
           1 -> return SrcUnpack
           _ -> return NoSrcUnpack
675

676
-- | Compare strictness annotations
677
eqHsBang :: HsImplBang -> HsImplBang -> Bool
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
eqHsBang HsLazy               HsLazy              = True
eqHsBang HsStrict             HsStrict            = True
eqHsBang (HsUnpack Nothing)   (HsUnpack Nothing)  = True
eqHsBang (HsUnpack (Just c1)) (HsUnpack (Just c2))
  = eqType (coercionType c1) (coercionType c2)
eqHsBang _ _                                       = False

isBanged :: HsImplBang -> Bool
isBanged (HsUnpack {}) = True
isBanged (HsStrict {}) = True
isBanged HsLazy        = False

isSrcStrict :: SrcStrictness -> Bool
isSrcStrict SrcStrict = True
isSrcStrict _ = False

isSrcUnpacked :: SrcUnpackedness -> Bool
isSrcUnpacked SrcUnpack = True
isSrcUnpacked _ = False
697
698
699
700

isMarkedStrict :: StrictnessMark -> Bool
isMarkedStrict NotMarkedStrict = False
isMarkedStrict _               = True   -- All others are strict
701

Austin Seipp's avatar
Austin Seipp committed
702
703
704
{-
************************************************************************
*                                                                      *
705
\subsection{Construction}
Austin Seipp's avatar
Austin Seipp committed
706
707
708
*                                                                      *
************************************************************************
-}
709

batterseapower's avatar
batterseapower committed
710
-- | Build a new data constructor
Edward Z. Yang's avatar
Edward Z. Yang committed
711
mkDataCon :: Name
712
          -> Bool           -- ^ Is the constructor declared infix?
713
          -> TyConRepName   -- ^  TyConRepName for the promoted TyCon
714
          -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user
715
716
717
718
          -> [FieldLabel]   -- ^ Field labels for the constructor,
                            -- if it is a record, otherwise empty
          -> [TyVar]        -- ^ Universally quantified type variables
          -> [TyVar]        -- ^ Existentially quantified type variables
719
          -> [EqSpec]       -- ^ GADT equalities
720
721
722
723
724
725
726
727
          -> ThetaType      -- ^ Theta-type occuring before the arguments proper
          -> [Type]         -- ^ Original argument types
          -> Type           -- ^ Original result type
          -> TyCon          -- ^ Representation type constructor
          -> ThetaType      -- ^ The "stupid theta", context of the data
                            -- declaration e.g. @data Eq a => T a ...@
          -> Id             -- ^ Worker Id
          -> DataConRep     -- ^ Representation
Edward Z. Yang's avatar
Edward Z. Yang committed
728
          -> DataCon
729
730
  -- Can get the tag from the TyCon

731
mkDataCon name declared_infix prom_info
Edward Z. Yang's avatar
Edward Z. Yang committed
732
733
734
735
736
737
738
          arg_stricts   -- Must match orig_arg_tys 1-1
          fields
          univ_tvs ex_tvs
          eq_spec theta
          orig_arg_tys orig_res_ty rep_tycon
          stupid_theta work_id rep
-- Warning: mkDataCon is not a good place to check invariants.
739
-- If the programmer writes the wrong result type in the decl, thus:
Edward Z. Yang's avatar
Edward Z. Yang committed
740
--      data T a where { MkT :: S }
741
742
743
744
745
-- then it's possible that the univ_tvs may hit an assertion failure
-- if you pull on univ_tvs.  This case is checked by checkValidDataCon,
-- so the error is detected properly... it's just that asaertions here
-- are a little dodgy.

746
  = con
747
  where
748
    is_vanilla = null ex_tvs && null eq_spec && null theta
Edward Z. Yang's avatar
Edward Z. Yang committed
749
750
751
752
753
754
755
756
    con = MkData {dcName = name, dcUnique = nameUnique name,
                  dcVanilla = is_vanilla, dcInfix = declared_infix,
                  dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
                  dcEqSpec = eq_spec,
                  dcOtherTheta = theta,
                  dcStupidTheta = stupid_theta,
                  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
                  dcRepTyCon = rep_tycon,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
757
                  dcSrcBangs = arg_stricts,
Edward Z. Yang's avatar
Edward Z. Yang committed
758
759
760
                  dcFields = fields, dcTag = tag, dcRepType = rep_ty,
                  dcWorkId = work_id,
                  dcRep = rep,
761
762
                  dcSourceArity = length orig_arg_tys,
                  dcRepArity = length rep_arg_tys,
763
                  dcPromoted = promoted }
764

Edward Z. Yang's avatar
Edward Z. Yang committed
765
766
767
        -- The 'arg_stricts' passed to mkDataCon are simply those for the
        -- source-language arguments.  We add extra ones for the
        -- dictionary arguments right here.
768

769
    tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
770
    rep_arg_tys = dataConRepArgTys con
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
771
772
      -- NB: This type is user-facing for datatypes that don't need wrappers;
      --     so it's important to use mkSpecForAllTys
773
    rep_ty = mkSpecForAllTys univ_tvs $ mkSpecForAllTys ex_tvs $
Edward Z. Yang's avatar
Edward Z. Yang committed
774
775
             mkFunTys rep_arg_tys $
             mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
776

777
778
    promoted   -- See Note [Promoted data constructors] in TyCon
      = mkPromotedDataCon con name prom_info (dataConUserType con) roles
779

780
781
    roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
            map (const Representational) orig_arg_tys
782

batterseapower's avatar
batterseapower committed
783
-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
784
785
786
dataConName :: DataCon -> Name
dataConName = dcName

batterseapower's avatar
batterseapower committed
787
-- | The tag used for ordering 'DataCon's
788
789
790
dataConTag :: DataCon -> ConTag
dataConTag  = dcTag

batterseapower's avatar
batterseapower committed
791
-- | The type constructor that we are building via this data constructor
792
dataConTyCon :: DataCon -> TyCon
793
dataConTyCon = dcRepTyCon
794

795
796
797
798
-- | The original type constructor used in the definition of this data
-- constructor.  In case of a data family instance, that will be the family
-- type constructor.
dataConOrigTyCon :: DataCon -> TyCon
Edward Z. Yang's avatar
Edward Z. Yang committed
799
dataConOrigTyCon dc
800
801
802
  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
  | otherwise                                          = dcRepTyCon dc

batterseapower's avatar
batterseapower committed
803
804
-- | The representation type of the data constructor, i.e. the sort
-- type that will represent values of this type at runtime
805
806
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
807

batterseapower's avatar
batterseapower committed
808
-- | Should the 'DataCon' be presented infix?
809
810
811
dataConIsInfix :: DataCon -> Bool
dataConIsInfix = dcInfix

batterseapower's avatar
batterseapower committed
812
-- | The universally-quantified type variables of the constructor
813
814
815
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars = dcUnivTyVars

batterseapower's avatar
batterseapower committed
816
-- | The existentially-quantified type variables of the constructor
817
818
819
dataConExTyVars :: DataCon -> [TyVar]
dataConExTyVars = dcExTyVars

batterseapower's avatar
batterseapower committed
820
-- | Both the universal and existentiatial type variables of the constructor
821
822
823
824
dataConAllTyVars :: DataCon -> [TyVar]
dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
  = univ_tvs ++ ex_tvs

batterseapower's avatar
batterseapower committed
825
-- | Equalities derived from the result type of the data constructor, as written
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
-- by the programmer in any GADT declaration. This includes *all* GADT-like
-- equalities, including those written in by hand by the programmer.
dataConEqSpec :: DataCon -> [EqSpec]
dataConEqSpec (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
  = eq_spec ++
    [ spec   -- heterogeneous equality
    | Just (tc, [_k1, _k2, ty1, ty2]) <- map splitTyConApp_maybe theta
    , tc `hasKey` heqTyConKey
    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
                    (Just tv1, _) -> [mkEqSpec tv1 ty2]
                    (_, Just tv2) -> [mkEqSpec tv2 ty1]
                    _             -> []
    ] ++
    [ spec   -- homogeneous equality
    | Just (tc, [_k, ty1, ty2]) <- map splitTyConApp_maybe theta
    , tc `hasKey` eqTyConKey
    , spec <- case (getTyVar_maybe ty1, getTyVar_maybe ty2) of
                    (Just tv1, _) -> [mkEqSpec tv1 ty2]
                    (_, Just tv2) -> [mkEqSpec tv2 ty1]
                    _             -> []
    ]


-- | The *full* constraints on the constructor type.
850
dataConTheta :: DataCon -> ThetaType
Edward Z. Yang's avatar
Edward Z. Yang committed
851
dataConTheta (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
852
  = eqSpecPreds eq_spec ++ theta
853

batterseapower's avatar
batterseapower committed
854
855
856
857
-- | Get the Id of the 'DataCon' worker: a function that is the "actual"
-- constructor and has no top level binding in the program. The type may
-- be different from the obvious one written in the source program. Panics
-- if there is no such 'Id' for this 'DataCon'
858
dataConWorkId :: DataCon -> Id
859
dataConWorkId dc = dcWorkId dc
860

batterseapower's avatar
batterseapower committed
861
862
-- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"
-- constructor so it has the type visible in the source program: c.f. 'dataConWorkId'.
Edward Z. Yang's avatar
Edward Z. Yang committed
863
-- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor
batterseapower's avatar
batterseapower committed
864
-- and also for a newtype (whose constructor is inlined compulsorily)
865
dataConWrapId_maybe :: DataCon -> Maybe Id
866
867
868
dataConWrapId_maybe dc = case dcRep dc of
                           NoDataConRep -> Nothing
                           DCR { dcr_wrap_id = wrap_id } -> Just wrap_id
869

batterseapower's avatar
batterseapower committed
870
871
872
-- | Returns an Id which looks like the Haskell-source constructor by using
-- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to
-- the worker (see 'dataConWorkId')
873
dataConWrapId :: DataCon -> Id
874
875
876
dataConWrapId dc = case dcRep dc of
                     NoDataConRep-> dcWorkId dc    -- worker=wrapper
                     DCR { dcr_wrap_id = wrap_id } -> wrap_id
877

batterseapower's avatar
batterseapower committed
878
879
-- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
-- the union of the 'dataConWorkId' and the 'dataConWrapId'
880
881
882
883
884
885
886
dataConImplicitTyThings :: DataCon -> [TyThing]
dataConImplicitTyThings (MkData { dcWorkId = work, dcRep = rep })
  = [AnId work] ++ wrap_ids
  where
    wrap_ids = case rep of
                 NoDataConRep               -> []
                 DCR { dcr_wrap_id = wrap } -> [AnId wrap]
887

batterseapower's avatar
batterseapower committed
888
-- | The labels for the fields of this particular 'DataCon'
889
890
891
dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields

batterseapower's avatar
batterseapower committed
892
-- | Extract the type for any given labelled field of the 'DataCon'
Adam Gundry's avatar
Adam Gundry committed
893
dataConFieldType :: DataCon -> FieldLabelString -> Type
894
dataConFieldType con label
Adam Gundry's avatar
Adam Gundry committed
895
896
  = case find ((== label) . flLabel . fst) (dcFields con `zip` dcOrigArgTys con) of
      Just (_, ty) -> ty
897
      Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
898

899
900
-- | Strictness/unpack annotations, from user; or, for imported
-- DataCons, from the interface file
Simon Peyton Jones's avatar
Simon Peyton Jones committed
901
-- The list is in one-to-one correspondence with the arity of the 'DataCon'
902

Simon Peyton Jones's avatar
Simon Peyton Jones committed
903
904
dataConSrcBangs :: DataCon -> [HsSrcBang]
dataConSrcBangs = dcSrcBangs
905

batterseapower's avatar
batterseapower committed
906
-- | Source-level arity of the data constructor
907
dataConSourceArity :: DataCon -> Arity
908
dataConSourceArity (MkData { dcSourceArity = arity }) = arity
909

Edward Z. Yang's avatar
Edward Z. Yang committed
910
-- | Gives the number of actual fields in the /representation/ of the
batterseapower's avatar
batterseapower committed
911
912
-- data constructor. This may be more than appear in the source code;
-- the extra ones are the existentially quantified dictionaries
913
dataConRepArity :: DataCon -> Arity
914
915
dataConRepArity (MkData { dcRepArity = arity }) = arity

916

917
918
919
920
921
-- | The number of fields in the /representation/ of the constructor
-- AFTER taking into account the unpacking of any unboxed tuple fields
dataConRepRepArity :: DataCon -> RepArity
dataConRepRepArity dc = typeRepArity (dataConRepArity dc) (dataConRepType dc)

batterseapower's avatar
batterseapower committed
922
923
-- | Return whether there are any argument types for this 'DataCon's original source type
isNullarySrcDataCon :: DataCon -> Bool
924
isNullarySrcDataCon dc = null (dcOrigArgTys dc)
batterseapower's avatar
batterseapower committed
925
926
927

-- | Return whether there are any argument types for this 'DataCon's runtime representation type
isNullaryRepDataCon :: DataCon -> Bool
928
isNullaryRepDataCon dc = dataConRepArity dc == 0
929

930
dataConRepStrictness :: DataCon -> [StrictnessMark]
batterseapower's avatar
batterseapower committed
931
932
-- ^ Give the demands on the arguments of a
-- Core constructor application (Con dc args)
933
934
935
936
dataConRepStrictness dc = case dcRep dc of
                            NoDataConRep -> [NotMarkedStrict | _ <- dataConRepArgTys dc]
                            DCR { dcr_stricts = strs } -> strs

Simon Peyton Jones's avatar
Simon Peyton Jones committed
937
938
939
dataConImplBangs :: DataCon -> [HsImplBang]
-- The implementation decisions about the strictness/unpack of each
-- source program argument to the data constructor
940
941
dataConImplBangs dc
  = case dcRep dc of
942
      NoDataConRep              -> replicate (dcSourceArity dc) HsLazy
943
      DCR { dcr_bangs = bangs } -> bangs
944
945
946

dataConBoxer :: DataCon -> Maybe DataConBoxer
dataConBoxer (MkData { dcRep = DCR { dcr_boxer = boxer } }) = Just boxer
Edward Z. Yang's avatar
Edward Z. Yang committed
947
dataConBoxer _ = Nothing
948

batterseapower's avatar
batterseapower committed
949
950
951
952
953
954
955
956
957
958
-- | The \"signature\" of the 'DataCon' returns, in order:
--
-- 1) The result of 'dataConAllTyVars',
--
-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
--    parameter - whatever)
--
-- 3) The type arguments to the constructor
--
-- 4) The /original/ result type of the 'DataCon'
959
dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
960
961
962
dataConSig con@(MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
                        dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
  = (univ_tvs ++ ex_tvs, dataConTheta con, arg_tys, res_ty)
963

Simon Peyton Jones's avatar
Simon Peyton Jones committed
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
dataConInstSig
  :: DataCon
  -> [Type]    -- Instantiate the *universal* tyvars with these types
  -> ([TyVar], ThetaType, [Type])  -- Return instantiated existentials
                                   -- theta and arg tys
-- ^ Instantantiate the universal tyvars of a data con,
--   returning the instantiated existentials, constraints, and args
dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
                       , dcEqSpec = eq_spec, dcOtherTheta  = theta
                       , dcOrigArgTys = arg_tys })
               univ_tys
  = (ex_tvs'
    , substTheta subst (eqSpecPreds eq_spec ++ theta)
    , substTys   subst arg_tys)
  where
niteria's avatar
niteria committed
979
    univ_subst = zipTvSubst univ_tvs univ_tys
Simon Peyton Jones's avatar
Simon Peyton Jones committed
980
981
982
    (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst ex_tvs


batterseapower's avatar
batterseapower committed
983
984
985
986
987
988
-- | The \"full signature\" of the 'DataCon' returns, in order:
--
-- 1) The result of 'dataConUnivTyVars'
--
-- 2) The result of 'dataConExTyVars'
--
989
-- 3) The GADT equalities
batterseapower's avatar
batterseapower committed
990
991
992
--
-- 4) The result of 'dataConDictTheta'
--
Edward Z. Yang's avatar
Edward Z. Yang committed
993
-- 5) The original argument types to the 'DataCon' (i.e. before
994
--    any change of the representation of the type)
batterseapower's avatar
batterseapower committed
995
996
--
-- 6) The original result type of the 'DataCon'
Edward Z. Yang's avatar
Edward Z. Yang committed
997
dataConFullSig :: DataCon
998
               -> ([TyVar], [TyVar], [EqSpec], ThetaType, [Type], Type)
Edward Z. Yang's avatar
Edward Z. Yang committed
999
1000
1001
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
                        dcEqSpec = eq_spec, dcOtherTheta = theta,
                        dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
1002
  = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)
1003
1004
1005

dataConOrigResTy :: DataCon -> Type
dataConOrigResTy dc = dcOrigResTy dc
1006

batterseapower's avatar
batterseapower committed
1007
1008
1009
-- | The \"stupid theta\" of the 'DataCon', such as @data Eq a@ in:
--
-- > data Eq a => T a = ...
1010
1011
1012
dataConStupidTheta :: DataCon -> ThetaType
dataConStupidTheta dc = dcStupidTheta dc

1013
dataConUserType :: DataCon -> Type
batterseapower's avatar
batterseapower committed
1014
1015
1016
1017
1018
1019
1020
-- ^ The user-declared type of the data constructor
-- in the nice-to-read form:
--
-- > T :: forall a b. a -> b -> T [a]
--
-- rather than:
--
1021
-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
batterseapower's avatar
batterseapower committed
1022
--
1023
1024
-- NB: If the constructor is part of a data instance, the result type
-- mentions the family tycon, not the internal one.
1025
1026
1027
1028
dataConUserType (MkData { dcUnivTyVars = univ_tvs,
                          dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
                          dcOtherTheta = theta, dcOrigArgTys = arg_tys,
                          dcOrigResTy = res_ty })
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
1029
1030
  = mkSpecForAllTys ((univ_tvs `minusList` map eqSpecTyVar eq_spec) ++
                      ex_tvs) $
batterseapower's avatar
batterseapower committed
1031
    mkFunTys theta $
1032
    mkFunTys arg_tys $
1033
    res_ty
1034

batterseapower's avatar
batterseapower committed
1035
1036
1037
1038
-- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation
-- NB: these INCLUDE any dictionary args
--     but EXCLUDE the data-declaration context, which is discarded
-- It's all post-flattening etc; this is a representation type
Edward Z. Yang's avatar
Edward Z. Yang committed
1039
1040
1041
1042
1043
dataConInstArgTys :: DataCon    -- ^ A datacon with no existentials or equality constraints
                                -- However, it can have a dcTheta (notably it can be a
                                -- class dictionary, with superclasses)
                  -> [Type]     -- ^ Instantiated at these types
                  -> [Type]
1044
dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
Edward Z. Yang's avatar
Edward Z. Yang committed
1045
                              dcExTyVars = ex_tvs}) inst_tys
1046
 = ASSERT2( length univ_tvs == length inst_tys
1047
          , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
1048
   ASSERT2( null ex_tvs, ppr dc )
1049
   map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)
1050

1051
1052
-- | Returns just the instantiated /value/ argument types of a 'DataCon',
-- (excluding dictionary args)
Edward Z. Yang's avatar
Edward Z. Yang committed
1053
1054
1055
1056
1057
dataConInstOrigArgTys
        :: DataCon      -- Works for any DataCon
        -> [Type]       -- Includes existential tyvar args, but NOT
                        -- equality constraints or dicts
        -> [Type]
1058
1059
-- For vanilla datacons, it's all quite straightforward
-- But for the call in MatchCon, we really do want just the value args
1060
dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
Edward Z. Yang's avatar
Edward Z. Yang committed
1061
1062
                                  dcUnivTyVars = univ_tvs,
                                  dcExTyVars = ex_tvs}) inst_tys
1063
  = ASSERT2( length tyvars == length inst_tys
1064
          , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
1065
1066
1067
    map (substTyWith tyvars inst_tys) arg_tys
  where
    tyvars = univ_tvs ++ ex_tvs
1068

batterseapower's avatar
batterseapower committed
1069
1070
-- | Returns the argument types of the wrapper, excluding all dictionary arguments
-- and without substituting for any type variables
1071
1072
1073
dataConOrigArgTys :: DataCon -> [Type]
dataConOrigArgTys dc = dcOrigArgTys dc

1074
1075
1076
-- | Returns the arg types of the worker, including *all*
-- evidence, after any flattening has been done and without substituting for
-- any type variables
1077
dataConRepArgTys :: DataCon -> [Type]
Edward Z. Yang's avatar
Edward Z. Yang committed
1078
dataConRepArgTys (MkData { dcRep = rep
1079
1080
                         , dcEqSpec = eq_spec
                         , dcOtherTheta = theta
Edward Z. Yang's avatar
Edward Z. Yang committed
1081
                         , dcOrigArgTys = orig_arg_tys })
1082
1083
1084
  = case rep of
      NoDataConRep -> ASSERT( null eq_spec ) theta ++ orig_arg_tys
      DCR { dcr_arg_tys = arg_tys } -> arg_tys