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, dataConId, dataConWrapId, dataConRepStrictness,
17 isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
18 isExistentialDataCon, classDataCon,
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, tyConDataConsIfAvailable, 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,
67 %************************************************************************
69 \subsection{Data constructors}
71 %************************************************************************
75 = MkData { -- Used for data constructors only;
76 -- there *is* no constructor for a newtype
78 dcUnique :: Unique, -- Cached from Name
83 -- data Eq a => T a = forall b. Ord b => MkT a [b]
85 dcRepType :: Type, -- Type of the constructor
86 -- forall ab . Ord b => a -> [b] -> MkT a
87 -- (this is *not* of the constructor Id:
88 -- see notes after this data type declaration)
90 -- The next six fields express the type of the constructor, in pieces
96 -- dcExTheta = [Ord b]
97 -- dcOrigArgTys = [a,List b]
100 dcTyVars :: [TyVar], -- Type vars and context for the data type decl
101 -- These are ALWAYS THE SAME AS THE TYVARS
102 -- FOR THE PARENT TyCon. We occasionally rely on
103 -- this just to avoid redundant instantiation
104 dcTheta :: ThetaType,
106 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
107 dcExTheta :: ThetaType, -- the existentially quantified stuff
109 dcOrigArgTys :: [Type], -- Original argument types
110 -- (before unboxing and flattening of
113 dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
114 -- and including existential dictionaries
116 dcRepStrictness :: [StrictnessMark], -- One for each representation argument
118 dcTyCon :: TyCon, -- Result tycon
120 -- Now the strictness annotations and field labels of the constructor
121 dcStrictMarks :: [StrictnessMark],
122 -- Strictness annotations as deduced by the compiler.
123 -- Has no MarkedUserStrict; they have been changed to MarkedStrict
124 -- or MarkedUnboxed by the compiler.
125 -- *Includes the existential dictionaries*
126 -- length = length dcExTheta + dataConSourceArity dataCon
128 dcFields :: [FieldLabel],
129 -- Field labels for this constructor, in the
130 -- same order as the argument types;
131 -- length = 0 (if not a record) or dataConSourceArity.
133 -- Finally, the curried worker function that corresponds to the constructor
134 -- It doesn't have an unfolding; the code generator saturates these Ids
135 -- and allocates a real constructor when it finds one.
137 -- An entirely separate wrapper function is built in TcTyDecls
139 dcId :: Id, -- The corresponding worker Id
140 -- Takes dcRepArgTys as its arguments
142 dcWrapId :: Id -- The wrapper Id
148 fIRST_TAG = 1 -- Tags allocated from here for real constructors
151 The dcRepType field contains the type of the representation of a contructor
152 This may differ from the type of the contructor *Id* (built
153 by MkId.mkDataConId) for two reasons:
154 a) the constructor Id may be overloaded, but the dictionary isn't stored
155 e.g. data Eq a => T a = MkT a a
157 b) the constructor may store an unboxed version of a strict field.
159 Here's an example illustrating both:
160 data Ord a => T a = MkT Int! a
162 T :: Ord a => Int -> a -> T a
164 Trep :: Int# -> a -> T a
165 Actually, the unboxed part isn't implemented yet!
168 %************************************************************************
170 \subsection{Instances}
172 %************************************************************************
175 instance Eq DataCon where
176 a == b = getUnique a == getUnique b
177 a /= b = getUnique a /= getUnique b
179 instance Ord DataCon where
180 a <= b = getUnique a <= getUnique b
181 a < b = getUnique a < getUnique b
182 a >= b = getUnique a >= getUnique b
183 a > b = getUnique a > getUnique b
184 compare a b = getUnique a `compare` getUnique b
186 instance Uniquable DataCon where
189 instance NamedThing DataCon where
192 instance Outputable DataCon where
193 ppr con = ppr (dataConName con)
195 instance Show DataCon where
196 showsPrec p con = showsPrecSDoc p (ppr con)
200 %************************************************************************
202 \subsection{Consruction}
204 %************************************************************************
208 -> [StrictnessMark] -> [FieldLabel]
209 -> [TyVar] -> ThetaType
210 -> [TyVar] -> ThetaType
214 -- Can get the tag from the TyCon
216 mkDataCon name arg_stricts fields
217 tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
219 = ASSERT(equalLength arg_stricts orig_arg_tys)
220 -- The 'stricts' passed to mkDataCon are simply those for the
221 -- source-language arguments. We add extra ones for the
222 -- dictionary arguments right here.
225 con = MkData {dcName = name, dcUnique = nameUnique name,
226 dcTyVars = tyvars, dcTheta = theta,
227 dcOrigArgTys = orig_arg_tys,
228 dcRepArgTys = rep_arg_tys,
229 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
230 dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_stricts,
231 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
232 dcId = work_id, dcWrapId = wrap_id}
234 -- Strictness marks for source-args
235 -- *after unboxing choices*,
236 -- but *including existential dictionaries*
237 ex_dict_tys = mkPredTys ex_theta
238 real_stricts = (map mk_dict_strict_mark ex_dict_tys) ++
239 zipWithEqual "mkDataCon1" (chooseBoxingStrategy tycon)
240 orig_arg_tys arg_stricts
241 real_arg_tys = ex_dict_tys ++ orig_arg_tys
243 -- Representation arguments and demands
244 (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
246 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
247 ty = mkForAllTys (tyvars ++ ex_tyvars)
248 (mkFunTys rep_arg_tys result_ty)
249 -- NB: the existential dict args are already in rep_arg_tys
251 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
253 mk_dict_strict_mark ty | isStrictType ty = MarkedStrict
254 | otherwise = NotMarkedStrict
258 dataConName :: DataCon -> Name
261 dataConTag :: DataCon -> ConTag
264 dataConTyCon :: DataCon -> TyCon
265 dataConTyCon = dcTyCon
267 dataConRepType :: DataCon -> Type
268 dataConRepType = dcRepType
270 dataConId :: DataCon -> Id
273 dataConWrapId :: DataCon -> Id
274 dataConWrapId = dcWrapId
276 dataConFieldLabels :: DataCon -> [FieldLabel]
277 dataConFieldLabels = dcFields
279 dataConStrictMarks :: DataCon -> [StrictnessMark]
280 dataConStrictMarks = dcStrictMarks
282 -- Number of type-instantiation arguments
283 -- All the remaining arguments of the DataCon are (notionally)
284 -- stored in the DataCon, and are matched in a case expression
285 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
287 dataConSourceArity :: DataCon -> Arity
288 -- Source-level arity of the data constructor
289 dataConSourceArity dc = length (dcOrigArgTys dc)
291 -- dataConRepArity gives the number of actual fields in the
292 -- {\em representation} of the data constructor. This may be more than appear
293 -- in the source code; the extra ones are the existentially quantified
295 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
297 isNullaryDataCon con = dataConRepArity con == 0
299 dataConRepStrictness :: DataCon -> [StrictnessMark]
300 -- Give the demands on the arguments of a
301 -- Core constructor application (Con dc args)
302 dataConRepStrictness dc = dcRepStrictness dc
304 dataConSig :: DataCon -> ([TyVar], ThetaType,
308 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
309 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
310 dcOrigArgTys = arg_tys, dcTyCon = tycon})
311 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
313 dataConArgTys :: DataCon
314 -> [Type] -- Instantiated at these types
315 -- NB: these INCLUDE the existentially quantified arg types
316 -> [Type] -- Needs arguments of these types
317 -- NB: these INCLUDE the existentially quantified dict args
318 -- but EXCLUDE the data-decl context which is discarded
319 -- It's all post-flattening etc; this is a representation type
321 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
322 dcExTyVars = ex_tyvars}) inst_tys
323 = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
325 dataConTheta :: DataCon -> ThetaType
326 dataConTheta dc = dcTheta dc
328 -- And the same deal for the original arg tys:
330 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
331 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
332 dcExTyVars = ex_tyvars}) inst_tys
333 = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
336 These two functions get the real argument types of the constructor,
337 without substituting for any type variables.
339 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
341 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
342 after any flattening has been done.
345 dataConOrigArgTys :: DataCon -> [Type]
346 dataConOrigArgTys dc = dcOrigArgTys dc
348 dataConRepArgTys :: DataCon -> [Type]
349 dataConRepArgTys dc = dcRepArgTys dc
354 isTupleCon :: DataCon -> Bool
355 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
357 isUnboxedTupleCon :: DataCon -> Bool
358 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
360 isExistentialDataCon :: DataCon -> Bool
361 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
366 classDataCon :: Class -> DataCon
367 classDataCon clas = case tyConDataCons (classTyCon clas) of
368 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
371 %************************************************************************
373 \subsection{Splitting products}
375 %************************************************************************
378 splitProductType_maybe
379 :: Type -- A product type, perhaps
380 -> Maybe (TyCon, -- The type constructor
381 [Type], -- Type args of the tycon
382 DataCon, -- The data constructor
383 [Type]) -- Its *representation* arg types
385 -- Returns (Just ...) for any
386 -- concrete (i.e. constructors visible)
387 -- single-constructor
388 -- not existentially quantified
389 -- type whether a data type or a new type
391 -- Rejecing existentials is conservative. Maybe some things
392 -- could be made to work with them, but I'm not going to sweat
393 -- it through till someone finds it's important.
395 splitProductType_maybe ty
396 = case splitTyConApp_maybe ty of
398 | isProductTyCon tycon -- Includes check for non-existential,
399 -- and for constructors visible
400 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
402 data_con = head (tyConDataConsIfAvailable tycon)
405 splitProductType str ty
406 = case splitProductType_maybe ty of
408 Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
410 -- We attempt to unbox/unpack a strict field when either:
411 -- (i) The tycon is imported, and the field is marked '! !', or
412 -- (ii) The tycon is defined in this module, the field is marked '!',
413 -- and the -funbox-strict-fields flag is on.
415 -- This ensures that if we compile some modules with -funbox-strict-fields and
416 -- some without, the compiler doesn't get confused about the constructor
419 chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
420 -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
421 chooseBoxingStrategy tycon arg_ty strict
424 | opt_UnboxStrictFields
425 && unbox arg_ty -> MarkedUnboxed
426 | otherwise -> MarkedStrict
429 -- beware: repType will go into a loop if we try this on a recursive
430 -- type (for reasons unknown...), hence the check for recursion below.
432 case splitTyConApp_maybe ty of
435 | isRecursiveTyCon arg_tycon -> False
437 case splitTyConApp_maybe (repType ty) of
439 Just (arg_tycon, _) -> isProductTyCon arg_tycon
441 computeRep :: [StrictnessMark] -- Original arg strictness
442 -- [after strategy choice; can't be MarkedUserStrict]
443 -> [Type] -- and types
444 -> ([StrictnessMark], -- Representation arg strictness
447 computeRep stricts tys
448 = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
450 unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
451 unbox MarkedStrict ty = [(MarkedStrict, ty)]
452 unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
454 (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" (repType ty)