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( substTy, mkTyVarSubst )
27 import CmdLineOpts ( opt_DictsStrict )
28 import Type ( Type, TauType, ThetaType,
29 mkForAllTys, mkFunTys, mkTyConApp,
30 mkTyVarTys, mkPredTys, getClassPredTys_maybe,
33 import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, 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 )
40 import Demand ( Demand, StrictnessMark(..), wwStrict, wwLazy )
42 import Unique ( Unique, Uniquable(..) )
43 import CmdLineOpts ( opt_UnboxStrictFields )
44 import PprType () -- Instances
46 import ListSetOps ( assoc )
47 import Util ( zipEqual, zipWithEqual )
51 Stuff about data constructors
52 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
53 Every constructor, C, comes with a
55 *wrapper*, called C, whose type is exactly what it looks like
56 in the source program. It is an ordinary function,
57 and it gets a top-level binding like any other function
59 *worker*, called $wC, which is the actual data constructor.
60 Its type may be different to C, because:
61 - useless dict args are dropped
62 - strict args may be flattened
63 It does not have a binding.
65 The worker is very like a primop, in that it has no binding,
69 %************************************************************************
71 \subsection{Data constructors}
73 %************************************************************************
77 = MkData { -- Used for data constructors only;
78 -- there *is* no constructor for a newtype
80 dcUnique :: Unique, -- Cached from Name
85 -- data Eq a => T a = forall b. Ord b => MkT a [b]
87 dcRepType :: Type, -- Type of the constructor
88 -- forall ab . Ord b => a -> [b] -> MkT a
89 -- (this is *not* of the constructor Id:
90 -- see notes after this data type declaration)
92 -- The next six fields express the type of the constructor, in pieces
98 -- dcExTheta = [Ord b]
99 -- dcOrigArgTys = [a,List b]
102 dcTyVars :: [TyVar], -- Type vars and context for the data type decl
103 -- These are ALWAYS THE SAME AS THE TYVARS
104 -- FOR THE PARENT TyCon. We occasionally rely on
105 -- this just to avoid redundant instantiation
106 dcTheta :: ThetaType,
108 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
109 dcExTheta :: ThetaType, -- the existentially quantified stuff
111 dcOrigArgTys :: [Type], -- Original argument types
112 -- (before unboxing and flattening of
115 dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
116 -- and including existential dictionaries
118 dcRepStrictness :: [Demand], -- One for each representation argument
120 dcTyCon :: TyCon, -- Result tycon
122 -- Now the strictness annotations and field labels of the constructor
123 dcStrictMarks :: [StrictnessMark],
124 -- Strictness annotations as deduced by the compiler.
125 -- Has no MarkedUserStrict; they have been changed to MarkedStrict
126 -- or MarkedUnboxed by the compiler.
127 -- *Includes the existential dictionaries*
128 -- length = length dcExTheta + dataConSourceArity dataCon
130 dcFields :: [FieldLabel],
131 -- Field labels for this constructor, in the
132 -- same order as the argument types;
133 -- length = 0 (if not a record) or dataConSourceArity.
135 -- Finally, the curried worker function that corresponds to the constructor
136 -- It doesn't have an unfolding; the code generator saturates these Ids
137 -- and allocates a real constructor when it finds one.
139 -- An entirely separate wrapper function is built in TcTyDecls
141 dcId :: Id, -- The corresponding worker Id
142 -- Takes dcRepArgTys as its arguments
144 dcWrapId :: Id -- The wrapper Id
150 fIRST_TAG = 1 -- Tags allocated from here for real constructors
153 The dcRepType field contains the type of the representation of a contructor
154 This may differ from the type of the contructor *Id* (built
155 by MkId.mkDataConId) for two reasons:
156 a) the constructor Id may be overloaded, but the dictionary isn't stored
157 e.g. data Eq a => T a = MkT a a
159 b) the constructor may store an unboxed version of a strict field.
161 Here's an example illustrating both:
162 data Ord a => T a = MkT Int! a
164 T :: Ord a => Int -> a -> T a
166 Trep :: Int# -> a -> T a
167 Actually, the unboxed part isn't implemented yet!
170 %************************************************************************
172 \subsection{Instances}
174 %************************************************************************
177 instance Eq DataCon where
178 a == b = getUnique a == getUnique b
179 a /= b = getUnique a /= getUnique b
181 instance Ord DataCon where
182 a <= b = getUnique a <= getUnique b
183 a < b = getUnique a < getUnique b
184 a >= b = getUnique a >= getUnique b
185 a > b = getUnique a > getUnique b
186 compare a b = getUnique a `compare` getUnique b
188 instance Uniquable DataCon where
191 instance NamedThing DataCon where
194 instance Outputable DataCon where
195 ppr con = ppr (dataConName con)
197 instance Show DataCon where
198 showsPrec p con = showsPrecSDoc p (ppr con)
202 %************************************************************************
204 \subsection{Consruction}
206 %************************************************************************
210 -> [StrictnessMark] -> [FieldLabel]
211 -> [TyVar] -> ThetaType
212 -> [TyVar] -> ThetaType
213 -> [TauType] -> TyCon
216 -- Can get the tag from the TyCon
218 mkDataCon name arg_stricts fields
219 tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
221 = ASSERT(length arg_stricts == length orig_arg_tys)
222 -- The 'stricts' passed to mkDataCon are simply those for the
223 -- source-language arguments. We add extra ones for the
224 -- dictionary arguments right here.
227 con = MkData {dcName = name, dcUnique = nameUnique name,
228 dcTyVars = tyvars, dcTheta = theta,
229 dcOrigArgTys = orig_arg_tys,
230 dcRepArgTys = rep_arg_tys,
231 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
232 dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_demands,
233 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
234 dcId = work_id, dcWrapId = wrap_id}
236 -- Strictness marks for source-args
237 -- *after unboxing choices*,
238 -- but *including existential dictionaries*
239 real_stricts = (map mk_dict_strict_mark ex_theta) ++
240 zipWithEqual "mkDataCon1" (chooseBoxingStrategy tycon)
241 orig_arg_tys arg_stricts
243 -- Representation arguments and demands
244 (rep_arg_demands, rep_arg_tys)
246 zipWithEqual "mkDataCon2" unbox_strict_arg_ty
248 (mkPredTys ex_theta ++ orig_arg_tys)
250 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
251 ty = mkForAllTys (tyvars ++ ex_tyvars)
252 (mkFunTys rep_arg_tys result_ty)
253 -- NB: the existential dict args are already in rep_arg_tys
255 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
257 mk_dict_strict_mark pred
258 | opt_DictsStrict, -- Don't mark newtype things as strict!
259 Just (clas,_) <- getClassPredTys_maybe pred,
260 isDataTyCon (classTyCon clas) = MarkedStrict
261 | otherwise = NotMarkedStrict
265 dataConName :: DataCon -> Name
268 dataConTag :: DataCon -> ConTag
271 dataConTyCon :: DataCon -> TyCon
272 dataConTyCon = dcTyCon
274 dataConRepType :: DataCon -> Type
275 dataConRepType = dcRepType
277 dataConId :: DataCon -> Id
280 dataConWrapId :: DataCon -> Id
281 dataConWrapId = dcWrapId
283 dataConFieldLabels :: DataCon -> [FieldLabel]
284 dataConFieldLabels = dcFields
286 dataConStrictMarks :: DataCon -> [StrictnessMark]
287 dataConStrictMarks = dcStrictMarks
289 -- Number of type-instantiation arguments
290 -- All the remaining arguments of the DataCon are (notionally)
291 -- stored in the DataCon, and are matched in a case expression
292 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
294 dataConSourceArity :: DataCon -> Arity
295 -- Source-level arity of the data constructor
296 dataConSourceArity dc = length (dcOrigArgTys dc)
298 -- dataConRepArity gives the number of actual fields in the
299 -- {\em representation} of the data constructor. This may be more than appear
300 -- in the source code; the extra ones are the existentially quantified
302 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
304 isNullaryDataCon con = dataConRepArity con == 0
306 dataConRepStrictness :: DataCon -> [Demand]
307 -- Give the demands on the arguments of a
308 -- Core constructor application (Con dc args)
309 dataConRepStrictness dc = dcRepStrictness dc
311 dataConSig :: DataCon -> ([TyVar], ThetaType,
315 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
316 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
317 dcOrigArgTys = arg_tys, dcTyCon = tycon})
318 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
320 dataConArgTys :: DataCon
321 -> [Type] -- Instantiated at these types
322 -- NB: these INCLUDE the existentially quantified arg types
323 -> [Type] -- Needs arguments of these types
324 -- NB: these INCLUDE the existentially quantified dict args
325 -- but EXCLUDE the data-decl context which is discarded
326 -- It's all post-flattening etc; this is a representation type
328 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
329 dcExTyVars = ex_tyvars}) inst_tys
330 = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
332 dataConTheta :: DataCon -> ThetaType
333 dataConTheta dc = dcTheta dc
335 -- And the same deal for the original arg tys:
337 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
338 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
339 dcExTyVars = ex_tyvars}) inst_tys
340 = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
343 These two functions get the real argument types of the constructor,
344 without substituting for any type variables.
346 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
348 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
349 after any flattening has been done.
352 dataConOrigArgTys :: DataCon -> [Type]
353 dataConOrigArgTys dc = dcOrigArgTys dc
355 dataConRepArgTys :: DataCon -> [TauType]
356 dataConRepArgTys dc = dcRepArgTys dc
361 isTupleCon :: DataCon -> Bool
362 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
364 isUnboxedTupleCon :: DataCon -> Bool
365 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
367 isExistentialDataCon :: DataCon -> Bool
368 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
373 classDataCon :: Class -> DataCon
374 classDataCon clas = case tyConDataCons (classTyCon clas) of
375 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
378 %************************************************************************
380 \subsection{Splitting products}
382 %************************************************************************
385 splitProductType_maybe
386 :: Type -- A product type, perhaps
387 -> Maybe (TyCon, -- The type constructor
388 [Type], -- Type args of the tycon
389 DataCon, -- The data constructor
390 [Type]) -- Its *representation* arg types
392 -- Returns (Just ...) for any
393 -- concrete (i.e. constructors visible)
394 -- single-constructor
395 -- not existentially quantified
396 -- type whether a data type or a new type
398 -- Rejecing existentials is conservative. Maybe some things
399 -- could be made to work with them, but I'm not going to sweat
400 -- it through till someone finds it's important.
402 splitProductType_maybe ty
403 = case splitTyConApp_maybe ty of
405 | isProductTyCon tycon -- Includes check for non-existential,
406 -- and for constructors visible
407 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
409 data_con = head (tyConDataConsIfAvailable tycon)
412 splitProductType str ty
413 = case splitProductType_maybe ty of
415 Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
417 -- We attempt to unbox/unpack a strict field when either:
418 -- (i) The tycon is imported, and the field is marked '! !', or
419 -- (ii) The tycon is defined in this module, the field is marked '!',
420 -- and the -funbox-strict-fields flag is on.
422 -- This ensures that if we compile some modules with -funbox-strict-fields and
423 -- some without, the compiler doesn't get confused about the constructor
426 chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
427 -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
428 chooseBoxingStrategy tycon arg_ty strict
430 MarkedUserStrict | unbox arg_ty -> MarkedUnboxed
431 | otherwise -> MarkedStrict
434 unbox ty = opt_UnboxStrictFields &&
435 case splitTyConApp_maybe ty of
436 Just (arg_tycon, _) -> not (isRecursiveTyCon arg_tycon) &&
437 isProductTyCon arg_tycon &&
438 isDataTyCon arg_tycon
440 -- Recursion: check whether the *argument* type constructor is
441 -- recursive. Checking the *parent* tycon is over-conservative
443 -- We can't look through newtypes in arguments (yet); hence isDataTyCon
447 :: StrictnessMark -- After strategy choice; can't be MkaredUserStrict
448 -> Type -- Source argument type
449 -> [(Demand,Type)] -- Representation argument types and demamds
451 unbox_strict_arg_ty NotMarkedStrict ty = [(wwLazy, ty)]
452 unbox_strict_arg_ty MarkedStrict ty = [(wwStrict, ty)]
453 unbox_strict_arg_ty MarkedUnboxed ty
454 = zipEqual "unbox_strict_arg_ty" (dataConRepStrictness arg_data_con) arg_tys
456 (_, _, arg_data_con, arg_tys) = splitProductType "unbox_strict_arg_ty" ty