2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[DataCon]{@DataCon@: Data Constructors}
11 dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
12 dataConArgTys, dataConOrigArgTys, dataConInstOrigArgTys,
13 dataConRepArgTys, dataConTheta,
14 dataConFieldLabels, dataConStrictMarks,
15 dataConSourceArity, dataConRepArity,
16 dataConNumInstArgs, dataConWorkId, dataConWrapId, dataConRepStrictness,
17 isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
18 isExistentialDataCon, classDataCon, dataConExistentialTyVars,
20 splitProductType_maybe, splitProductType,
23 #include "HsVersions.h"
25 import {-# SOURCE #-} Subst( substTyWith )
26 import {-# SOURCE #-} PprType( pprType )
28 import Type ( Type, ThetaType,
29 mkForAllTys, mkFunTys, mkTyConApp,
30 mkTyVarTys, splitTyConApp_maybe, repType,
31 mkPredTys, isStrictType
33 import TyCon ( TyCon, tyConDataCons, tyConDataCons, isProductTyCon,
34 isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
35 import Class ( Class, classTyCon )
36 import Name ( Name, NamedThing(..), nameUnique )
37 import Var ( TyVar, Id )
38 import FieldLabel ( FieldLabel )
39 import BasicTypes ( Arity, StrictnessMark(..) )
41 import Unique ( Unique, Uniquable(..) )
42 import CmdLineOpts ( opt_UnboxStrictFields )
44 import ListSetOps ( assoc )
45 import Util ( zipEqual, zipWithEqual, equalLength )
49 Stuff about data constructors
50 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
51 Every constructor, C, comes with a
53 *wrapper*, called C, whose type is exactly what it looks like
54 in the source program. It is an ordinary function,
55 and it gets a top-level binding like any other function
57 *worker*, called $wC, which is the actual data constructor.
58 Its type may be different to C, because:
59 - useless dict args are dropped
60 - strict args may be flattened
61 It does not have a binding.
63 The worker is very like a primop, in that it has no binding,
66 A note about the stupid context
67 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
68 Data types can have a context:
70 data (Eq a, Ord b) => T a b = T1 a b | T2 a
72 and that makes the constructors have a context too
73 (notice that T2's context is "thinned"):
75 T1 :: (Eq a, Ord b) => a -> b -> T a b
76 T2 :: (Eq a) => a -> T a b
78 Furthermore, this context pops up when pattern matching
79 (though GHC hasn't implemented this, but it is in H98, and
80 I've fixed GHC so that it now does):
84 f :: Eq a => T a b -> a
86 I say the context is "stupid" because the dictionaries passed
87 are immediately discarded -- they do nothing and have no benefit.
88 It's a flaw in the language.
90 Up to now [March 2002] I have put this stupid context into the type of
91 the "wrapper" constructors functions, T1 and T2, but that turned out
92 to be jolly inconvenient for generics, and record update, and other
93 functions that build values of type T (because they don't have
94 suitable dictionaries available).
96 So now I've taken the stupid context out. I simply deal with it
97 separately in the type checker on occurrences of a constructor, either
98 in an expression or in a pattern.
102 %************************************************************************
104 \subsection{Data constructors}
106 %************************************************************************
110 = MkData { -- Used for data constructors only;
111 -- there *is* no constructor for a newtype
113 dcUnique :: Unique, -- Cached from Name
118 -- data Eq a => T a = forall b. Ord b => MkT a [b]
120 dcRepType :: Type, -- Type of the constructor
121 -- forall b a . Ord b => a -> [b] -> MkT a
122 -- (this is *not* of the constructor wrapper Id:
123 -- see notes after this data type declaration)
125 -- Notice that the existential type parameters come
126 -- *first*. It doesn't really matter provided we are
129 -- The next six fields express the type of the constructor, in pieces
135 -- dcExTheta = [Ord b]
136 -- dcOrigArgTys = [a,List b]
139 dcTyVars :: [TyVar], -- Type vars for the data type decl
140 -- These are ALWAYS THE SAME AS THE TYVARS
141 -- FOR THE PARENT TyCon. We occasionally rely on
142 -- this just to avoid redundant instantiation
144 dcStupidTheta :: ThetaType, -- This is a "thinned" version of the context of
146 -- "Thinned", because the Report says
147 -- to eliminate any constraints that don't mention
148 -- tyvars free in the arg types for this constructor
150 -- "Stupid", because the dictionaries aren't used for anything.
152 -- Indeed, [as of March 02] they are no
153 -- longer in the type of the dataConWrapId, because
154 -- that makes it harder to use the wrap-id to rebuild
155 -- values after record selection or in generics.
157 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
158 dcExTheta :: ThetaType, -- the existentially quantified stuff
160 dcOrigArgTys :: [Type], -- Original argument types
161 -- (before unboxing and flattening of
164 dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
165 -- and including existential dictionaries
167 dcRepStrictness :: [StrictnessMark], -- One for each representation argument
169 dcTyCon :: TyCon, -- Result tycon
171 -- Now the strictness annotations and field labels of the constructor
172 dcStrictMarks :: [StrictnessMark],
173 -- Strictness annotations as deduced by the compiler.
174 -- Has no MarkedUserStrict; they have been changed to MarkedStrict
175 -- or MarkedUnboxed by the compiler.
176 -- *Includes the existential dictionaries*
177 -- length = length dcExTheta + dataConSourceArity dataCon
179 dcFields :: [FieldLabel],
180 -- Field labels for this constructor, in the
181 -- same order as the argument types;
182 -- length = 0 (if not a record) or dataConSourceArity.
184 -- Finally, the curried worker function that corresponds to the constructor
185 -- It doesn't have an unfolding; the code generator saturates these Ids
186 -- and allocates a real constructor when it finds one.
188 -- An entirely separate wrapper function is built in TcTyDecls
190 dcWorkId :: Id, -- The corresponding worker Id
191 -- Takes dcRepArgTys as its arguments
193 dcWrapId :: Id -- The wrapper Id
199 fIRST_TAG = 1 -- Tags allocated from here for real constructors
202 The dcRepType field contains the type of the representation of a contructor
203 This may differ from the type of the contructor *Id* (built
204 by MkId.mkDataConId) for two reasons:
205 a) the constructor Id may be overloaded, but the dictionary isn't stored
206 e.g. data Eq a => T a = MkT a a
208 b) the constructor may store an unboxed version of a strict field.
210 Here's an example illustrating both:
211 data Ord a => T a = MkT Int! a
213 T :: Ord a => Int -> a -> T a
215 Trep :: Int# -> a -> T a
216 Actually, the unboxed part isn't implemented yet!
219 %************************************************************************
221 \subsection{Instances}
223 %************************************************************************
226 instance Eq DataCon where
227 a == b = getUnique a == getUnique b
228 a /= b = getUnique a /= getUnique b
230 instance Ord DataCon where
231 a <= b = getUnique a <= getUnique b
232 a < b = getUnique a < getUnique b
233 a >= b = getUnique a >= getUnique b
234 a > b = getUnique a > getUnique b
235 compare a b = getUnique a `compare` getUnique b
237 instance Uniquable DataCon where
240 instance NamedThing DataCon where
243 instance Outputable DataCon where
244 ppr con = ppr (dataConName con)
246 instance Show DataCon where
247 showsPrec p con = showsPrecSDoc p (ppr con)
251 %************************************************************************
253 \subsection{Construction}
255 %************************************************************************
259 -> [StrictnessMark] -> [FieldLabel]
260 -> [TyVar] -> ThetaType
261 -> [TyVar] -> ThetaType
265 -- Can get the tag from the TyCon
267 mkDataCon name arg_stricts fields
268 tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
270 = ASSERT(equalLength arg_stricts orig_arg_tys)
271 -- The 'stricts' passed to mkDataCon are simply those for the
272 -- source-language arguments. We add extra ones for the
273 -- dictionary arguments right here.
276 con = MkData {dcName = name, dcUnique = nameUnique name,
277 dcTyVars = tyvars, dcStupidTheta = theta,
278 dcOrigArgTys = orig_arg_tys,
279 dcRepArgTys = rep_arg_tys,
280 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
281 dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_stricts,
282 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
283 dcWorkId = work_id, dcWrapId = wrap_id}
285 -- Strictness marks for source-args
286 -- *after unboxing choices*,
287 -- but *including existential dictionaries*
288 ex_dict_tys = mkPredTys ex_theta
289 real_stricts = (map mk_dict_strict_mark ex_dict_tys) ++
290 zipWithEqual "mkDataCon1" (chooseBoxingStrategy tycon)
291 orig_arg_tys arg_stricts
292 real_arg_tys = ex_dict_tys ++ orig_arg_tys
294 -- Representation arguments and demands
295 (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
297 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
298 ty = mkForAllTys (ex_tyvars ++ tyvars)
299 (mkFunTys rep_arg_tys result_ty)
300 -- NB: the existential dict args are already in rep_arg_tys
302 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
304 mk_dict_strict_mark ty | isStrictType ty = MarkedStrict
305 | otherwise = NotMarkedStrict
309 dataConName :: DataCon -> Name
312 dataConTag :: DataCon -> ConTag
315 dataConTyCon :: DataCon -> TyCon
316 dataConTyCon = dcTyCon
318 dataConRepType :: DataCon -> Type
319 dataConRepType = dcRepType
321 dataConWorkId :: DataCon -> Id
322 dataConWorkId = dcWorkId
324 dataConWrapId :: DataCon -> Id
325 dataConWrapId = dcWrapId
327 dataConFieldLabels :: DataCon -> [FieldLabel]
328 dataConFieldLabels = dcFields
330 dataConStrictMarks :: DataCon -> [StrictnessMark]
331 dataConStrictMarks = dcStrictMarks
333 -- Number of type-instantiation arguments
334 -- All the remaining arguments of the DataCon are (notionally)
335 -- stored in the DataCon, and are matched in a case expression
336 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
338 dataConSourceArity :: DataCon -> Arity
339 -- Source-level arity of the data constructor
340 dataConSourceArity dc = length (dcOrigArgTys dc)
342 -- dataConRepArity gives the number of actual fields in the
343 -- {\em representation} of the data constructor. This may be more than appear
344 -- in the source code; the extra ones are the existentially quantified
346 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
348 isNullaryDataCon con = dataConRepArity con == 0
350 dataConRepStrictness :: DataCon -> [StrictnessMark]
351 -- Give the demands on the arguments of a
352 -- Core constructor application (Con dc args)
353 dataConRepStrictness dc = dcRepStrictness dc
355 dataConSig :: DataCon -> ([TyVar], ThetaType,
359 dataConSig (MkData {dcTyVars = tyvars, dcStupidTheta = theta,
360 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
361 dcOrigArgTys = arg_tys, dcTyCon = tycon})
362 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
364 dataConArgTys :: DataCon
365 -> [Type] -- Instantiated at these types
366 -- NB: these INCLUDE the existentially quantified arg types
367 -> [Type] -- Needs arguments of these types
368 -- NB: these INCLUDE the existentially quantified dict args
369 -- but EXCLUDE the data-decl context which is discarded
370 -- It's all post-flattening etc; this is a representation type
372 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
373 dcExTyVars = ex_tyvars}) inst_tys
374 = map (substTyWith (ex_tyvars ++ tyvars) inst_tys) arg_tys
376 dataConTheta :: DataCon -> ThetaType
377 dataConTheta dc = dcStupidTheta dc
379 dataConExistentialTyVars :: DataCon -> [TyVar]
380 dataConExistentialTyVars dc = dcExTyVars dc
382 -- And the same deal for the original arg tys:
384 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
385 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
386 dcExTyVars = ex_tyvars}) inst_tys
387 = map (substTyWith (ex_tyvars ++ tyvars) inst_tys) arg_tys
390 These two functions get the real argument types of the constructor,
391 without substituting for any type variables.
393 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
395 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
396 after any flattening has been done.
399 dataConOrigArgTys :: DataCon -> [Type]
400 dataConOrigArgTys dc = dcOrigArgTys dc
402 dataConRepArgTys :: DataCon -> [Type]
403 dataConRepArgTys dc = dcRepArgTys dc
408 isTupleCon :: DataCon -> Bool
409 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
411 isUnboxedTupleCon :: DataCon -> Bool
412 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
414 isExistentialDataCon :: DataCon -> Bool
415 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
420 classDataCon :: Class -> DataCon
421 classDataCon clas = case tyConDataCons (classTyCon clas) of
422 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
425 %************************************************************************
427 \subsection{Splitting products}
429 %************************************************************************
432 splitProductType_maybe
433 :: Type -- A product type, perhaps
434 -> Maybe (TyCon, -- The type constructor
435 [Type], -- Type args of the tycon
436 DataCon, -- The data constructor
437 [Type]) -- Its *representation* arg types
439 -- Returns (Just ...) for any
440 -- concrete (i.e. constructors visible)
441 -- single-constructor
442 -- not existentially quantified
443 -- type whether a data type or a new type
445 -- Rejecing existentials is conservative. Maybe some things
446 -- could be made to work with them, but I'm not going to sweat
447 -- it through till someone finds it's important.
449 splitProductType_maybe ty
450 = case splitTyConApp_maybe ty of
452 | isProductTyCon tycon -- Includes check for non-existential,
453 -- and for constructors visible
454 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
456 data_con = head (tyConDataCons tycon)
459 splitProductType str ty
460 = case splitProductType_maybe ty of
462 Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
464 -- We attempt to unbox/unpack a strict field when either:
465 -- (i) The tycon is imported, and the field is marked '! !', or
466 -- (ii) The tycon is defined in this module, the field is marked '!',
467 -- and the -funbox-strict-fields flag is on.
469 -- This ensures that if we compile some modules with -funbox-strict-fields and
470 -- some without, the compiler doesn't get confused about the constructor
473 chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
474 -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
475 chooseBoxingStrategy tycon arg_ty strict
478 | opt_UnboxStrictFields
479 && unbox arg_ty -> MarkedUnboxed
480 | otherwise -> MarkedStrict
483 -- beware: repType will go into a loop if we try this on a recursive
484 -- type (for reasons unknown...), hence the check for recursion below.
486 case splitTyConApp_maybe ty of
489 | isRecursiveTyCon arg_tycon -> False
491 case splitTyConApp_maybe (repType ty) of
493 Just (arg_tycon, _) -> isProductTyCon arg_tycon
495 computeRep :: [StrictnessMark] -- Original arg strictness
496 -- [after strategy choice; can't be MarkedUserStrict]
497 -> [Type] -- and types
498 -> ([StrictnessMark], -- Representation arg strictness
501 computeRep stricts tys
502 = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
504 unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
505 unbox MarkedStrict ty = [(MarkedStrict, ty)]
506 unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
508 (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" (repType ty)