2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[DataCon]{@DataCon@: Data Constructors}
11 dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
12 dataConArgTys, dataConOrigArgTys,
13 dataConRepArgTys, dataConTheta,
14 dataConFieldLabels, dataConStrictMarks,
15 dataConSourceArity, dataConRepArity,
16 dataConNumInstArgs, dataConId, dataConWrapId, dataConRepStrictness,
17 isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
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 )
32 import Type ( Type, ThetaType, TauType, ClassContext,
33 mkForAllTys, mkFunTys, mkTyConApp,
34 mkTyVarTys, mkDictTys,
35 splitTyConApp_maybe, classesToPreds
37 import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon,
38 isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
39 import Class ( classTyCon )
40 import Name ( Name, NamedThing(..), nameUnique, isLocallyDefined )
41 import Var ( TyVar, Id )
42 import FieldLabel ( FieldLabel )
43 import BasicTypes ( Arity )
44 import Demand ( Demand, wwStrict, wwLazy )
46 import Unique ( Unique, Uniquable(..) )
47 import CmdLineOpts ( opt_UnboxStrictFields )
48 import PprType () -- Instances
50 import Maybes ( maybeToBool )
56 Stuff about data constructors
57 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58 Every constructor, C, comes with a
60 *wrapper*, called C, whose type is exactly what it looks like
61 in the source program. It is an ordinary function,
62 and it gets a top-level binding like any other function
64 *worker*, called $wC, which is the actual data constructor.
65 Its type may be different to C, because:
66 - useless dict args are dropped
67 - strict args may be flattened
68 It does not have a binding.
70 The worker is very like a primop, in that it has no binding,
74 %************************************************************************
76 \subsection{Data constructors}
78 %************************************************************************
82 = MkData { -- Used for data constructors only;
83 -- there *is* no constructor for a newtype
85 dcUnique :: Unique, -- Cached from Name
90 -- data Eq a => T a = forall b. Ord b => MkT a [b]
92 dcRepType :: Type, -- Type of the constructor
93 -- forall ab . Ord b => a -> [b] -> MkT a
94 -- (this is *not* of the constructor Id:
95 -- see notes after this data type declaration)
97 -- The next six fields express the type of the constructor, in pieces
103 -- dcExTheta = [Ord b]
104 -- dcOrigArgTys = [a,List b]
107 dcTyVars :: [TyVar], -- Type vars and context for the data type decl
108 -- These are ALWAYS THE SAME AS THE TYVARS
109 -- FOR THE PARENT TyCon. We occasionally rely on
110 -- this just to avoid redundant instantiation
111 dcTheta :: ClassContext,
113 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
114 dcExTheta :: ClassContext, -- the existentially quantified stuff
116 dcOrigArgTys :: [Type], -- Original argument types
117 -- (before unboxing and flattening of
120 dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
121 -- and including existential dictionaries
123 dcTyCon :: TyCon, -- Result tycon
125 -- Now the strictness annotations and field labels of the constructor
126 dcUserStricts :: [StrictnessMark],
127 -- Strictness annotations, as placed on the data type defn,
128 -- in the same order as the argument types;
129 -- length = dataConSourceArity dataCon
131 dcRealStricts :: [StrictnessMark],
132 -- Strictness annotations as deduced by the compiler. May
133 -- include some MarkedUnboxed fields that are merely MarkedStrict
134 -- in dcUserStricts. Also includes the existential dictionaries.
135 -- length = length dcExTheta + dataConSourceArity dataCon
137 dcFields :: [FieldLabel],
138 -- Field labels for this constructor, in the
139 -- same order as the argument types;
140 -- length = 0 (if not a record) or dataConSourceArity.
142 -- Finally, the curried worker function that corresponds to the constructor
143 -- It doesn't have an unfolding; the code generator saturates these Ids
144 -- and allocates a real constructor when it finds one.
146 -- An entirely separate wrapper function is built in TcTyDecls
148 dcId :: Id, -- The corresponding worker Id
149 -- Takes dcRepArgTys as its arguments
151 dcWrapId :: Id -- The wrapper Id
157 fIRST_TAG = 1 -- Tags allocated from here for real constructors
160 The dcRepType field contains the type of the representation of a contructor
161 This may differ from the type of the contructor *Id* (built
162 by MkId.mkDataConId) for two reasons:
163 a) the constructor Id may be overloaded, but the dictionary isn't stored
164 e.g. data Eq a => T a = MkT a a
166 b) the constructor may store an unboxed version of a strict field.
168 Here's an example illustrating both:
169 data Ord a => T a = MkT Int! a
171 T :: Ord a => Int -> a -> T a
173 Trep :: Int# -> a -> T a
174 Actually, the unboxed part isn't implemented yet!
177 %************************************************************************
179 \subsection{Strictness indication}
181 %************************************************************************
184 data StrictnessMark = MarkedStrict
185 | MarkedUnboxed DataCon [Type]
188 markedStrict = MarkedStrict
189 notMarkedStrict = NotMarkedStrict
190 markedUnboxed = MarkedUnboxed (panic "markedUnboxed1") (panic "markedUnboxed2")
192 maybeMarkedUnboxed (MarkedUnboxed dc tys) = Just (dc,tys)
193 maybeMarkedUnboxed other = Nothing
197 %************************************************************************
199 \subsection{Instances}
201 %************************************************************************
204 instance Eq DataCon where
205 a == b = getUnique a == getUnique b
206 a /= b = getUnique a /= getUnique b
208 instance Ord DataCon where
209 a <= b = getUnique a <= getUnique b
210 a < b = getUnique a < getUnique b
211 a >= b = getUnique a >= getUnique b
212 a > b = getUnique a > getUnique b
213 compare a b = getUnique a `compare` getUnique b
215 instance Uniquable DataCon where
218 instance NamedThing DataCon where
221 instance Outputable DataCon where
222 ppr con = ppr (dataConName con)
224 instance Show DataCon where
225 showsPrec p con = showsPrecSDoc p (ppr con)
229 %************************************************************************
231 \subsection{Consruction}
233 %************************************************************************
237 -> [StrictnessMark] -> [FieldLabel]
238 -> [TyVar] -> ClassContext
239 -> [TyVar] -> ClassContext
240 -> [TauType] -> TyCon
243 -- Can get the tag from the TyCon
245 mkDataCon name arg_stricts fields
246 tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
248 = ASSERT(length arg_stricts == length orig_arg_tys)
249 -- The 'stricts' passed to mkDataCon are simply those for the
250 -- source-language arguments. We add extra ones for the
251 -- dictionary arguments right here.
254 con = MkData {dcName = name, dcUnique = nameUnique name,
255 dcTyVars = tyvars, dcTheta = theta,
256 dcOrigArgTys = orig_arg_tys,
257 dcRepArgTys = rep_arg_tys,
258 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
259 dcRealStricts = all_stricts, dcUserStricts = user_stricts,
260 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
261 dcId = work_id, dcWrapId = wrap_id}
263 (real_arg_stricts, strict_arg_tyss)
264 = unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
265 rep_arg_tys = mkDictTys ex_theta ++ concat strict_arg_tyss
267 ex_dict_stricts = map mk_dict_strict_mark ex_theta
268 -- Add a strictness flag for the existential dictionary arguments
269 all_stricts = ex_dict_stricts ++ real_arg_stricts
270 user_stricts = ex_dict_stricts ++ arg_stricts
272 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
273 ty = mkForAllTys (tyvars ++ ex_tyvars)
274 (mkFunTys rep_arg_tys result_ty)
275 -- NB: the existential dict args are already in rep_arg_tys
277 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
279 mk_dict_strict_mark (clas,tys)
281 -- Don't mark newtype things as strict!
282 isDataTyCon (classTyCon clas) = MarkedStrict
283 | otherwise = NotMarkedStrict
287 dataConName :: DataCon -> Name
290 dataConTag :: DataCon -> ConTag
293 dataConTyCon :: DataCon -> TyCon
294 dataConTyCon = dcTyCon
296 dataConRepType :: DataCon -> Type
297 dataConRepType = dcRepType
299 dataConId :: DataCon -> Id
302 dataConWrapId :: DataCon -> Id
303 dataConWrapId = dcWrapId
305 dataConFieldLabels :: DataCon -> [FieldLabel]
306 dataConFieldLabels = dcFields
308 dataConStrictMarks :: DataCon -> [StrictnessMark]
309 dataConStrictMarks = dcRealStricts
311 -- Number of type-instantiation arguments
312 -- All the remaining arguments of the DataCon are (notionally)
313 -- stored in the DataCon, and are matched in a case expression
314 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
316 dataConSourceArity :: DataCon -> Arity
317 -- Source-level arity of the data constructor
318 dataConSourceArity dc = length (dcOrigArgTys dc)
320 -- dataConRepArity gives the number of actual fields in the
321 -- {\em representation} of the data constructor. This may be more than appear
322 -- in the source code; the extra ones are the existentially quantified
324 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
326 isNullaryDataCon con = dataConRepArity con == 0
328 dataConRepStrictness :: DataCon -> [Demand]
329 -- Give the demands on the arguments of a
330 -- Core constructor application (Con dc args)
331 dataConRepStrictness dc
332 = go (dcRealStricts dc)
335 go (MarkedStrict : ss) = wwStrict : go ss
336 go (NotMarkedStrict : ss) = wwLazy : go ss
337 go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
339 dataConSig :: DataCon -> ([TyVar], ClassContext,
340 [TyVar], ClassContext,
343 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
344 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
345 dcOrigArgTys = arg_tys, dcTyCon = tycon})
346 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
348 dataConArgTys :: DataCon
349 -> [Type] -- Instantiated at these types
350 -- NB: these INCLUDE the existentially quantified arg types
351 -> [Type] -- Needs arguments of these types
352 -- NB: these INCLUDE the existentially quantified dict args
353 -- but EXCLUDE the data-decl context which is discarded
354 -- It's all post-flattening etc; this is a representation type
356 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
357 dcExTyVars = ex_tyvars}) inst_tys
358 = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
360 dataConTheta (MkData {dcTheta = theta}) = theta
363 These two functions get the real argument types of the constructor,
364 without substituting for any type variables.
366 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
368 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
369 after any flattening has been done.
372 dataConOrigArgTys :: DataCon -> [Type]
373 dataConOrigArgTys dc = dcOrigArgTys dc
375 dataConRepArgTys :: DataCon -> [TauType]
376 dataConRepArgTys dc = dcRepArgTys dc
381 isTupleCon :: DataCon -> Bool
382 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
384 isUnboxedTupleCon :: DataCon -> Bool
385 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
387 isExistentialDataCon :: DataCon -> Bool
388 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
392 %************************************************************************
394 \subsection{Splitting products}
396 %************************************************************************
399 splitProductType_maybe
400 :: Type -- A product type, perhaps
401 -> Maybe (TyCon, -- The type constructor
402 [Type], -- Type args of the tycon
403 DataCon, -- The data constructor
404 [Type]) -- Its *representation* arg types
406 -- Returns (Just ...) for any
407 -- concrete (i.e. constructors visible)
408 -- single-constructor
409 -- not existentially quantified
410 -- type whether a data type or a new type
412 -- Rejecing existentials is conservative. Maybe some things
413 -- could be made to work with them, but I'm not going to sweat
414 -- it through till someone finds it's important.
416 splitProductType_maybe ty
417 = case splitTyConApp_maybe ty of
419 | isProductTyCon tycon -- Includes check for non-existential,
420 -- and for constructors visible
421 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
423 data_con = head (tyConDataConsIfAvailable tycon)
426 splitProductType str ty
427 = case splitProductType_maybe ty of
429 Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
431 -- We attempt to unbox/unpack a strict field when either:
432 -- (i) The tycon is imported, and the field is marked '! !', or
433 -- (ii) The tycon is defined in this module, the field is marked '!',
434 -- and the -funbox-strict-fields flag is on.
436 -- This ensures that if we compile some modules with -funbox-strict-fields and
437 -- some without, the compiler doesn't get confused about the constructor
440 unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
442 unbox_strict_arg_ty tycon strict_mark ty
443 | case strict_mark of
444 NotMarkedStrict -> False
445 MarkedUnboxed _ _ -> True
446 MarkedStrict -> opt_UnboxStrictFields &&
447 isLocallyDefined tycon &&
448 maybeToBool maybe_product &&
449 not (isRecursiveTyCon tycon) &&
450 isDataTyCon arg_tycon
451 -- We can't look through newtypes in arguments (yet)
452 = (MarkedUnboxed con arg_tys, arg_tys)
455 = (strict_mark, [ty])
458 maybe_product = splitProductType_maybe ty
459 Just (arg_tycon, _, con, arg_tys) = maybe_product