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, notNull )
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 a b . 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 *second*.
126 -- Reason: in a case expression we may find:
127 -- case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
128 -- It's convenient to apply the rep-type of MkT to 't', to get
129 -- forall b. Ord b => ...
130 -- and use that to check the pattern. Mind you, this is really only
134 -- The next six fields express the type of the constructor, in pieces
140 -- dcExTheta = [Ord b]
141 -- dcOrigArgTys = [a,List b]
144 dcTyVars :: [TyVar], -- Type vars for the data type decl
145 -- These are ALWAYS THE SAME AS THE TYVARS
146 -- FOR THE PARENT TyCon. We occasionally rely on
147 -- this just to avoid redundant instantiation
149 dcStupidTheta :: ThetaType, -- This is a "thinned" version of the context of
151 -- "Thinned", because the Report says
152 -- to eliminate any constraints that don't mention
153 -- tyvars free in the arg types for this constructor
155 -- "Stupid", because the dictionaries aren't used for anything.
157 -- Indeed, [as of March 02] they are no
158 -- longer in the type of the dataConWrapId, because
159 -- that makes it harder to use the wrap-id to rebuild
160 -- values after record selection or in generics.
162 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
163 dcExTheta :: ThetaType, -- the existentially quantified stuff
165 dcOrigArgTys :: [Type], -- Original argument types
166 -- (before unboxing and flattening of
169 dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
170 -- and including existential dictionaries
172 dcRepStrictness :: [StrictnessMark], -- One for each representation argument
174 dcTyCon :: TyCon, -- Result tycon
176 -- Now the strictness annotations and field labels of the constructor
177 dcStrictMarks :: [StrictnessMark],
178 -- Strictness annotations as deduced by the compiler.
179 -- Has no MarkedUserStrict; they have been changed to MarkedStrict
180 -- or MarkedUnboxed by the compiler.
181 -- *Includes the existential dictionaries*
182 -- length = length dcExTheta + dataConSourceArity dataCon
184 dcFields :: [FieldLabel],
185 -- Field labels for this constructor, in the
186 -- same order as the argument types;
187 -- length = 0 (if not a record) or dataConSourceArity.
189 -- Finally, the curried worker function that corresponds to the constructor
190 -- It doesn't have an unfolding; the code generator saturates these Ids
191 -- and allocates a real constructor when it finds one.
193 -- An entirely separate wrapper function is built in TcTyDecls
195 dcWorkId :: Id, -- The corresponding worker Id
196 -- Takes dcRepArgTys as its arguments
198 dcWrapId :: Id -- The wrapper Id
204 fIRST_TAG = 1 -- Tags allocated from here for real constructors
207 The dcRepType field contains the type of the representation of a contructor
208 This may differ from the type of the contructor *Id* (built
209 by MkId.mkDataConId) for two reasons:
210 a) the constructor Id may be overloaded, but the dictionary isn't stored
211 e.g. data Eq a => T a = MkT a a
213 b) the constructor may store an unboxed version of a strict field.
215 Here's an example illustrating both:
216 data Ord a => T a = MkT Int! a
218 T :: Ord a => Int -> a -> T a
220 Trep :: Int# -> a -> T a
221 Actually, the unboxed part isn't implemented yet!
224 %************************************************************************
226 \subsection{Instances}
228 %************************************************************************
231 instance Eq DataCon where
232 a == b = getUnique a == getUnique b
233 a /= b = getUnique a /= getUnique b
235 instance Ord DataCon where
236 a <= b = getUnique a <= getUnique b
237 a < b = getUnique a < getUnique b
238 a >= b = getUnique a >= getUnique b
239 a > b = getUnique a > getUnique b
240 compare a b = getUnique a `compare` getUnique b
242 instance Uniquable DataCon where
245 instance NamedThing DataCon where
248 instance Outputable DataCon where
249 ppr con = ppr (dataConName con)
251 instance Show DataCon where
252 showsPrec p con = showsPrecSDoc p (ppr con)
256 %************************************************************************
258 \subsection{Construction}
260 %************************************************************************
264 -> [StrictnessMark] -> [FieldLabel]
265 -> [TyVar] -> ThetaType
266 -> [TyVar] -> ThetaType
270 -- Can get the tag from the TyCon
272 mkDataCon name arg_stricts fields
273 tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
275 = ASSERT(equalLength arg_stricts orig_arg_tys)
276 -- The 'stricts' passed to mkDataCon are simply those for the
277 -- source-language arguments. We add extra ones for the
278 -- dictionary arguments right here.
281 con = MkData {dcName = name, dcUnique = nameUnique name,
282 dcTyVars = tyvars, dcStupidTheta = theta,
283 dcOrigArgTys = orig_arg_tys,
284 dcRepArgTys = rep_arg_tys,
285 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
286 dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_stricts,
287 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
288 dcWorkId = work_id, dcWrapId = wrap_id}
290 -- Strictness marks for source-args
291 -- *after unboxing choices*,
292 -- but *including existential dictionaries*
293 ex_dict_tys = mkPredTys ex_theta
294 real_stricts = (map mk_dict_strict_mark ex_dict_tys) ++
295 zipWithEqual "mkDataCon1" (chooseBoxingStrategy tycon)
296 orig_arg_tys arg_stricts
297 real_arg_tys = ex_dict_tys ++ orig_arg_tys
299 -- Representation arguments and demands
300 (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
302 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
303 ty = mkForAllTys (tyvars ++ ex_tyvars)
304 (mkFunTys rep_arg_tys result_ty)
305 -- NB: the existential dict args are already in rep_arg_tys
307 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
309 mk_dict_strict_mark ty | isStrictType ty = MarkedStrict
310 | otherwise = NotMarkedStrict
314 dataConName :: DataCon -> Name
317 dataConTag :: DataCon -> ConTag
320 dataConTyCon :: DataCon -> TyCon
321 dataConTyCon = dcTyCon
323 dataConRepType :: DataCon -> Type
324 dataConRepType = dcRepType
326 dataConWorkId :: DataCon -> Id
327 dataConWorkId = dcWorkId
329 dataConWrapId :: DataCon -> Id
330 dataConWrapId = dcWrapId
332 dataConFieldLabels :: DataCon -> [FieldLabel]
333 dataConFieldLabels = dcFields
335 dataConStrictMarks :: DataCon -> [StrictnessMark]
336 dataConStrictMarks = dcStrictMarks
338 -- Number of type-instantiation arguments
339 -- All the remaining arguments of the DataCon are (notionally)
340 -- stored in the DataCon, and are matched in a case expression
341 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
343 dataConSourceArity :: DataCon -> Arity
344 -- Source-level arity of the data constructor
345 dataConSourceArity dc = length (dcOrigArgTys dc)
347 -- dataConRepArity gives the number of actual fields in the
348 -- {\em representation} of the data constructor. This may be more than appear
349 -- in the source code; the extra ones are the existentially quantified
351 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
353 isNullaryDataCon con = dataConRepArity con == 0
355 dataConRepStrictness :: DataCon -> [StrictnessMark]
356 -- Give the demands on the arguments of a
357 -- Core constructor application (Con dc args)
358 dataConRepStrictness dc = dcRepStrictness dc
360 dataConSig :: DataCon -> ([TyVar], ThetaType,
364 dataConSig (MkData {dcTyVars = tyvars, dcStupidTheta = theta,
365 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
366 dcOrigArgTys = arg_tys, dcTyCon = tycon})
367 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
369 dataConArgTys :: DataCon
370 -> [Type] -- Instantiated at these types
371 -- NB: these INCLUDE the existentially quantified arg types
372 -> [Type] -- Needs arguments of these types
373 -- NB: these INCLUDE the existentially quantified dict args
374 -- but EXCLUDE the data-decl context which is discarded
375 -- It's all post-flattening etc; this is a representation type
377 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
378 dcExTyVars = ex_tyvars}) inst_tys
379 = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
381 dataConTheta :: DataCon -> ThetaType
382 dataConTheta dc = dcStupidTheta dc
384 dataConExistentialTyVars :: DataCon -> [TyVar]
385 dataConExistentialTyVars dc = dcExTyVars dc
387 -- And the same deal for the original arg tys:
389 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
390 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
391 dcExTyVars = ex_tyvars}) inst_tys
392 = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
395 These two functions get the real argument types of the constructor,
396 without substituting for any type variables.
398 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
400 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
401 after any flattening has been done.
404 dataConOrigArgTys :: DataCon -> [Type]
405 dataConOrigArgTys dc = dcOrigArgTys dc
407 dataConRepArgTys :: DataCon -> [Type]
408 dataConRepArgTys dc = dcRepArgTys dc
413 isTupleCon :: DataCon -> Bool
414 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
416 isUnboxedTupleCon :: DataCon -> Bool
417 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
419 isExistentialDataCon :: DataCon -> Bool
420 isExistentialDataCon (MkData {dcExTyVars = tvs}) = notNull tvs
425 classDataCon :: Class -> DataCon
426 classDataCon clas = case tyConDataCons (classTyCon clas) of
427 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
430 %************************************************************************
432 \subsection{Splitting products}
434 %************************************************************************
437 splitProductType_maybe
438 :: Type -- A product type, perhaps
439 -> Maybe (TyCon, -- The type constructor
440 [Type], -- Type args of the tycon
441 DataCon, -- The data constructor
442 [Type]) -- Its *representation* arg types
444 -- Returns (Just ...) for any
445 -- concrete (i.e. constructors visible)
446 -- single-constructor
447 -- not existentially quantified
448 -- type whether a data type or a new type
450 -- Rejecing existentials is conservative. Maybe some things
451 -- could be made to work with them, but I'm not going to sweat
452 -- it through till someone finds it's important.
454 splitProductType_maybe ty
455 = case splitTyConApp_maybe ty of
457 | isProductTyCon tycon -- Includes check for non-existential,
458 -- and for constructors visible
459 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
461 data_con = head (tyConDataCons tycon)
464 splitProductType str ty
465 = case splitProductType_maybe ty of
467 Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
469 -- We attempt to unbox/unpack a strict field when either:
470 -- (i) The tycon is imported, and the field is marked '! !', or
471 -- (ii) The tycon is defined in this module, the field is marked '!',
472 -- and the -funbox-strict-fields flag is on.
474 -- This ensures that if we compile some modules with -funbox-strict-fields and
475 -- some without, the compiler doesn't get confused about the constructor
478 chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
479 -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
480 chooseBoxingStrategy tycon arg_ty strict
483 | opt_UnboxStrictFields
484 && unbox arg_ty -> MarkedUnboxed
485 | otherwise -> MarkedStrict
488 -- beware: repType will go into a loop if we try this on a recursive
489 -- type (for reasons unknown...), hence the check for recursion below.
491 case splitTyConApp_maybe ty of
494 | isRecursiveTyCon arg_tycon -> False
496 case splitTyConApp_maybe (repType ty) of
498 Just (arg_tycon, _) -> isProductTyCon arg_tycon
500 computeRep :: [StrictnessMark] -- Original arg strictness
501 -- [after strategy choice; can't be MarkedUserStrict]
502 -> [Type] -- and types
503 -> ([StrictnessMark], -- Representation arg strictness
506 computeRep stricts tys
507 = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
509 unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
510 unbox MarkedStrict ty = [(MarkedStrict, ty)]
511 unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
513 (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" (repType ty)