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,
22 StrictnessMark(..), -- Representation visible to MkId only
23 markedStrict, notMarkedStrict, markedUnboxed, maybeMarkedUnboxed
26 #include "HsVersions.h"
28 import {-# SOURCE #-} Subst( substTy, mkTyVarSubst )
30 import CmdLineOpts ( opt_DictsStrict )
31 import Type ( Type, TauType, ClassContext,
32 mkForAllTys, mkFunTys, mkTyConApp,
33 mkTyVarTys, mkDictTys,
36 import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon,
37 isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
38 import Class ( Class, classTyCon )
39 import Name ( Name, NamedThing(..), nameUnique )
40 import Var ( TyVar, Id )
41 import FieldLabel ( FieldLabel )
42 import BasicTypes ( Arity )
43 import Demand ( Demand, wwStrict, wwLazy )
45 import Unique ( Unique, Uniquable(..) )
46 import CmdLineOpts ( opt_UnboxStrictFields )
47 import PprType () -- Instances
48 import Maybes ( maybeToBool )
50 import ListSetOps ( assoc )
54 Stuff about data constructors
55 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
56 Every constructor, C, comes with a
58 *wrapper*, called C, whose type is exactly what it looks like
59 in the source program. It is an ordinary function,
60 and it gets a top-level binding like any other function
62 *worker*, called $wC, which is the actual data constructor.
63 Its type may be different to C, because:
64 - useless dict args are dropped
65 - strict args may be flattened
66 It does not have a binding.
68 The worker is very like a primop, in that it has no binding,
72 %************************************************************************
74 \subsection{Data constructors}
76 %************************************************************************
80 = MkData { -- Used for data constructors only;
81 -- there *is* no constructor for a newtype
83 dcUnique :: Unique, -- Cached from Name
88 -- data Eq a => T a = forall b. Ord b => MkT a [b]
90 dcRepType :: Type, -- Type of the constructor
91 -- forall ab . Ord b => a -> [b] -> MkT a
92 -- (this is *not* of the constructor Id:
93 -- see notes after this data type declaration)
95 -- The next six fields express the type of the constructor, in pieces
101 -- dcExTheta = [Ord b]
102 -- dcOrigArgTys = [a,List b]
105 dcTyVars :: [TyVar], -- Type vars and context for the data type decl
106 -- These are ALWAYS THE SAME AS THE TYVARS
107 -- FOR THE PARENT TyCon. We occasionally rely on
108 -- this just to avoid redundant instantiation
109 dcTheta :: ClassContext,
111 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
112 dcExTheta :: ClassContext, -- the existentially quantified stuff
114 dcOrigArgTys :: [Type], -- Original argument types
115 -- (before unboxing and flattening of
118 dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
119 -- and including existential dictionaries
121 dcTyCon :: TyCon, -- Result tycon
123 -- Now the strictness annotations and field labels of the constructor
124 dcUserStricts :: [StrictnessMark],
125 -- Strictness annotations, as placed on the data type defn,
126 -- in the same order as the argument types;
127 -- length = dataConSourceArity dataCon
129 dcRealStricts :: [StrictnessMark],
130 -- Strictness annotations as deduced by the compiler. May
131 -- include some MarkedUnboxed fields that are merely MarkedStrict
132 -- in dcUserStricts. Also includes the existential dictionaries.
133 -- length = length dcExTheta + dataConSourceArity dataCon
135 dcFields :: [FieldLabel],
136 -- Field labels for this constructor, in the
137 -- same order as the argument types;
138 -- length = 0 (if not a record) or dataConSourceArity.
140 -- Finally, the curried worker function that corresponds to the constructor
141 -- It doesn't have an unfolding; the code generator saturates these Ids
142 -- and allocates a real constructor when it finds one.
144 -- An entirely separate wrapper function is built in TcTyDecls
146 dcId :: Id, -- The corresponding worker Id
147 -- Takes dcRepArgTys as its arguments
149 dcWrapId :: Id -- The wrapper Id
155 fIRST_TAG = 1 -- Tags allocated from here for real constructors
158 The dcRepType field contains the type of the representation of a contructor
159 This may differ from the type of the contructor *Id* (built
160 by MkId.mkDataConId) for two reasons:
161 a) the constructor Id may be overloaded, but the dictionary isn't stored
162 e.g. data Eq a => T a = MkT a a
164 b) the constructor may store an unboxed version of a strict field.
166 Here's an example illustrating both:
167 data Ord a => T a = MkT Int! a
169 T :: Ord a => Int -> a -> T a
171 Trep :: Int# -> a -> T a
172 Actually, the unboxed part isn't implemented yet!
175 %************************************************************************
177 \subsection{Strictness indication}
179 %************************************************************************
182 data StrictnessMark = MarkedStrict
183 | MarkedUnboxed DataCon [Type]
186 markedStrict = MarkedStrict
187 notMarkedStrict = NotMarkedStrict
188 markedUnboxed = MarkedUnboxed (panic "markedUnboxed1") (panic "markedUnboxed2")
190 maybeMarkedUnboxed (MarkedUnboxed dc tys) = Just (dc,tys)
191 maybeMarkedUnboxed other = Nothing
195 %************************************************************************
197 \subsection{Instances}
199 %************************************************************************
202 instance Eq DataCon where
203 a == b = getUnique a == getUnique b
204 a /= b = getUnique a /= getUnique b
206 instance Ord DataCon where
207 a <= b = getUnique a <= getUnique b
208 a < b = getUnique a < getUnique b
209 a >= b = getUnique a >= getUnique b
210 a > b = getUnique a > getUnique b
211 compare a b = getUnique a `compare` getUnique b
213 instance Uniquable DataCon where
216 instance NamedThing DataCon where
219 instance Outputable DataCon where
220 ppr con = ppr (dataConName con)
222 instance Show DataCon where
223 showsPrec p con = showsPrecSDoc p (ppr con)
227 %************************************************************************
229 \subsection{Consruction}
231 %************************************************************************
235 -> [StrictnessMark] -> [FieldLabel]
236 -> [TyVar] -> ClassContext
237 -> [TyVar] -> ClassContext
238 -> [TauType] -> TyCon
241 -- Can get the tag from the TyCon
243 mkDataCon name arg_stricts fields
244 tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
246 = ASSERT(length arg_stricts == length orig_arg_tys)
247 -- The 'stricts' passed to mkDataCon are simply those for the
248 -- source-language arguments. We add extra ones for the
249 -- dictionary arguments right here.
252 con = MkData {dcName = name, dcUnique = nameUnique name,
253 dcTyVars = tyvars, dcTheta = theta,
254 dcOrigArgTys = orig_arg_tys,
255 dcRepArgTys = rep_arg_tys,
256 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
257 dcRealStricts = all_stricts, dcUserStricts = user_stricts,
258 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
259 dcId = work_id, dcWrapId = wrap_id}
261 (real_arg_stricts, strict_arg_tyss)
262 = unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
263 rep_arg_tys = mkDictTys ex_theta ++ concat strict_arg_tyss
265 ex_dict_stricts = map mk_dict_strict_mark ex_theta
266 -- Add a strictness flag for the existential dictionary arguments
267 all_stricts = ex_dict_stricts ++ real_arg_stricts
268 user_stricts = ex_dict_stricts ++ arg_stricts
270 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
271 ty = mkForAllTys (tyvars ++ ex_tyvars)
272 (mkFunTys rep_arg_tys result_ty)
273 -- NB: the existential dict args are already in rep_arg_tys
275 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
277 mk_dict_strict_mark (clas,tys)
279 -- Don't mark newtype things as strict!
280 isDataTyCon (classTyCon clas) = MarkedStrict
281 | otherwise = NotMarkedStrict
285 dataConName :: DataCon -> Name
288 dataConTag :: DataCon -> ConTag
291 dataConTyCon :: DataCon -> TyCon
292 dataConTyCon = dcTyCon
294 dataConRepType :: DataCon -> Type
295 dataConRepType = dcRepType
297 dataConId :: DataCon -> Id
300 dataConWrapId :: DataCon -> Id
301 dataConWrapId = dcWrapId
303 dataConFieldLabels :: DataCon -> [FieldLabel]
304 dataConFieldLabels = dcFields
306 dataConStrictMarks :: DataCon -> [StrictnessMark]
307 dataConStrictMarks = dcRealStricts
309 -- Number of type-instantiation arguments
310 -- All the remaining arguments of the DataCon are (notionally)
311 -- stored in the DataCon, and are matched in a case expression
312 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
314 dataConSourceArity :: DataCon -> Arity
315 -- Source-level arity of the data constructor
316 dataConSourceArity dc = length (dcOrigArgTys dc)
318 -- dataConRepArity gives the number of actual fields in the
319 -- {\em representation} of the data constructor. This may be more than appear
320 -- in the source code; the extra ones are the existentially quantified
322 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
324 isNullaryDataCon con = dataConRepArity con == 0
326 dataConRepStrictness :: DataCon -> [Demand]
327 -- Give the demands on the arguments of a
328 -- Core constructor application (Con dc args)
329 dataConRepStrictness dc
330 = go (dcRealStricts dc)
333 go (MarkedStrict : ss) = wwStrict : go ss
334 go (NotMarkedStrict : ss) = wwLazy : go ss
335 go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
337 dataConSig :: DataCon -> ([TyVar], ClassContext,
338 [TyVar], ClassContext,
341 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
342 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
343 dcOrigArgTys = arg_tys, dcTyCon = tycon})
344 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
346 dataConArgTys :: DataCon
347 -> [Type] -- Instantiated at these types
348 -- NB: these INCLUDE the existentially quantified arg types
349 -> [Type] -- Needs arguments of these types
350 -- NB: these INCLUDE the existentially quantified dict args
351 -- but EXCLUDE the data-decl context which is discarded
352 -- It's all post-flattening etc; this is a representation type
354 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
355 dcExTyVars = ex_tyvars}) inst_tys
356 = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
358 dataConTheta :: DataCon -> ClassContext
359 dataConTheta dc = dcTheta dc
361 -- And the same deal for the original arg tys:
363 dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
364 dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
365 dcExTyVars = ex_tyvars}) inst_tys
366 = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
369 These two functions get the real argument types of the constructor,
370 without substituting for any type variables.
372 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
374 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
375 after any flattening has been done.
378 dataConOrigArgTys :: DataCon -> [Type]
379 dataConOrigArgTys dc = dcOrigArgTys dc
381 dataConRepArgTys :: DataCon -> [TauType]
382 dataConRepArgTys dc = dcRepArgTys dc
387 isTupleCon :: DataCon -> Bool
388 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
390 isUnboxedTupleCon :: DataCon -> Bool
391 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
393 isExistentialDataCon :: DataCon -> Bool
394 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
399 classDataCon :: Class -> DataCon
400 classDataCon clas = case tyConDataCons (classTyCon clas) of
401 (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
404 %************************************************************************
406 \subsection{Splitting products}
408 %************************************************************************
411 splitProductType_maybe
412 :: Type -- A product type, perhaps
413 -> Maybe (TyCon, -- The type constructor
414 [Type], -- Type args of the tycon
415 DataCon, -- The data constructor
416 [Type]) -- Its *representation* arg types
418 -- Returns (Just ...) for any
419 -- concrete (i.e. constructors visible)
420 -- single-constructor
421 -- not existentially quantified
422 -- type whether a data type or a new type
424 -- Rejecing existentials is conservative. Maybe some things
425 -- could be made to work with them, but I'm not going to sweat
426 -- it through till someone finds it's important.
428 splitProductType_maybe ty
429 = case splitTyConApp_maybe ty of
431 | isProductTyCon tycon -- Includes check for non-existential,
432 -- and for constructors visible
433 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
435 data_con = head (tyConDataConsIfAvailable tycon)
438 splitProductType str ty
439 = case splitProductType_maybe ty of
441 Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
443 -- We attempt to unbox/unpack a strict field when either:
444 -- (i) The tycon is imported, and the field is marked '! !', or
445 -- (ii) The tycon is defined in this module, the field is marked '!',
446 -- and the -funbox-strict-fields flag is on.
448 -- This ensures that if we compile some modules with -funbox-strict-fields and
449 -- some without, the compiler doesn't get confused about the constructor
452 unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
454 unbox_strict_arg_ty tycon strict_mark ty
455 | case strict_mark of
456 NotMarkedStrict -> False
457 MarkedUnboxed _ _ -> True -- !! From interface file
458 MarkedStrict -> opt_UnboxStrictFields && -- ! From source
459 maybeToBool maybe_product &&
460 not (isRecursiveTyCon tycon) &&
461 isDataTyCon arg_tycon
462 -- We can't look through newtypes in arguments (yet)
463 = (MarkedUnboxed con arg_tys, arg_tys)
466 = (strict_mark, [ty])
469 maybe_product = splitProductType_maybe ty
470 Just (arg_tycon, _, con, arg_tys) = maybe_product