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