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