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