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 )
27 import CmdLineOpts ( opt_DictsStrict )
28 import Type ( Type, TauType, ThetaType,
29 mkForAllTys, mkFunTys, mkTyConApp,
30 mkTyVarTys, splitTyConApp_maybe, repType
32 import TcType ( isStrictPred, mkPredTys )
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(..) )
40 import NewDemand ( Demand, lazyDmd, seqDmd )
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 | isStrictPred pred = MarkedStrict
258 | otherwise = NotMarkedStrict
262 dataConName :: DataCon -> Name
265 dataConTag :: DataCon -> ConTag
268 dataConTyCon :: DataCon -> TyCon
269 dataConTyCon = dcTyCon
271 dataConRepType :: DataCon -> Type
272 dataConRepType = dcRepType
274 dataConId :: DataCon -> Id
277 dataConWrapId :: DataCon -> Id
278 dataConWrapId = dcWrapId
280 dataConFieldLabels :: DataCon -> [FieldLabel]
281 dataConFieldLabels = dcFields
283 dataConStrictMarks :: DataCon -> [StrictnessMark]
284 dataConStrictMarks = dcStrictMarks
286 -- Number of type-instantiation arguments
287 -- All the remaining arguments of the DataCon are (notionally)
288 -- stored in the DataCon, and are matched in a case expression
289 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
291 dataConSourceArity :: DataCon -> Arity
292 -- Source-level arity of the data constructor
293 dataConSourceArity dc = length (dcOrigArgTys dc)
295 -- dataConRepArity gives the number of actual fields in the
296 -- {\em representation} of the data constructor. This may be more than appear
297 -- in the source code; the extra ones are the existentially quantified
299 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
301 isNullaryDataCon con = dataConRepArity con == 0
303 dataConRepStrictness :: DataCon -> [Demand]
304 -- Give the demands on the arguments of a
305 -- Core constructor application (Con dc args)
306 dataConRepStrictness dc = dcRepStrictness dc
308 dataConSig :: DataCon -> ([TyVar], ThetaType,
312 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
313 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
314 dcOrigArgTys = arg_tys, dcTyCon = tycon})
315 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
317 dataConArgTys :: DataCon
318 -> [Type] -- Instantiated at these types
319 -- NB: these INCLUDE the existentially quantified arg types
320 -> [Type] -- Needs arguments of these types
321 -- NB: these INCLUDE the existentially quantified dict args
322 -- but EXCLUDE the data-decl context which is discarded
323 -- It's all post-flattening etc; this is a representation type
325 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
326 dcExTyVars = ex_tyvars}) inst_tys
327 = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
329 dataConTheta :: DataCon -> ThetaType
330 dataConTheta dc = dcTheta dc
332 -- And the same deal for the original arg tys:
334 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
335 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
336 dcExTyVars = ex_tyvars}) inst_tys
337 = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys
340 These two functions get the real argument types of the constructor,
341 without substituting for any type variables.
343 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
345 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
346 after any flattening has been done.
349 dataConOrigArgTys :: DataCon -> [Type]
350 dataConOrigArgTys dc = dcOrigArgTys dc
352 dataConRepArgTys :: DataCon -> [TauType]
353 dataConRepArgTys dc = dcRepArgTys dc
358 isTupleCon :: DataCon -> Bool
359 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
361 isUnboxedTupleCon :: DataCon -> Bool
362 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
364 isExistentialDataCon :: DataCon -> Bool
365 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
370 classDataCon :: Class -> DataCon
371 classDataCon clas = case tyConDataCons (classTyCon clas) of
372 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
375 %************************************************************************
377 \subsection{Splitting products}
379 %************************************************************************
382 splitProductType_maybe
383 :: Type -- A product type, perhaps
384 -> Maybe (TyCon, -- The type constructor
385 [Type], -- Type args of the tycon
386 DataCon, -- The data constructor
387 [Type]) -- Its *representation* arg types
389 -- Returns (Just ...) for any
390 -- concrete (i.e. constructors visible)
391 -- single-constructor
392 -- not existentially quantified
393 -- type whether a data type or a new type
395 -- Rejecing existentials is conservative. Maybe some things
396 -- could be made to work with them, but I'm not going to sweat
397 -- it through till someone finds it's important.
399 splitProductType_maybe ty
400 = case splitTyConApp_maybe ty of
402 | isProductTyCon tycon -- Includes check for non-existential,
403 -- and for constructors visible
404 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
406 data_con = head (tyConDataConsIfAvailable tycon)
409 splitProductType str ty
410 = case splitProductType_maybe ty of
412 Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
414 -- We attempt to unbox/unpack a strict field when either:
415 -- (i) The tycon is imported, and the field is marked '! !', or
416 -- (ii) The tycon is defined in this module, the field is marked '!',
417 -- and the -funbox-strict-fields flag is on.
419 -- This ensures that if we compile some modules with -funbox-strict-fields and
420 -- some without, the compiler doesn't get confused about the constructor
423 chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
424 -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
425 chooseBoxingStrategy tycon arg_ty strict
428 | opt_UnboxStrictFields
429 && unbox arg_ty -> MarkedUnboxed
430 | otherwise -> MarkedStrict
433 -- beware: repType will go into a loop if we try this on a recursive
434 -- type (for reasons unknown...), hence the check for recursion below.
436 case splitTyConApp_maybe ty of
439 | isRecursiveTyCon arg_tycon -> False
441 case splitTyConApp_maybe (repType ty) of
443 Just (arg_tycon, _) -> isProductTyCon arg_tycon
446 :: StrictnessMark -- After strategy choice; can't be MarkedUserStrict
447 -> Type -- Source argument type
448 -> [(Demand,Type)] -- Representation argument types and demamds
450 unbox_strict_arg_ty NotMarkedStrict ty = [(lazyDmd, ty)]
451 unbox_strict_arg_ty MarkedStrict ty = [(seqDmd, ty)]
452 unbox_strict_arg_ty MarkedUnboxed ty
453 = zipEqual "unbox_strict_arg_ty" (dataConRepStrictness arg_data_con) arg_tys
455 (_, _, arg_data_con, arg_tys) = splitProductType "unbox_strict_arg_ty" (repType ty)