~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to compiler/basicTypes/DataCon.lhs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
ImportĀ upstreamĀ versionĀ 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%
 
2
% (c) The University of Glasgow 2006
 
3
% (c) The GRASP/AQUA Project, Glasgow University, 1998
 
4
%
 
5
\section[DataCon]{@DataCon@: Data Constructors}
 
6
 
 
7
\begin{code}
 
8
module DataCon (
 
9
        -- * Main data types
 
10
        DataCon, DataConIds(..),
 
11
        ConTag,
 
12
        
 
13
        -- ** Type construction
 
14
        mkDataCon, fIRST_TAG,
 
15
        
 
16
        -- ** Type deconstruction
 
17
        dataConRepType, dataConSig, dataConFullSig,
 
18
        dataConName, dataConIdentity, dataConTag, dataConTyCon, 
 
19
        dataConOrigTyCon, dataConUserType,
 
20
        dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, 
 
21
        dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta,
 
22
        dataConStupidTheta,  
 
23
        dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
 
24
        dataConInstOrigArgTys, dataConRepArgTys, 
 
25
        dataConFieldLabels, dataConFieldType,
 
26
        dataConStrictMarks, dataConExStricts,
 
27
        dataConSourceArity, dataConRepArity,
 
28
        dataConIsInfix,
 
29
        dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
 
30
        dataConRepStrictness,
 
31
        
 
32
        -- ** Predicates on DataCons
 
33
        isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
 
34
        isVanillaDataCon, classDataCon, 
 
35
 
 
36
        -- * Splitting product types
 
37
        splitProductType_maybe, splitProductType, deepSplitProductType,
 
38
        deepSplitProductType_maybe
 
39
    ) where
 
40
 
 
41
#include "HsVersions.h"
 
42
 
 
43
import Type
 
44
import Coercion
 
45
import TyCon
 
46
import Class
 
47
import Name
 
48
import Var
 
49
import BasicTypes
 
50
import Outputable
 
51
import Unique
 
52
import ListSetOps
 
53
import Util
 
54
import FastString
 
55
import Module
 
56
 
 
57
import qualified Data.Data as Data
 
58
import Data.Char
 
59
import Data.Word
 
60
import Data.List ( partition )
 
61
\end{code}
 
62
 
 
63
 
 
64
Data constructor representation
 
65
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
66
Consider the following Haskell data type declaration
 
67
 
 
68
        data T = T !Int ![Int]
 
69
 
 
70
Using the strictness annotations, GHC will represent this as
 
71
 
 
72
        data T = T Int# [Int]
 
73
 
 
74
That is, the Int has been unboxed.  Furthermore, the Haskell source construction
 
75
 
 
76
        T e1 e2
 
77
 
 
78
is translated to
 
79
 
 
80
        case e1 of { I# x -> 
 
81
        case e2 of { r ->
 
82
        T x r }}
 
83
 
 
84
That is, the first argument is unboxed, and the second is evaluated.  Finally,
 
85
pattern matching is translated too:
 
86
 
 
87
        case e of { T a b -> ... }
 
88
 
 
89
becomes
 
90
 
 
91
        case e of { T a' b -> let a = I# a' in ... }
 
92
 
 
93
To keep ourselves sane, we name the different versions of the data constructor
 
94
differently, as follows.
 
95
 
 
96
 
 
97
Note [Data Constructor Naming]
 
98
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
99
Each data constructor C has two, and possibly up to four, Names associated with it:
 
100
 
 
101
                   OccName   Name space   Name of   Notes
 
102
 ---------------------------------------------------------------------------
 
103
 The "data con itself"   C     DataName   DataCon   In dom( GlobalRdrEnv )
 
104
 The "worker data con"   C     VarName    Id        The worker
 
105
 The "wrapper data con"  $WC   VarName    Id        The wrapper
 
106
 The "newtype coercion"  :CoT  TcClsName  TyCon
 
107
 
 
108
EVERY data constructor (incl for newtypes) has the former two (the
 
109
data con itself, and its worker.  But only some data constructors have a
 
110
wrapper (see Note [The need for a wrapper]).
 
111
 
 
112
Each of these three has a distinct Unique.  The "data con itself" name
 
113
appears in the output of the renamer, and names the Haskell-source
 
114
data constructor.  The type checker translates it into either the wrapper Id
 
115
(if it exists) or worker Id (otherwise).
 
116
 
 
117
The data con has one or two Ids associated with it:
 
118
 
 
119
The "worker Id", is the actual data constructor.
 
120
* Every data constructor (newtype or data type) has a worker
 
121
 
 
122
* The worker is very like a primop, in that it has no binding.
 
123
 
 
124
* For a *data* type, the worker *is* the data constructor;
 
125
  it has no unfolding
 
126
 
 
127
* For a *newtype*, the worker has a compulsory unfolding which 
 
128
  does a cast, e.g.
 
129
        newtype T = MkT Int
 
130
        The worker for MkT has unfolding
 
131
                \\(x:Int). x `cast` sym CoT
 
132
  Here CoT is the type constructor, witnessing the FC axiom
 
133
        axiom CoT : T = Int
 
134
 
 
135
The "wrapper Id", \$WC, goes as follows
 
136
 
 
137
* Its type is exactly what it looks like in the source program. 
 
138
 
 
139
* It is an ordinary function, and it gets a top-level binding 
 
140
  like any other function.
 
141
 
 
142
* The wrapper Id isn't generated for a data type if there is
 
143
  nothing for the wrapper to do.  That is, if its defn would be
 
144
        \$wC = C
 
145
 
 
146
Note [The need for a wrapper]
 
147
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
148
Why might the wrapper have anything to do?  Two reasons:
 
149
 
 
150
* Unboxing strict fields (with -funbox-strict-fields)
 
151
        data T = MkT !(Int,Int)
 
152
        \$wMkT :: (Int,Int) -> T
 
153
        \$wMkT (x,y) = MkT x y
 
154
  Notice that the worker has two fields where the wapper has 
 
155
  just one.  That is, the worker has type
 
156
                MkT :: Int -> Int -> T
 
157
 
 
158
* Equality constraints for GADTs
 
159
        data T a where { MkT :: a -> T [a] }
 
160
 
 
161
  The worker gets a type with explicit equality
 
162
  constraints, thus:
 
163
        MkT :: forall a b. (a=[b]) => b -> T a
 
164
 
 
165
  The wrapper has the programmer-specified type:
 
166
        \$wMkT :: a -> T [a]
 
167
        \$wMkT a x = MkT [a] a [a] x
 
168
  The third argument is a coerion
 
169
        [a] :: [a]~[a]
 
170
 
 
171
INVARIANT: the dictionary constructor for a class
 
172
           never has a wrapper.
 
173
 
 
174
 
 
175
A note about the stupid context
 
176
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
177
Data types can have a context:
 
178
        
 
179
        data (Eq a, Ord b) => T a b = T1 a b | T2 a
 
180
 
 
181
and that makes the constructors have a context too
 
182
(notice that T2's context is "thinned"):
 
183
 
 
184
        T1 :: (Eq a, Ord b) => a -> b -> T a b
 
185
        T2 :: (Eq a) => a -> T a b
 
186
 
 
187
Furthermore, this context pops up when pattern matching
 
188
(though GHC hasn't implemented this, but it is in H98, and
 
189
I've fixed GHC so that it now does):
 
190
 
 
191
        f (T2 x) = x
 
192
gets inferred type
 
193
        f :: Eq a => T a b -> a
 
194
 
 
195
I say the context is "stupid" because the dictionaries passed
 
196
are immediately discarded -- they do nothing and have no benefit.
 
197
It's a flaw in the language.
 
198
 
 
199
        Up to now [March 2002] I have put this stupid context into the
 
200
        type of the "wrapper" constructors functions, T1 and T2, but
 
201
        that turned out to be jolly inconvenient for generics, and
 
202
        record update, and other functions that build values of type T
 
203
        (because they don't have suitable dictionaries available).
 
204
 
 
205
        So now I've taken the stupid context out.  I simply deal with
 
206
        it separately in the type checker on occurrences of a
 
207
        constructor, either in an expression or in a pattern.
 
208
 
 
209
        [May 2003: actually I think this decision could evasily be
 
210
        reversed now, and probably should be.  Generics could be
 
211
        disabled for types with a stupid context; record updates now
 
212
        (H98) needs the context too; etc.  It's an unforced change, so
 
213
        I'm leaving it for now --- but it does seem odd that the
 
214
        wrapper doesn't include the stupid context.]
 
215
 
 
216
[July 04] With the advent of generalised data types, it's less obvious
 
217
what the "stupid context" is.  Consider
 
218
        C :: forall a. Ord a => a -> a -> T (Foo a)
 
219
Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
 
220
 
 
221
        f :: T b -> Ordering
 
222
        f = /\b. \x:T b. 
 
223
            case x of
 
224
                C a (d:Ord a) (p:a) (q:a) -> compare d p q
 
225
 
 
226
Note that (Foo a) might not be an instance of Ord.
 
227
 
 
228
%************************************************************************
 
229
%*                                                                      *
 
230
\subsection{Data constructors}
 
231
%*                                                                      *
 
232
%************************************************************************
 
233
 
 
234
\begin{code}
 
235
-- | A data constructor
 
236
data DataCon
 
237
  = MkData {
 
238
        dcName    :: Name,      -- This is the name of the *source data con*
 
239
                                -- (see "Note [Data Constructor Naming]" above)
 
240
        dcUnique :: Unique,     -- Cached from Name
 
241
        dcTag    :: ConTag,     -- ^ Tag, used for ordering 'DataCon's
 
242
 
 
243
        -- Running example:
 
244
        --
 
245
        --      *** As declared by the user
 
246
        --  data T a where
 
247
        --    MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)
 
248
 
 
249
        --      *** As represented internally
 
250
        --  data T a where
 
251
        --    MkT :: forall a. forall x y. (a~(x,y),x~y,Ord x) => x -> y -> T a
 
252
        -- 
 
253
        -- The next six fields express the type of the constructor, in pieces
 
254
        -- e.g.
 
255
        --
 
256
        --      dcUnivTyVars  = [a]
 
257
        --      dcExTyVars    = [x,y]
 
258
        --      dcEqSpec      = [a~(x,y)]
 
259
        --      dcEqTheta     = [x~y]   
 
260
        --      dcDictTheta   = [Ord x]
 
261
        --      dcOrigArgTys  = [a,List b]
 
262
        --      dcRepTyCon       = T
 
263
 
 
264
        dcVanilla :: Bool,      -- True <=> This is a vanilla Haskell 98 data constructor
 
265
                                --          Its type is of form
 
266
                                --              forall a1..an . t1 -> ... tm -> T a1..an
 
267
                                --          No existentials, no coercions, nothing.
 
268
                                -- That is: dcExTyVars = dcEqSpec = dcEqTheta = dcDictTheta = []
 
269
                -- NB 1: newtypes always have a vanilla data con
 
270
                -- NB 2: a vanilla constructor can still be declared in GADT-style 
 
271
                --       syntax, provided its type looks like the above.
 
272
                --       The declaration format is held in the TyCon (algTcGadtSyntax)
 
273
 
 
274
        dcUnivTyVars :: [TyVar],        -- Universally-quantified type vars [a,b,c]
 
275
                                        -- INVARIANT: length matches arity of the dcRepTyCon
 
276
                                        ---           result type of (rep) data con is exactly (T a b c)
 
277
 
 
278
        dcExTyVars   :: [TyVar],        -- Existentially-quantified type vars 
 
279
                -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
 
280
                -- FOR THE PARENT TyCon. With GADTs the data con might not even have 
 
281
                -- the same number of type variables.
 
282
                -- [This is a change (Oct05): previously, vanilla datacons guaranteed to
 
283
                --  have the same type variables as their parent TyCon, but that seems ugly.]
 
284
 
 
285
        -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
 
286
        -- Reason: less confusing, and easier to generate IfaceSyn
 
287
 
 
288
        dcEqSpec :: [(TyVar,Type)],     -- Equalities derived from the result type, 
 
289
                                        -- _as written by the programmer_
 
290
                -- This field allows us to move conveniently between the two ways
 
291
                -- of representing a GADT constructor's type:
 
292
                --      MkT :: forall a b. (a ~ [b]) => b -> T a
 
293
                --      MkT :: forall b. b -> T [b]
 
294
                -- Each equality is of the form (a ~ ty), where 'a' is one of 
 
295
                -- the universally quantified type variables
 
296
                                        
 
297
                -- The next two fields give the type context of the data constructor
 
298
                --      (aside from the GADT constraints, 
 
299
                --       which are given by the dcExpSpec)
 
300
                -- In GADT form, this is *exactly* what the programmer writes, even if
 
301
                -- the context constrains only universally quantified variables
 
302
                --      MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
 
303
        dcEqTheta   :: ThetaType,  -- The *equational* constraints
 
304
        dcDictTheta :: ThetaType,  -- The *type-class and implicit-param* constraints
 
305
 
 
306
        dcStupidTheta :: ThetaType,     -- The context of the data type declaration 
 
307
                                        --      data Eq a => T a = ...
 
308
                                        -- or, rather, a "thinned" version thereof
 
309
                -- "Thinned", because the Report says
 
310
                -- to eliminate any constraints that don't mention
 
311
                -- tyvars free in the arg types for this constructor
 
312
                --
 
313
                -- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
 
314
                -- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
 
315
                -- 
 
316
                -- "Stupid", because the dictionaries aren't used for anything.  
 
317
                -- Indeed, [as of March 02] they are no longer in the type of 
 
318
                -- the wrapper Id, because that makes it harder to use the wrap-id 
 
319
                -- to rebuild values after record selection or in generics.
 
320
 
 
321
        dcOrigArgTys :: [Type],         -- Original argument types
 
322
                                        -- (before unboxing and flattening of strict fields)
 
323
        dcOrigResTy :: Type,            -- Original result type, as seen by the user
 
324
                -- NB: for a data instance, the original user result type may 
 
325
                -- differ from the DataCon's representation TyCon.  Example
 
326
                --      data instance T [a] where MkT :: a -> T [a]
 
327
                -- The OrigResTy is T [a], but the dcRepTyCon might be :T123
 
328
 
 
329
        -- Now the strictness annotations and field labels of the constructor
 
330
        dcStrictMarks :: [HsBang],
 
331
                -- Strictness annotations as decided by the compiler.  
 
332
                -- Does *not* include the existential dictionaries
 
333
                -- length = dataConSourceArity dataCon
 
334
 
 
335
        dcFields  :: [FieldLabel],
 
336
                -- Field labels for this constructor, in the
 
337
                -- same order as the dcOrigArgTys; 
 
338
                -- length = 0 (if not a record) or dataConSourceArity.
 
339
 
 
340
        -- Constructor representation
 
341
        dcRepArgTys :: [Type],          -- Final, representation argument types, 
 
342
                                        -- after unboxing and flattening,
 
343
                                        -- and *including* existential dictionaries
 
344
 
 
345
        dcRepStrictness :: [StrictnessMark],
 
346
                -- One for each *representation* *value* argument
 
347
                -- See also Note [Data-con worker strictness] in MkId.lhs
 
348
 
 
349
        -- Result type of constructor is T t1..tn
 
350
        dcRepTyCon  :: TyCon,           -- Result tycon, T
 
351
 
 
352
        dcRepType   :: Type,    -- Type of the constructor
 
353
                                --      forall a x y. (a~(x,y), x~y, Ord x) =>
 
354
                                --        x -> y -> T a
 
355
                                -- (this is *not* of the constructor wrapper Id:
 
356
                                --  see Note [Data con representation] below)
 
357
        -- Notice that the existential type parameters come *second*.  
 
358
        -- Reason: in a case expression we may find:
 
359
        --      case (e :: T t) of
 
360
        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
 
361
        -- It's convenient to apply the rep-type of MkT to 't', to get
 
362
        --      forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
 
363
        -- and use that to check the pattern.  Mind you, this is really only
 
364
        -- used in CoreLint.
 
365
 
 
366
 
 
367
        -- The curried worker function that corresponds to the constructor:
 
368
        -- It doesn't have an unfolding; the code generator saturates these Ids
 
369
        -- and allocates a real constructor when it finds one.
 
370
        --
 
371
        -- An entirely separate wrapper function is built in TcTyDecls
 
372
        dcIds :: DataConIds,
 
373
 
 
374
        dcInfix :: Bool         -- True <=> declared infix
 
375
                                -- Used for Template Haskell and 'deriving' only
 
376
                                -- The actual fixity is stored elsewhere
 
377
  }
 
378
 
 
379
-- | Contains the Ids of the data constructor functions
 
380
data DataConIds
 
381
  = DCIds (Maybe Id) Id         -- Algebraic data types always have a worker, and
 
382
                                -- may or may not have a wrapper, depending on whether
 
383
                                -- the wrapper does anything.  Newtypes just have a worker
 
384
 
 
385
        -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
 
386
 
 
387
        -- The wrapper takes dcOrigArgTys as its arguments
 
388
        -- The worker takes dcRepArgTys as its arguments
 
389
        -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
 
390
 
 
391
        -- The 'Nothing' case of DCIds is important
 
392
        -- Not only is this efficient,
 
393
        -- but it also ensures that the wrapper is replaced
 
394
        -- by the worker (because it *is* the worker)
 
395
        -- even when there are no args. E.g. in
 
396
        --              f (:) x
 
397
        -- the (:) *is* the worker.
 
398
        -- This is really important in rule matching,
 
399
        -- (We could match on the wrappers,
 
400
        -- but that makes it less likely that rules will match
 
401
        -- when we bring bits of unfoldings together.)
 
402
 
 
403
-- | Type of the tags associated with each constructor possibility
 
404
type ConTag = Int
 
405
 
 
406
fIRST_TAG :: ConTag
 
407
-- ^ Tags are allocated from here for real constructors
 
408
fIRST_TAG =  1
 
409
\end{code}
 
410
 
 
411
Note [Data con representation]
 
412
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
413
The dcRepType field contains the type of the representation of a contructor
 
414
This may differ from the type of the contructor *Id* (built
 
415
by MkId.mkDataConId) for two reasons:
 
416
        a) the constructor Id may be overloaded, but the dictionary isn't stored
 
417
           e.g.    data Eq a => T a = MkT a a
 
418
 
 
419
        b) the constructor may store an unboxed version of a strict field.
 
420
 
 
421
Here's an example illustrating both:
 
422
        data Ord a => T a = MkT Int! a
 
423
Here
 
424
        T :: Ord a => Int -> a -> T a
 
425
but the rep type is
 
426
        Trep :: Int# -> a -> T a
 
427
Actually, the unboxed part isn't implemented yet!
 
428
 
 
429
 
 
430
%************************************************************************
 
431
%*                                                                      *
 
432
\subsection{Instances}
 
433
%*                                                                      *
 
434
%************************************************************************
 
435
 
 
436
\begin{code}
 
437
instance Eq DataCon where
 
438
    a == b = getUnique a == getUnique b
 
439
    a /= b = getUnique a /= getUnique b
 
440
 
 
441
instance Ord DataCon where
 
442
    a <= b = getUnique a <= getUnique b
 
443
    a <  b = getUnique a <  getUnique b
 
444
    a >= b = getUnique a >= getUnique b
 
445
    a >  b = getUnique a > getUnique b
 
446
    compare a b = getUnique a `compare` getUnique b
 
447
 
 
448
instance Uniquable DataCon where
 
449
    getUnique = dcUnique
 
450
 
 
451
instance NamedThing DataCon where
 
452
    getName = dcName
 
453
 
 
454
instance Outputable DataCon where
 
455
    ppr con = ppr (dataConName con)
 
456
 
 
457
instance Show DataCon where
 
458
    showsPrec p con = showsPrecSDoc p (ppr con)
 
459
 
 
460
instance Data.Typeable DataCon where
 
461
    typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
 
462
 
 
463
instance Data.Data DataCon where
 
464
    -- don't traverse?
 
465
    toConstr _   = abstractConstr "DataCon"
 
466
    gunfold _ _  = error "gunfold"
 
467
    dataTypeOf _ = mkNoRepType "DataCon"
 
468
\end{code}
 
469
 
 
470
 
 
471
%************************************************************************
 
472
%*                                                                      *
 
473
\subsection{Construction}
 
474
%*                                                                      *
 
475
%************************************************************************
 
476
 
 
477
\begin{code}
 
478
-- | Build a new data constructor
 
479
mkDataCon :: Name 
 
480
          -> Bool               -- ^ Is the constructor declared infix?
 
481
          -> [HsBang]           -- ^ Strictness annotations written in the source file
 
482
          -> [FieldLabel]       -- ^ Field labels for the constructor, if it is a record, 
 
483
                                --   otherwise empty
 
484
          -> [TyVar]            -- ^ Universally quantified type variables
 
485
          -> [TyVar]            -- ^ Existentially quantified type variables
 
486
          -> [(TyVar,Type)]     -- ^ GADT equalities
 
487
          -> ThetaType          -- ^ Theta-type occuring before the arguments proper
 
488
          -> [Type]             -- ^ Original argument types
 
489
          -> Type               -- ^ Original result type
 
490
          -> TyCon              -- ^ Representation type constructor
 
491
          -> ThetaType          -- ^ The "stupid theta", context of the data declaration 
 
492
                                --   e.g. @data Eq a => T a ...@
 
493
          -> DataConIds         -- ^ The Ids of the actual builder functions
 
494
          -> DataCon
 
495
  -- Can get the tag from the TyCon
 
496
 
 
497
mkDataCon name declared_infix
 
498
          arg_stricts   -- Must match orig_arg_tys 1-1
 
499
          fields
 
500
          univ_tvs ex_tvs 
 
501
          eq_spec theta
 
502
          orig_arg_tys orig_res_ty rep_tycon
 
503
          stupid_theta ids
 
504
-- Warning: mkDataCon is not a good place to check invariants. 
 
505
-- If the programmer writes the wrong result type in the decl, thus:
 
506
--      data T a where { MkT :: S }
 
507
-- then it's possible that the univ_tvs may hit an assertion failure
 
508
-- if you pull on univ_tvs.  This case is checked by checkValidDataCon,
 
509
-- so the error is detected properly... it's just that asaertions here
 
510
-- are a little dodgy.
 
511
 
 
512
  = -- ASSERT( not (any isEqPred theta) )
 
513
        -- We don't currently allow any equality predicates on
 
514
        -- a data constructor (apart from the GADT ones in eq_spec)
 
515
    con
 
516
  where
 
517
    is_vanilla = null ex_tvs && null eq_spec && null theta
 
518
    con = MkData {dcName = name, dcUnique = nameUnique name, 
 
519
                  dcVanilla = is_vanilla, dcInfix = declared_infix,
 
520
                  dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, 
 
521
                  dcEqSpec = eq_spec, 
 
522
                  dcStupidTheta = stupid_theta, 
 
523
                  dcEqTheta = eq_theta, dcDictTheta = dict_theta,
 
524
                  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
 
525
                  dcRepTyCon = rep_tycon, 
 
526
                  dcRepArgTys = rep_arg_tys,
 
527
                  dcStrictMarks = arg_stricts, 
 
528
                  dcRepStrictness = rep_arg_stricts,
 
529
                  dcFields = fields, dcTag = tag, dcRepType = ty,
 
530
                  dcIds = ids }
 
531
 
 
532
        -- Strictness marks for source-args
 
533
        --      *after unboxing choices*, 
 
534
        -- but  *including existential dictionaries*
 
535
        -- 
 
536
        -- The 'arg_stricts' passed to mkDataCon are simply those for the
 
537
        -- source-language arguments.  We add extra ones for the
 
538
        -- dictionary arguments right here.
 
539
    (eq_theta,dict_theta)  = partition isEqPred theta
 
540
    dict_tys               = mkPredTys dict_theta
 
541
    real_arg_tys           = dict_tys ++ orig_arg_tys
 
542
    real_stricts           = map mk_dict_strict_mark dict_theta ++ arg_stricts
 
543
 
 
544
        -- Representation arguments and demands
 
545
        -- To do: eliminate duplication with MkId
 
546
    (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
 
547
 
 
548
    tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
 
549
    ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $ 
 
550
          mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
 
551
          mkFunTys (mkPredTys eq_theta) $
 
552
                -- NB:  the dict args are already in rep_arg_tys
 
553
                --      because they might be flattened..
 
554
                --      but the equality predicates are not
 
555
          mkFunTys rep_arg_tys $
 
556
          mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
 
557
 
 
558
eqSpecPreds :: [(TyVar,Type)] -> ThetaType
 
559
eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
 
560
 
 
561
mk_dict_strict_mark :: PredType -> HsBang
 
562
mk_dict_strict_mark pred | isStrictPred pred = HsStrict
 
563
                         | otherwise         = HsNoBang
 
564
\end{code}
 
565
 
 
566
\begin{code}
 
567
-- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
 
568
dataConName :: DataCon -> Name
 
569
dataConName = dcName
 
570
 
 
571
-- | The tag used for ordering 'DataCon's
 
572
dataConTag :: DataCon -> ConTag
 
573
dataConTag  = dcTag
 
574
 
 
575
-- | The type constructor that we are building via this data constructor
 
576
dataConTyCon :: DataCon -> TyCon
 
577
dataConTyCon = dcRepTyCon
 
578
 
 
579
-- | The original type constructor used in the definition of this data
 
580
-- constructor.  In case of a data family instance, that will be the family
 
581
-- type constructor.
 
582
dataConOrigTyCon :: DataCon -> TyCon
 
583
dataConOrigTyCon dc 
 
584
  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
 
585
  | otherwise                                          = dcRepTyCon dc
 
586
 
 
587
-- | The representation type of the data constructor, i.e. the sort
 
588
-- type that will represent values of this type at runtime
 
589
dataConRepType :: DataCon -> Type
 
590
dataConRepType = dcRepType
 
591
 
 
592
-- | Should the 'DataCon' be presented infix?
 
593
dataConIsInfix :: DataCon -> Bool
 
594
dataConIsInfix = dcInfix
 
595
 
 
596
-- | The universally-quantified type variables of the constructor
 
597
dataConUnivTyVars :: DataCon -> [TyVar]
 
598
dataConUnivTyVars = dcUnivTyVars
 
599
 
 
600
-- | The existentially-quantified type variables of the constructor
 
601
dataConExTyVars :: DataCon -> [TyVar]
 
602
dataConExTyVars = dcExTyVars
 
603
 
 
604
-- | Both the universal and existentiatial type variables of the constructor
 
605
dataConAllTyVars :: DataCon -> [TyVar]
 
606
dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
 
607
  = univ_tvs ++ ex_tvs
 
608
 
 
609
-- | Equalities derived from the result type of the data constructor, as written
 
610
-- by the programmer in any GADT declaration
 
611
dataConEqSpec :: DataCon -> [(TyVar,Type)]
 
612
dataConEqSpec = dcEqSpec
 
613
 
 
614
-- | The equational constraints on the data constructor type
 
615
dataConEqTheta :: DataCon -> ThetaType
 
616
dataConEqTheta = dcEqTheta
 
617
 
 
618
-- | The type class and implicit parameter contsraints on the data constructor type
 
619
dataConDictTheta :: DataCon -> ThetaType
 
620
dataConDictTheta = dcDictTheta
 
621
 
 
622
-- | Get the Id of the 'DataCon' worker: a function that is the "actual"
 
623
-- constructor and has no top level binding in the program. The type may
 
624
-- be different from the obvious one written in the source program. Panics
 
625
-- if there is no such 'Id' for this 'DataCon'
 
626
dataConWorkId :: DataCon -> Id
 
627
dataConWorkId dc = case dcIds dc of
 
628
                        DCIds _ wrk_id -> wrk_id
 
629
 
 
630
-- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"
 
631
-- constructor so it has the type visible in the source program: c.f. 'dataConWorkId'.
 
632
-- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor 
 
633
-- and also for a newtype (whose constructor is inlined compulsorily)
 
634
dataConWrapId_maybe :: DataCon -> Maybe Id
 
635
dataConWrapId_maybe dc = case dcIds dc of
 
636
                                DCIds mb_wrap _ -> mb_wrap
 
637
 
 
638
-- | Returns an Id which looks like the Haskell-source constructor by using
 
639
-- the wrapper if it exists (see 'dataConWrapId_maybe') and failing over to
 
640
-- the worker (see 'dataConWorkId')
 
641
dataConWrapId :: DataCon -> Id
 
642
dataConWrapId dc = case dcIds dc of
 
643
                        DCIds (Just wrap) _   -> wrap
 
644
                        DCIds Nothing     wrk -> wrk        -- worker=wrapper
 
645
 
 
646
-- | Find all the 'Id's implicitly brought into scope by the data constructor. Currently,
 
647
-- the union of the 'dataConWorkId' and the 'dataConWrapId'
 
648
dataConImplicitIds :: DataCon -> [Id]
 
649
dataConImplicitIds dc = case dcIds dc of
 
650
                          DCIds (Just wrap) work -> [wrap,work]
 
651
                          DCIds Nothing     work -> [work]
 
652
 
 
653
-- | The labels for the fields of this particular 'DataCon'
 
654
dataConFieldLabels :: DataCon -> [FieldLabel]
 
655
dataConFieldLabels = dcFields
 
656
 
 
657
-- | Extract the type for any given labelled field of the 'DataCon'
 
658
dataConFieldType :: DataCon -> FieldLabel -> Type
 
659
dataConFieldType con label
 
660
  = case lookup label (dcFields con `zip` dcOrigArgTys con) of
 
661
      Just ty -> ty
 
662
      Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
 
663
 
 
664
-- | The strictness markings decided on by the compiler.  Does not include those for
 
665
-- existential dictionaries.  The list is in one-to-one correspondence with the arity of the 'DataCon'
 
666
dataConStrictMarks :: DataCon -> [HsBang]
 
667
dataConStrictMarks = dcStrictMarks
 
668
 
 
669
-- | Strictness of /existential/ arguments only
 
670
dataConExStricts :: DataCon -> [HsBang]
 
671
-- Usually empty, so we don't bother to cache this
 
672
dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc
 
673
 
 
674
-- | Source-level arity of the data constructor
 
675
dataConSourceArity :: DataCon -> Arity
 
676
dataConSourceArity dc = length (dcOrigArgTys dc)
 
677
 
 
678
-- | Gives the number of actual fields in the /representation/ of the 
 
679
-- data constructor. This may be more than appear in the source code;
 
680
-- the extra ones are the existentially quantified dictionaries
 
681
dataConRepArity :: DataCon -> Int
 
682
dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
 
683
 
 
684
-- | Return whether there are any argument types for this 'DataCon's original source type
 
685
isNullarySrcDataCon :: DataCon -> Bool
 
686
isNullarySrcDataCon dc = null (dcOrigArgTys dc)
 
687
 
 
688
-- | Return whether there are any argument types for this 'DataCon's runtime representation type
 
689
isNullaryRepDataCon :: DataCon -> Bool
 
690
isNullaryRepDataCon dc = null (dcRepArgTys dc)
 
691
 
 
692
dataConRepStrictness :: DataCon -> [StrictnessMark]
 
693
-- ^ Give the demands on the arguments of a
 
694
-- Core constructor application (Con dc args)
 
695
dataConRepStrictness dc = dcRepStrictness dc
 
696
 
 
697
-- | The \"signature\" of the 'DataCon' returns, in order:
 
698
--
 
699
-- 1) The result of 'dataConAllTyVars',
 
700
--
 
701
-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
 
702
--    parameter - whatever)
 
703
--
 
704
-- 3) The type arguments to the constructor
 
705
--
 
706
-- 4) The /original/ result type of the 'DataCon'
 
707
dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
 
708
dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 
709
                    dcEqTheta  = eq_theta, dcDictTheta = dict_theta, 
 
710
                    dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
 
711
  = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ eq_theta ++ dict_theta, arg_tys, res_ty)
 
712
 
 
713
-- | The \"full signature\" of the 'DataCon' returns, in order:
 
714
--
 
715
-- 1) The result of 'dataConUnivTyVars'
 
716
--
 
717
-- 2) The result of 'dataConExTyVars'
 
718
--
 
719
-- 3) The result of 'dataConEqSpec'
 
720
--
 
721
-- 4) The result of 'dataConDictTheta'
 
722
--
 
723
-- 5) The original argument types to the 'DataCon' (i.e. before 
 
724
--    any change of the representation of the type)
 
725
--
 
726
-- 6) The original result type of the 'DataCon'
 
727
dataConFullSig :: DataCon 
 
728
               -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)
 
729
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 
730
                        dcEqTheta = eq_theta, dcDictTheta = dict_theta, 
 
731
                        dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
 
732
  = (univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, res_ty)
 
733
 
 
734
dataConOrigResTy :: DataCon -> Type
 
735
dataConOrigResTy dc = dcOrigResTy dc
 
736
 
 
737
-- | The \"stupid theta\" of the 'DataCon', such as @data Eq a@ in:
 
738
--
 
739
-- > data Eq a => T a = ...
 
740
dataConStupidTheta :: DataCon -> ThetaType
 
741
dataConStupidTheta dc = dcStupidTheta dc
 
742
 
 
743
dataConUserType :: DataCon -> Type
 
744
-- ^ The user-declared type of the data constructor
 
745
-- in the nice-to-read form:
 
746
--
 
747
-- > T :: forall a b. a -> b -> T [a]
 
748
--
 
749
-- rather than:
 
750
--
 
751
-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
 
752
--
 
753
-- NB: If the constructor is part of a data instance, the result type
 
754
-- mentions the family tycon, not the internal one.
 
755
dataConUserType  (MkData { dcUnivTyVars = univ_tvs, 
 
756
                           dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
 
757
                           dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys,
 
758
                           dcOrigResTy = res_ty })
 
759
  = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
 
760
    mkFunTys (mkPredTys eq_theta) $
 
761
    mkFunTys (mkPredTys dict_theta) $
 
762
    mkFunTys arg_tys $
 
763
    res_ty
 
764
 
 
765
-- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation
 
766
-- NB: these INCLUDE any dictionary args
 
767
--     but EXCLUDE the data-declaration context, which is discarded
 
768
-- It's all post-flattening etc; this is a representation type
 
769
dataConInstArgTys :: DataCon    -- ^ A datacon with no existentials or equality constraints
 
770
                                -- However, it can have a dcTheta (notably it can be a 
 
771
                                -- class dictionary, with superclasses)
 
772
                  -> [Type]     -- ^ Instantiated at these types
 
773
                  -> [Type]
 
774
dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys, 
 
775
                              dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
 
776
                              dcExTyVars = ex_tvs}) inst_tys
 
777
 = ASSERT2 ( length univ_tvs == length inst_tys 
 
778
           , ptext (sLit "dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
 
779
   ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )        
 
780
   map (substTyWith univ_tvs inst_tys) rep_arg_tys
 
781
 
 
782
-- | Returns just the instantiated /value/ argument types of a 'DataCon',
 
783
-- (excluding dictionary args)
 
784
dataConInstOrigArgTys 
 
785
        :: DataCon      -- Works for any DataCon
 
786
        -> [Type]       -- Includes existential tyvar args, but NOT
 
787
                        -- equality constraints or dicts
 
788
        -> [Type]
 
789
-- For vanilla datacons, it's all quite straightforward
 
790
-- But for the call in MatchCon, we really do want just the value args
 
791
dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
 
792
                                  dcUnivTyVars = univ_tvs, 
 
793
                                  dcExTyVars = ex_tvs}) inst_tys
 
794
  = ASSERT2( length tyvars == length inst_tys
 
795
          , ptext (sLit "dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
 
796
    map (substTyWith tyvars inst_tys) arg_tys
 
797
  where
 
798
    tyvars = univ_tvs ++ ex_tvs
 
799
\end{code}
 
800
 
 
801
\begin{code}
 
802
-- | Returns the argument types of the wrapper, excluding all dictionary arguments
 
803
-- and without substituting for any type variables
 
804
dataConOrigArgTys :: DataCon -> [Type]
 
805
dataConOrigArgTys dc = dcOrigArgTys dc
 
806
 
 
807
-- | Returns the arg types of the worker, including all dictionaries, after any 
 
808
-- flattening has been done and without substituting for any type variables
 
809
dataConRepArgTys :: DataCon -> [Type]
 
810
dataConRepArgTys dc = dcRepArgTys dc
 
811
\end{code}
 
812
 
 
813
\begin{code}
 
814
-- | The string @package:module.name@ identifying a constructor, which is attached
 
815
-- to its info table and used by the GHCi debugger and the heap profiler
 
816
dataConIdentity :: DataCon -> [Word8]
 
817
-- We want this string to be UTF-8, so we get the bytes directly from the FastStrings.
 
818
dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++ 
 
819
                  fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
 
820
                  fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
 
821
  where name = dataConName dc
 
822
        mod  = ASSERT( isExternalName name ) nameModule name
 
823
\end{code}
 
824
 
 
825
\begin{code}
 
826
isTupleCon :: DataCon -> Bool
 
827
isTupleCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
 
828
        
 
829
isUnboxedTupleCon :: DataCon -> Bool
 
830
isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
 
831
 
 
832
-- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors
 
833
isVanillaDataCon :: DataCon -> Bool
 
834
isVanillaDataCon dc = dcVanilla dc
 
835
\end{code}
 
836
 
 
837
\begin{code}
 
838
classDataCon :: Class -> DataCon
 
839
classDataCon clas = case tyConDataCons (classTyCon clas) of
 
840
                      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr 
 
841
                      [] -> panic "classDataCon"
 
842
\end{code}
 
843
 
 
844
%************************************************************************
 
845
%*                                                                      *
 
846
\subsection{Splitting products}
 
847
%*                                                                      *
 
848
%************************************************************************
 
849
 
 
850
\begin{code}
 
851
-- | Extract the type constructor, type argument, data constructor and it's
 
852
-- /representation/ argument types from a type if it is a product type.
 
853
--
 
854
-- Precisely, we return @Just@ for any type that is all of:
 
855
--
 
856
--  * Concrete (i.e. constructors visible)
 
857
--
 
858
--  * Single-constructor
 
859
--
 
860
--  * Not existentially quantified
 
861
--
 
862
-- Whether the type is a @data@ type or a @newtype@
 
863
splitProductType_maybe
 
864
        :: Type                         -- ^ A product type, perhaps
 
865
        -> Maybe (TyCon,                -- The type constructor
 
866
                  [Type],               -- Type args of the tycon
 
867
                  DataCon,              -- The data constructor
 
868
                  [Type])               -- Its /representation/ arg types
 
869
 
 
870
        -- Rejecing existentials is conservative.  Maybe some things
 
871
        -- could be made to work with them, but I'm not going to sweat
 
872
        -- it through till someone finds it's important.
 
873
 
 
874
splitProductType_maybe ty
 
875
  = case splitTyConApp_maybe ty of
 
876
        Just (tycon,ty_args)
 
877
           | isProductTyCon tycon       -- Includes check for non-existential,
 
878
                                        -- and for constructors visible
 
879
           -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
 
880
           where
 
881
              data_con = ASSERT( not (null (tyConDataCons tycon)) ) 
 
882
                         head (tyConDataCons tycon)
 
883
        _other -> Nothing
 
884
 
 
885
-- | As 'splitProductType_maybe', but panics if the 'Type' is not a product type
 
886
splitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
 
887
splitProductType str ty
 
888
  = case splitProductType_maybe ty of
 
889
        Just stuff -> stuff
 
890
        Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
 
891
 
 
892
 
 
893
-- | As 'splitProductType_maybe', but in turn instantiates the 'TyCon' returned
 
894
-- and hence recursively tries to unpack it as far as it able to
 
895
deepSplitProductType_maybe :: Type -> Maybe (TyCon, [Type], DataCon, [Type])
 
896
deepSplitProductType_maybe ty
 
897
  = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
 
898
       ; let {result 
 
899
             | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
 
900
             , not (isRecursiveTyCon tycon)
 
901
             = deepSplitProductType_maybe ty'   -- Ignore the coercion?
 
902
             | isNewTyCon tycon = Nothing  -- cannot unbox through recursive
 
903
                                           -- newtypes nor through families
 
904
             | otherwise = Just res}
 
905
       ; result
 
906
       }
 
907
 
 
908
-- | As 'deepSplitProductType_maybe', but panics if the 'Type' is not a product type
 
909
deepSplitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
 
910
deepSplitProductType str ty 
 
911
  = case deepSplitProductType_maybe ty of
 
912
      Just stuff -> stuff
 
913
      Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
 
914
 
 
915
-- | Compute the representation type strictness and type suitable for a 'DataCon'
 
916
computeRep :: [HsBang]                  -- ^ Original argument strictness
 
917
           -> [Type]                    -- ^ Original argument types
 
918
           -> ([StrictnessMark],        -- Representation arg strictness
 
919
               [Type])                  -- And type
 
920
 
 
921
computeRep stricts tys
 
922
  = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
 
923
  where
 
924
    unbox HsNoBang       ty = [(NotMarkedStrict, ty)]
 
925
    unbox HsStrict       ty = [(MarkedStrict,    ty)]
 
926
    unbox HsUnpackFailed ty = [(MarkedStrict,    ty)]
 
927
    unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
 
928
                      where
 
929
                        (_tycon, _tycon_args, arg_dc, arg_tys) 
 
930
                           = deepSplitProductType "unbox_strict_arg_ty" ty
 
931
\end{code}