2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[DataCon]{@DataCon@: Data Constructors}
11 dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
12 dataConArgTys, dataConOrigArgTys,
14 dataConFieldLabels, dataConStrictMarks,
15 dataConSourceArity, dataConRepArity,
16 dataConNumInstArgs, dataConId, dataConWrapId, dataConRepStrictness,
17 isNullaryDataCon, isTupleCon, isUnboxedTupleCon, isDynDataCon,
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,
35 splitAlgTyConApp_maybe, classesToPreds
37 import TyCon ( TyCon, tyConDataCons, isDataTyCon, isProductTyCon,
38 isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon )
39 import Class ( classTyCon )
40 import Name ( Name, NamedThing(..), nameUnique, isDynName, 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 dcTheta :: ClassContext,
110 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
111 dcExTheta :: ClassContext, -- the existentially quantified stuff
113 dcOrigArgTys :: [Type], -- Original argument types
114 -- (before unboxing and flattening of
117 dcRepArgTys :: [Type], -- Final, representation argument types, after unboxing and flattening,
118 -- and including existential dictionaries
120 dcTyCon :: TyCon, -- Result tycon
122 -- Now the strictness annotations and field labels of the constructor
123 dcUserStricts :: [StrictnessMark],
124 -- Strictness annotations, as placed on the data type defn,
125 -- in the same order as the argument types;
126 -- length = dataConSourceArity dataCon
128 dcRealStricts :: [StrictnessMark],
129 -- Strictness annotations as deduced by the compiler. May
130 -- include some MarkedUnboxed fields that are merely MarkedStrict
131 -- in dcUserStricts. Also includes the existential dictionaries.
132 -- length = length dcExTheta + dataConSourceArity dataCon
134 dcFields :: [FieldLabel],
135 -- Field labels for this constructor, in the
136 -- same order as the argument types;
137 -- length = 0 (if not a record) or dataConSourceArity.
139 -- Finally, the curried worker function that corresponds to the constructor
140 -- It doesn't have an unfolding; the code generator saturates these Ids
141 -- and allocates a real constructor when it finds one.
143 -- An entirely separate wrapper function is built in TcTyDecls
145 dcId :: Id, -- The corresponding worker Id
146 -- Takes dcRepArgTys as its arguments
148 dcWrapId :: Id -- The wrapper Id
154 fIRST_TAG = 1 -- Tags allocated from here for real constructors
157 The dcRepType field contains the type of the representation of a contructor
158 This may differ from the type of the contructor *Id* (built
159 by MkId.mkDataConId) for two reasons:
160 a) the constructor Id may be overloaded, but the dictionary isn't stored
161 e.g. data Eq a => T a = MkT a a
163 b) the constructor may store an unboxed version of a strict field.
165 Here's an example illustrating both:
166 data Ord a => T a = MkT Int! a
168 T :: Ord a => Int -> a -> T a
170 Trep :: Int# -> a -> T a
171 Actually, the unboxed part isn't implemented yet!
174 %************************************************************************
176 \subsection{Strictness indication}
178 %************************************************************************
181 data StrictnessMark = MarkedStrict
182 | MarkedUnboxed DataCon [Type]
185 markedStrict = MarkedStrict
186 notMarkedStrict = NotMarkedStrict
187 markedUnboxed = MarkedUnboxed (panic "markedUnboxed1") (panic "markedUnboxed2")
189 maybeMarkedUnboxed (MarkedUnboxed dc tys) = Just (dc,tys)
190 maybeMarkedUnboxed other = Nothing
194 %************************************************************************
196 \subsection{Instances}
198 %************************************************************************
201 instance Eq DataCon where
202 a == b = getUnique a == getUnique b
203 a /= b = getUnique a /= getUnique b
205 instance Ord DataCon where
206 a <= b = getUnique a <= getUnique b
207 a < b = getUnique a < getUnique b
208 a >= b = getUnique a >= getUnique b
209 a > b = getUnique a > getUnique b
210 compare a b = getUnique a `compare` getUnique b
212 instance Uniquable DataCon where
215 instance NamedThing DataCon where
218 instance Outputable DataCon where
219 ppr con = ppr (dataConName con)
221 instance Show DataCon where
222 showsPrec p con = showsPrecSDoc p (ppr con)
226 %************************************************************************
228 \subsection{Consruction}
230 %************************************************************************
234 -> [StrictnessMark] -> [FieldLabel]
235 -> [TyVar] -> ClassContext
236 -> [TyVar] -> ClassContext
237 -> [TauType] -> TyCon
240 -- Can get the tag from the TyCon
242 mkDataCon name arg_stricts fields
243 tyvars theta ex_tyvars ex_theta orig_arg_tys tycon
245 = ASSERT(length arg_stricts == length orig_arg_tys)
246 -- The 'stricts' passed to mkDataCon are simply those for the
247 -- source-language arguments. We add extra ones for the
248 -- dictionary arguments right here.
251 con = MkData {dcName = name, dcUnique = nameUnique name,
252 dcTyVars = tyvars, dcTheta = theta,
253 dcOrigArgTys = orig_arg_tys,
254 dcRepArgTys = rep_arg_tys,
255 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
256 dcRealStricts = all_stricts, dcUserStricts = user_stricts,
257 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty,
258 dcId = work_id, dcWrapId = wrap_id}
260 (real_arg_stricts, strict_arg_tyss)
261 = unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
262 rep_arg_tys = [mkDictTy cls tys | (cls,tys) <- ex_theta] ++ concat strict_arg_tyss
264 ex_dict_stricts = map mk_dict_strict_mark ex_theta
265 -- Add a strictness flag for the existential dictionary arguments
266 all_stricts = ex_dict_stricts ++ real_arg_stricts
267 user_stricts = ex_dict_stricts ++ arg_stricts
269 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
270 ty = mkForAllTys (tyvars ++ ex_tyvars)
271 (mkFunTys rep_arg_tys result_ty)
272 -- NB: the existential dict args are already in rep_arg_tys
274 result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
276 mk_dict_strict_mark (clas,tys)
278 -- Don't mark newtype things as strict!
279 isDataTyCon (classTyCon clas) = MarkedStrict
280 | otherwise = NotMarkedStrict
284 dataConName :: DataCon -> Name
287 dataConTag :: DataCon -> ConTag
290 dataConTyCon :: DataCon -> TyCon
291 dataConTyCon = dcTyCon
293 dataConRepType :: DataCon -> Type
294 dataConRepType = dcRepType
296 dataConId :: DataCon -> Id
299 dataConWrapId :: DataCon -> Id
300 dataConWrapId = dcWrapId
302 dataConFieldLabels :: DataCon -> [FieldLabel]
303 dataConFieldLabels = dcFields
305 dataConStrictMarks :: DataCon -> [StrictnessMark]
306 dataConStrictMarks = dcRealStricts
308 -- Number of type-instantiation arguments
309 -- All the remaining arguments of the DataCon are (notionally)
310 -- stored in the DataCon, and are matched in a case expression
311 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
313 dataConSourceArity :: DataCon -> Arity
314 -- Source-level arity of the data constructor
315 dataConSourceArity dc = length (dcOrigArgTys dc)
317 -- dataConRepArity gives the number of actual fields in the
318 -- {\em representation} of the data constructor. This may be more than appear
319 -- in the source code; the extra ones are the existentially quantified
321 dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
323 isNullaryDataCon con = dataConRepArity con == 0
325 dataConRepStrictness :: DataCon -> [Demand]
326 -- Give the demands on the arguments of a
327 -- Core constructor application (Con dc args)
328 dataConRepStrictness dc
329 = go (dcRealStricts dc)
332 go (MarkedStrict : ss) = wwStrict : go ss
333 go (NotMarkedStrict : ss) = wwLazy : go ss
334 go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
336 dataConSig :: DataCon -> ([TyVar], ClassContext,
337 [TyVar], ClassContext,
340 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
341 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
342 dcOrigArgTys = arg_tys, dcTyCon = tycon})
343 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
345 dataConArgTys :: DataCon
346 -> [Type] -- Instantiated at these types
347 -- NB: these INCLUDE the existentially quantified arg types
348 -> [Type] -- Needs arguments of these types
349 -- NB: these INCLUDE the existentially quantified dict args
350 -- but EXCLUDE the data-decl context which is discarded
351 -- It's all post-flattening etc; this is a representation type
353 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
354 dcExTyVars = ex_tyvars}) inst_tys
355 = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys)) arg_tys
358 These two functions get the real argument types of the constructor,
359 without substituting for any type variables.
361 dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
363 dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
364 after any flattening has been done.
367 dataConOrigArgTys :: DataCon -> [Type]
368 dataConOrigArgTys dc = dcOrigArgTys dc
370 dataConRepArgTys :: DataCon -> [TauType]
371 dataConRepArgTys dc = dcRepArgTys dc
376 isTupleCon :: DataCon -> Bool
377 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
379 isUnboxedTupleCon :: DataCon -> Bool
380 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
382 isExistentialDataCon :: DataCon -> Bool
383 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
385 isDynDataCon :: DataCon -> Bool
386 isDynDataCon con = isDynName (dataConName con)
390 %************************************************************************
392 \subsection{Splitting products}
394 %************************************************************************
397 splitProductType_maybe
398 :: Type -- A product type, perhaps
399 -> Maybe (TyCon, -- The type constructor
400 [Type], -- Type args of the tycon
401 DataCon, -- The data constructor
402 [Type]) -- Its *representation* arg types
404 -- Returns (Just ...) for any
405 -- single-constructor
406 -- not existentially quantified
407 -- type whether a data type or a new type
409 -- Rejecing existentials is conservative. Maybe some things
410 -- could be made to work with them, but I'm not going to sweat
411 -- it through till someone finds it's important.
413 splitProductType_maybe ty
414 = case splitAlgTyConApp_maybe ty of
415 Just (tycon,ty_args,[data_con])
416 | isProductTyCon tycon -- Includes check for non-existential
417 -> Just (tycon, ty_args, data_con, dataConArgTys data_con ty_args)
420 splitProductType str ty
421 = case splitProductType_maybe ty of
423 Nothing -> pprPanic (str ++ ": not a product") (ppr ty)
425 -- We attempt to unbox/unpack a strict field when either:
426 -- (i) The tycon is imported, and the field is marked '! !', or
427 -- (ii) The tycon is defined in this module, the field is marked '!',
428 -- and the -funbox-strict-fields flag is on.
430 -- This ensures that if we compile some modules with -funbox-strict-fields and
431 -- some without, the compiler doesn't get confused about the constructor
434 unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
436 unbox_strict_arg_ty tycon strict_mark ty
437 | case strict_mark of
438 NotMarkedStrict -> False
439 MarkedUnboxed _ _ -> True
440 MarkedStrict -> opt_UnboxStrictFields &&
441 isLocallyDefined tycon &&
442 maybeToBool maybe_product &&
443 not (isRecursiveTyCon tycon) &&
444 isDataTyCon arg_tycon
445 -- We can't look through newtypes in arguments (yet)
446 = (MarkedUnboxed con arg_tys, arg_tys)
449 = (strict_mark, [ty])
452 maybe_product = splitProductType_maybe ty
453 Just (arg_tycon, _, con, arg_tys) = maybe_product