DataCon.lhs 29.3 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
4
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%
5
\section[DataCon]{@DataCon@: Data Constructors}
6
7
8

\begin{code}
module DataCon (
9
	DataCon, DataConIds(..),
10
11
	ConTag, fIRST_TAG,
	mkDataCon,
12
	dataConRepType, dataConSig, dataConFullSig,
13
	dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
14
	dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, 
15
	dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta, dataConStupidTheta, 
16
	dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
17
18
	dataConInstOrigArgTys, dataConInstOrigDictsAndArgTys,
	dataConRepArgTys, 
19
20
	dataConFieldLabels, dataConFieldType,
	dataConStrictMarks, dataConExStricts,
21
	dataConSourceArity, dataConRepArity,
22
	dataConIsInfix,
23
	dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
24
	dataConRepStrictness,
25
26
	isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
	isVanillaDataCon, classDataCon, 
27

28
29
	splitProductType_maybe, splitProductType, deepSplitProductType,
        deepSplitProductType_maybe
30
31
32
33
    ) where

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
34
35
36
37
38
39
40
import Type
import Coercion
import TyCon
import Class
import Name
import Var
import BasicTypes
41
import Outputable
Simon Marlow's avatar
Simon Marlow committed
42
43
44
45
import Unique
import ListSetOps
import Util
import Maybes
46
import FastString
47
48
49
50
import Module

import Data.Char
import Data.Word
51
import Data.List ( partition )
52
53
54
\end{code}


55
56
57
Data constructor representation
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the following Haskell data type declaration
58

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
	data T = T !Int ![Int]

Using the strictness annotations, GHC will represent this as

	data T = T Int# [Int]

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

	T e1 e2

is translated to

	case e1 of { I# x -> 
	case e2 of { r ->
	T x r }}

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

	case e of { T a b -> ... }

becomes

	case e of { T a' b -> let a = I# a' in ... }

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


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

92
			     OccName	Name space	Name of
93
  ---------------------------------------------------------------------------
94
95
96
97
98
99
100
101
102
103
  * The "data con itself" 	C	DataName	DataCon
  * The "worker data con"	C	VarName		Id (the worker)
  * The "wrapper data con"	$WC	VarName		Id (the wrapper)
  * The "newtype coercion"      :CoT    TcClsName	TyCon
 
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
104
105
106
107
108
109
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:

110
111
The "worker Id", is the actual data constructor.
* Every data constructor (newtype or data type) has a worker
112

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

115
116
* For a *data* type, the worker *is* the data constructor;
  it has no unfolding
117

118
119
120
121
122
123
124
* For a *newtype*, the worker has a compulsory unfolding which 
  does a cast, e.g.
	newtype T = MkT Int
	The worker for MkT has unfolding
		\(x:Int). x `cast` sym CoT
  Here CoT is the type constructor, witnessing the FC axiom
	axiom CoT : T = Int
125

126
127
128
129
130
131
132
133
134
135
136
The "wrapper Id", $WC, goes as follows

* Its type is exactly what it looks like in the source program. 

* It is an ordinary function, and it gets a top-level binding 
  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
	$wC = C

137
138
Note [The need for a wrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Why might the wrapper have anything to do?  Two reasons:

* Unboxing strict fields (with -funbox-strict-fields)
	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 
  just one.  That is, the worker has type
		MkT :: Int -> Int -> T

* Equality constraints for GADTs
	data T a where { MkT :: a -> T [a] }

  The worker gets a type with explicit equality
  constraints, thus:
	MkT :: forall a b. (a=[b]) => b -> T a

  The wrapper has the programmer-specified type:
	$wMkT :: a -> T [a]
	$wMkT a x = MkT [a] a [a] x
  The third argument is a coerion
	[a] :: [a]:=:[a]
161

162
163
INVARIANT: the dictionary constructor for a class
	   never has a wrapper.
164
165


166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
A note about the stupid context
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Data types can have a context:
	
	data (Eq a, Ord b) => T a b = T1 a b | T2 a

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

	T1 :: (Eq a, Ord b) => a -> b -> T a b
	T2 :: (Eq a) => a -> T a b

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):

	f (T2 x) = x
gets inferred type
	f :: Eq a => T a b -> a

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.

190
191
192
193
194
195
196
197
198
	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).

	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.
199

200
201
202
203
204
205
	[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.]
206

207
208
209
210
[July 04] With the advent of generalised data types, it's less obvious
what the "stupid context" is.  Consider
	C :: forall a. Ord a => a -> a -> T (Foo a)
Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
211

212
213
214
215
	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
216

217
Note that (Foo a) might not be an instance of Ord.
218

219
220
221
222
223
224
225
226
%************************************************************************
%*									*
\subsection{Data constructors}
%*									*
%************************************************************************

\begin{code}
data DataCon
227
  = MkData {
228
229
	dcName    :: Name,	-- This is the name of the *source data con*
				-- (see "Note [Data Constructor Naming]" above)
230
	dcUnique :: Unique, 	-- Cached from Name
231
	dcTag    :: ConTag,
232
233
234

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

239
240
	-- 	*** As represented internally
	--  data T a where
241
	--    MkT :: forall a. forall x y. (a:=:(x,y),x~y,Ord x) => x -> y -> T a
242
	-- 
243
244
245
	-- The next six fields express the type of the constructor, in pieces
	-- e.g.
	--
246
247
248
	--	dcUnivTyVars  = [a]
	--	dcExTyVars    = [x,y]
	--	dcEqSpec      = [a:=:(x,y)]
249
250
	--	dcEqTheta     = [x~y]	
	--	dcDictTheta   = [Ord x]
251
	--	dcOrigArgTys  = [a,List b]
252
	--	dcRepTyCon       = T
253
254
255
256

	dcVanilla :: Bool,	-- True <=> This is a vanilla Haskell 98 data constructor
				--	    Its type is of form
				--	        forall a1..an . t1 -> ... tm -> T a1..an
257
				-- 	    No existentials, no coercions, nothing.
258
				-- That is: dcExTyVars = dcEqSpec = dcEqTheta = dcDictTheta = []
259
260
261
262
263
264
		-- 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)

	dcUnivTyVars :: [TyVar],	-- Universally-quantified type vars 
265
266
					-- INVARIANT: length matches arity of the dcRepTyCon

267
268
	dcExTyVars   :: [TyVar],	-- Existentially-quantified type vars 
		-- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
269
270
271
272
		-- 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.]
273

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

277
278
279
280
281
282
283
284
285
	dcEqSpec :: [(TyVar,Type)],	-- Equalities derived from the result type, 
					-- *as written by the programmer*
		-- 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
					
286
287
288
		-- The next two fields give the type context of the data constructor
		-- 	(aside from the GADT constraints, 
		--	 which are given by the dcExpSpec)
289
290
		-- In GADT form, this is *exactly* what the programmer writes, even if
		-- the context constrains only universally quantified variables
291
292
293
		--	MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
	dcEqTheta   :: ThetaType,  -- The *equational* constraints
	dcDictTheta :: ThetaType,  -- The *type-class and implicit-param* constraints
294
295
296
297

	dcStupidTheta :: ThetaType,	-- The context of the data type declaration 
					--	data Eq a => T a = ...
					-- or, rather, a "thinned" version thereof
298
299
300
301
		-- "Thinned", because the Report says
		-- to eliminate any constraints that don't mention
		-- tyvars free in the arg types for this constructor
		--
302
303
		-- INVARIANT: the free tyvars of dcStupidTheta are a subset of dcUnivTyVars
		-- Reason: dcStupidTeta is gotten by thinning the stupid theta from the tycon
304
		-- 
305
306
307
308
		-- "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.
309

310
	dcOrigArgTys :: [Type],		-- Original argument types
311
					-- (before unboxing and flattening of strict fields)
312
313
314
315
316
	dcOrigResTy :: Type,		-- Original result type
		-- 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
317

318
	-- Now the strictness annotations and field labels of the constructor
319
	dcStrictMarks :: [StrictnessMark],
320
321
322
		-- Strictness annotations as decided by the compiler.  
		-- Does *not* include the existential dictionaries
		-- length = dataConSourceArity dataCon
323
324
325

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

329
330
331
332
333
	-- Constructor representation
	dcRepArgTys :: [Type],		-- Final, representation argument types, 
					-- after unboxing and flattening,
					-- and *including* existential dictionaries

334
	dcRepStrictness :: [StrictnessMark],	-- One for each *representation* argument	
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
335
		-- See also Note [Data-con worker strictness] in MkId.lhs
336

337
338
339
	-- Result type of constructor is T t1..tn
	dcRepTyCon  :: TyCon,		-- Result tycon, T

340
	dcRepType   :: Type,	-- Type of the constructor
341
342
				-- 	forall a x y. (a:=:(x,y), x~y, Ord x) =>
                                --        x -> y -> T a
343
				-- (this is *not* of the constructor wrapper Id:
344
				--  see Note [Data con representation] below)
345
346
	-- Notice that the existential type parameters come *second*.  
	-- Reason: in a case expression we may find:
347
348
	--	case (e :: T t) of
        --        MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
349
	-- It's convenient to apply the rep-type of MkT to 't', to get
350
	--	forall x y. (t:=:(x,y), x~y, Ord x) => x -> y -> T t
351
	-- and use that to check the pattern.  Mind you, this is really only
352
	-- used in CoreLint.
353
354


355
	-- The curried worker function that corresponds to the constructor:
356
357
358
359
	-- It doesn't have an unfolding; the code generator saturates these Ids
	-- and allocates a real constructor when it finds one.
	--
	-- An entirely separate wrapper function is built in TcTyDecls
360
361
	dcIds :: DataConIds,

362
	dcInfix :: Bool		-- True <=> declared infix
363
364
				-- Used for Template Haskell and 'deriving' only
				-- The actual fixity is stored elsewhere
365
366
  }

367
data DataConIds
368
  = DCIds (Maybe Id) Id 	-- Algebraic data types always have a worker, and
369
				-- may or may not have a wrapper, depending on whether
370
				-- the wrapper does anything.  Newtypes just have a worker
371

372
	-- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
373
374
375
376
377

	-- The wrapper takes dcOrigArgTys as its arguments
	-- The worker takes dcRepArgTys as its arguments
	-- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys

378
	-- The 'Nothing' case of DCIds is important
379
380
	-- Not only is this efficient,
	-- but it also ensures that the wrapper is replaced
381
	-- by the worker (because it *is* the worker)
382
383
384
385
386
387
388
389
	-- even when there are no args. E.g. in
	-- 		f (:) x
	-- 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.)

390
391
392
393
394
395
type ConTag = Int

fIRST_TAG :: ConTag
fIRST_TAG =  1	-- Tags allocated from here for real constructors
\end{code}

396
397
Note [Data con representation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
398
The dcRepType field contains the type of the representation of a contructor
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
This may differ from the type of the contructor *Id* (built
by MkId.mkDataConId) for two reasons:
	a) the constructor Id may be overloaded, but the dictionary isn't stored
	   e.g.    data Eq a => T a = MkT a a

	b) the constructor may store an unboxed version of a strict field.

Here's an example illustrating both:
	data Ord a => T a = MkT Int! a
Here
	T :: Ord a => Int -> a -> T a
but the rep type is
	Trep :: Int# -> a -> T a
Actually, the unboxed part isn't implemented yet!


415
416
417
418
419
420
%************************************************************************
%*									*
\subsection{Instances}
%*									*
%************************************************************************

421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
\begin{code}
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
    a <	 b = getUnique a <  getUnique b
    a >= b = getUnique a >= getUnique b
    a >	 b = getUnique a > getUnique b
    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)

instance Show DataCon where
    showsPrec p con = showsPrecSDoc p (ppr con)
\end{code}

446
447
448

%************************************************************************
%*									*
449
\subsection{Construction}
450
451
452
%*									*
%************************************************************************

453
\begin{code}
454
mkDataCon :: Name 
455
	  -> Bool	-- Declared infix
456
	  -> [StrictnessMark] -> [FieldLabel]
457
458
459
460
	  -> [TyVar] -> [TyVar] 
	  -> [(TyVar,Type)] -> ThetaType
	  -> [Type] -> TyCon
	  -> ThetaType -> DataConIds
461
462
463
	  -> DataCon
  -- Can get the tag from the TyCon

464
mkDataCon name declared_infix
465
	  arg_stricts	-- Must match orig_arg_tys 1-1
466
	  fields
467
468
469
470
	  univ_tvs ex_tvs 
	  eq_spec theta
	  orig_arg_tys tycon
	  stupid_theta ids
471
472
473
474
475
476
477
478
-- Warning: mkDataCon is not a good place to check invariants. 
-- If the programmer writes the wrong result type in the decl, thus:
--	data T a where { MkT :: S }
-- 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.

479
  = -- ASSERT( not (any isEqPred theta) )
480
481
482
	-- We don't currently allow any equality predicates on
	-- a data constructor (apart from the GADT ones in eq_spec)
    con
483
  where
484
    is_vanilla = null ex_tvs && null eq_spec && null theta
485
    con = MkData {dcName = name, dcUnique = nameUnique name, 
486
487
488
		  dcVanilla = is_vanilla, dcInfix = declared_infix,
	  	  dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, 
		  dcEqSpec = eq_spec, 
489
490
		  dcStupidTheta = stupid_theta, 
		  dcEqTheta = eq_theta, dcDictTheta = dict_theta,
491
492
		  dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
		  dcRepTyCon = tycon, 
493
		  dcRepArgTys = rep_arg_tys,
494
495
		  dcStrictMarks = arg_stricts, 
		  dcRepStrictness = rep_arg_stricts,
496
		  dcFields = fields, dcTag = tag, dcRepType = ty,
497
		  dcIds = ids }
498

499
500
501
	-- Strictness marks for source-args
	--	*after unboxing choices*, 
	-- but  *including existential dictionaries*
502
503
504
505
	-- 
	-- The 'arg_stricts' passed to mkDataCon are simply those for the
	-- source-language arguments.  We add extra ones for the
	-- dictionary arguments right here.
506
507
508
509
    (eq_theta,dict_theta)  = partition isEqPred theta
    dict_tys     	   = mkPredTys dict_theta
    real_arg_tys 	   = dict_tys ++ orig_arg_tys
    real_stricts 	   = map mk_dict_strict_mark dict_theta ++ arg_stricts
510

511
	-- Example
512
513
514
	--   data instance T (b,c) where 
	--	TI :: forall e. e -> T (e,e)
	--
515
	-- The representation tycon looks like this:
516
517
	--   data :R7T b c where 
	--	TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
518
	-- In this case orig_res_ty = T (e,e)
519
    orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)
520

521
	-- Representation arguments and demands
522
	-- To do: eliminate duplication with MkId
523
    (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
524
525

    tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
526
527
    ty  = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $ 
	  mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
528
	  mkFunTys (mkPredTys eq_theta) $
529
530
531
532
533
		-- NB:	the dict args are already in rep_arg_tys
		--	because they might be flattened..
		--	but the equality predicates are not
	  mkFunTys rep_arg_tys $
	  mkTyConApp tycon (mkTyVarTys univ_tvs)
534

535
536
eqSpecPreds :: [(TyVar,Type)] -> ThetaType
eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
537

Simon Marlow's avatar
Simon Marlow committed
538
mk_dict_strict_mark :: PredType -> StrictnessMark
539
540
mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
		         | otherwise	     = NotMarkedStrict
541
542
543
544
545
546
547
548
549
550
\end{code}

\begin{code}
dataConName :: DataCon -> Name
dataConName = dcName

dataConTag :: DataCon -> ConTag
dataConTag  = dcTag

dataConTyCon :: DataCon -> TyCon
551
dataConTyCon = dcRepTyCon
552

553
554
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
555

556
557
558
dataConIsInfix :: DataCon -> Bool
dataConIsInfix = dcInfix

559
560
561
562
563
564
565
566
567
568
569
570
571
dataConUnivTyVars :: DataCon -> [TyVar]
dataConUnivTyVars = dcUnivTyVars

dataConExTyVars :: DataCon -> [TyVar]
dataConExTyVars = dcExTyVars

dataConAllTyVars :: DataCon -> [TyVar]
dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
  = univ_tvs ++ ex_tvs

dataConEqSpec :: DataCon -> [(TyVar,Type)]
dataConEqSpec = dcEqSpec

572
573
574
575
576
dataConEqTheta :: DataCon -> ThetaType
dataConEqTheta = dcEqTheta

dataConDictTheta :: DataCon -> ThetaType
dataConDictTheta = dcDictTheta
577

578
dataConWorkId :: DataCon -> Id
579
dataConWorkId dc = case dcIds dc of
580
			DCIds _ wrk_id -> wrk_id
581

582
dataConWrapId_maybe :: DataCon -> Maybe Id
583
584
-- Returns Nothing if there is no wrapper for an algebraic data con
--		   and also for a newtype (whose constructor is inlined compulsorily)
585
dataConWrapId_maybe dc = case dcIds dc of
586
				DCIds mb_wrap _ -> mb_wrap
587

588
dataConWrapId :: DataCon -> Id
589
-- Returns an Id which looks like the Haskell-source constructor
590
dataConWrapId dc = case dcIds dc of
591
592
			DCIds (Just wrap) _   -> wrap
			DCIds Nothing     wrk -> wrk	    -- worker=wrapper
593
594
595

dataConImplicitIds :: DataCon -> [Id]
dataConImplicitIds dc = case dcIds dc of
596
597
			  DCIds (Just wrap) work -> [wrap,work]
			  DCIds Nothing     work -> [work]
598
599
600
601

dataConFieldLabels :: DataCon -> [FieldLabel]
dataConFieldLabels = dcFields

602
603
604
605
dataConFieldType :: DataCon -> FieldLabel -> Type
dataConFieldType con label = expectJust "unexpected label" $
    lookup label (dcFields con `zip` dcOrigArgTys con)

606
dataConStrictMarks :: DataCon -> [StrictnessMark]
607
dataConStrictMarks = dcStrictMarks
608

609
610
611
dataConExStricts :: DataCon -> [StrictnessMark]
-- Strictness of *existential* arguments only
-- Usually empty, so we don't bother to cache this
612
dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc
613

614
615
dataConSourceArity :: DataCon -> Arity
	-- Source-level arity of the data constructor
616
dataConSourceArity dc = length (dcOrigArgTys dc)
617

618
619
620
621
-- dataConRepArity gives the number of actual fields in the
-- {\em representation} of the data constructor.  This may be more than appear
-- in the source code; the extra ones are the existentially quantified
-- dictionaries
Simon Marlow's avatar
Simon Marlow committed
622
dataConRepArity :: DataCon -> Int
623
624
dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys

625
626
627
isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
isNullarySrcDataCon dc = null (dcOrigArgTys dc)
isNullaryRepDataCon dc = null (dcRepArgTys dc)
628

629
dataConRepStrictness :: DataCon -> [StrictnessMark]
630
	-- Give the demands on the arguments of a
631
	-- Core constructor application (Con dc args)
632
dataConRepStrictness dc = dcRepStrictness dc
633

634
dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
635
dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
636
637
		    dcEqTheta  = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
  = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ eq_theta ++ dict_theta, arg_tys, res_ty)
638

639
dataConFullSig :: DataCon 
640
	       -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)
641
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
642
643
			dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
  = (univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, res_ty)
644
645
646

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

648
649
650
dataConStupidTheta :: DataCon -> ThetaType
dataConStupidTheta dc = dcStupidTheta dc

651
652
653
dataConUserType :: DataCon -> Type
-- The user-declared type of the data constructor
-- in the nice-to-read form 
654
--	T :: forall a b. a -> b -> T [a]
655
-- rather than
656
--	T :: forall a c. forall b. (c=[a]) => a -> b -> T c
657
658
-- NB: If the constructor is part of a data instance, the result type
-- mentions the family tycon, not the internal one.
659
660
dataConUserType  (MkData { dcUnivTyVars = univ_tvs, 
			   dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
661
			   dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys,
662
			   dcOrigResTy = res_ty })
663
  = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
664
665
    mkFunTys (mkPredTys eq_theta) $
    mkFunTys (mkPredTys dict_theta) $
666
    mkFunTys arg_tys $
667
    res_ty
668

669
670
671
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)
672
673
	      	  -> [Type] 	-- Instantiated at these types
	      	  -> [Type]	-- Needs arguments of these types
674
				-- NB: these INCLUDE any dict args
675
				--     but EXCLUDE the data-decl context which is discarded
676
				-- It's all post-flattening etc; this is a representation type
677
678
dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys, 
			      dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
mnislaih's avatar
mnislaih committed
679
			      dcExTyVars = ex_tvs}) inst_tys
680
681
682
683
684
685
686
687
688
689
690
691
 = ASSERT2 ( length univ_tvs == length inst_tys 
           , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
   ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )        
   map (substTyWith univ_tvs inst_tys) rep_arg_tys

dataConInstOrigArgTys 
	:: DataCon	-- Works for any DataCon
	-> [Type]	-- Includes existential tyvar args, but NOT
			-- equality constraints or dicts
	-> [Type]	-- Returns just the instsantiated *value* arguments
-- For vanilla datacons, it's all quite straightforward
-- But for the call in MatchCon, we really do want just the value args
692
dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
mnislaih's avatar
mnislaih committed
693
694
			          dcUnivTyVars = univ_tvs, 
			          dcExTyVars = ex_tvs}) inst_tys
695
  = ASSERT2( length tyvars == length inst_tys
mnislaih's avatar
mnislaih committed
696
          , ptext SLIT("dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
697
698
699
    map (substTyWith tyvars inst_tys) arg_tys
  where
    tyvars = univ_tvs ++ ex_tvs
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714

dataConInstOrigDictsAndArgTys 
	:: DataCon	-- Works for any DataCon
	-> [Type]	-- Includes existential tyvar args, but NOT
			-- equality constraints or dicts
	-> [Type]	-- Returns just the instsantiated dicts and *value* arguments
dataConInstOrigDictsAndArgTys dc@(MkData {dcOrigArgTys = arg_tys,
				  dcDictTheta = dicts,       
			          dcUnivTyVars = univ_tvs, 
			          dcExTyVars = ex_tvs}) inst_tys
  = ASSERT2( length tyvars == length inst_tys
          , ptext SLIT("dataConInstOrigDictsAndArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
    map (substTyWith tyvars inst_tys) (mkPredTys dicts ++ arg_tys)
  where
    tyvars = univ_tvs ++ ex_tvs
715
716
\end{code}

717
These two functions get the real argument types of the constructor,
718
without substituting for any type variables.
719
720
721
722
723

dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.

dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
after any flattening has been done.
724
725

\begin{code}
726
727
728
dataConOrigArgTys :: DataCon -> [Type]
dataConOrigArgTys dc = dcOrigArgTys dc

729
dataConRepArgTys :: DataCon -> [Type]
730
dataConRepArgTys dc = dcRepArgTys dc
731
732
\end{code}

733
734
735
736
737
738
739
740
741
742
743
744
745
The string <package>:<module>.<name> identifying a constructor, which is attached
to its info table and used by the GHCi debugger and the heap profiler.  We want
this string to be UTF-8, so we get the bytes directly from the FastStrings.

\begin{code}
dataConIdentity :: DataCon -> [Word8]
dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++ 
                  fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
                  fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
  where name = dataConName dc
        mod  = nameModule name
\end{code}

746
747
748

\begin{code}
isTupleCon :: DataCon -> Bool
749
isTupleCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
750
751
	
isUnboxedTupleCon :: DataCon -> Bool
752
isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
753

754
755
isVanillaDataCon :: DataCon -> Bool
isVanillaDataCon dc = dcVanilla dc
756
\end{code}
757
758


759
760
761
762
\begin{code}
classDataCon :: Class -> DataCon
classDataCon clas = case tyConDataCons (classTyCon clas) of
		      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr 
763
		      [] -> panic "classDataCon"
764
765
\end{code}

766
767
768
769
770
771
%************************************************************************
%*									*
\subsection{Splitting products}
%*									*
%************************************************************************

772
\begin{code}
773
774
775
776
777
778
779
splitProductType_maybe
	:: Type 			-- A product type, perhaps
	-> Maybe (TyCon, 		-- The type constructor
		  [Type],		-- Type args of the tycon
		  DataCon,		-- The data constructor
		  [Type])		-- Its *representation* arg types

780
	-- Returns (Just ...) for any
781
	--	concrete (i.e. constructors visible)
782
783
784
785
786
787
788
789
790
	--	single-constructor
	--	not existentially quantified
	-- type whether a data type or a new type
	--
	-- Rejecing existentials is conservative.  Maybe some things
	-- could be made to work with them, but I'm not going to sweat
	-- it through till someone finds it's important.

splitProductType_maybe ty
791
  = case splitTyConApp_maybe ty of
792
	Just (tycon,ty_args)
793
794
	   | isProductTyCon tycon  	-- Includes check for non-existential,
					-- and for constructors visible
795
	   -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
796
	   where
797
798
	      data_con = ASSERT( not (null (tyConDataCons tycon)) ) 
			 head (tyConDataCons tycon)
Simon Marlow's avatar
Simon Marlow committed
799
	_other -> Nothing
800

Simon Marlow's avatar
Simon Marlow committed
801
splitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
802
803
804
splitProductType str ty
  = case splitProductType_maybe ty of
	Just stuff -> stuff
805
	Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
806
807


Simon Marlow's avatar
Simon Marlow committed
808
deepSplitProductType_maybe :: Type -> Maybe (TyCon, [Type], DataCon, [Type])
809
810
811
deepSplitProductType_maybe ty
  = do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
       ; let {result 
812
813
814
             | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
	     , not (isRecursiveTyCon tycon)
             = deepSplitProductType_maybe ty'	-- Ignore the coercion?
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
815
816
             | isNewTyCon tycon = Nothing  -- cannot unbox through recursive
					   -- newtypes nor through families
817
818
819
820
             | otherwise = Just res}
       ; result
       }
          
Simon Marlow's avatar
Simon Marlow committed
821
deepSplitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
822
823
824
825
826
deepSplitProductType str ty 
  = case deepSplitProductType_maybe ty of
      Just stuff -> stuff
      Nothing -> pprPanic (str ++ ": not a product") (pprType ty)

827
828
829
830
computeRep :: [StrictnessMark]		-- Original arg strictness
	   -> [Type]			-- and types
	   -> ([StrictnessMark],	-- Representation arg strictness
	       [Type])			-- And type
831

832
833
computeRep stricts tys
  = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
834
  where
835
836
837
    unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
    unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
    unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
838
                               where
839
                                 (_tycon, _tycon_args, arg_dc, arg_tys) 
840
                                     = deepSplitProductType "unbox_strict_arg_ty" ty
841
\end{code}