2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[DataCon]{@DataCon@: Data Constructors}
11 dataConType, dataConSig, dataConName, dataConTag, dataConTyCon,
12 dataConArgTys, dataConOrigArgTys,
13 dataConRawArgTys, dataConAllRawArgTys,
14 dataConFieldLabels, dataConStrictMarks, dataConSourceArity,
15 dataConNumFields, dataConNumInstArgs, dataConId, dataConRepStrictness,
16 isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
17 isExistentialDataCon, splitProductType_maybe,
19 StrictnessMark(..), -- Representation visible to MkId only
20 markedStrict, notMarkedStrict, markedUnboxed, maybeMarkedUnboxed
23 #include "HsVersions.h"
25 import {-# SOURCE #-} Subst( substTy, mkTyVarSubst )
27 import CmdLineOpts ( opt_DictsStrict )
29 import Type ( Type, ThetaType, TauType, ClassContext,
30 mkSigmaTy, mkFunTys, mkTyConApp,
32 splitAlgTyConApp_maybe, classesToPreds
35 import TyCon ( TyCon, tyConDataCons, isDataTyCon, isProductTyCon,
36 isTupleTyCon, isUnboxedTupleTyCon )
37 import Class ( classTyCon )
38 import Name ( Name, NamedThing(..), nameUnique, isLocallyDefined )
39 import Var ( TyVar, Id )
40 import FieldLabel ( FieldLabel )
41 import BasicTypes ( Arity )
42 import Demand ( Demand, wwStrict, wwLazy )
44 import Unique ( Unique, Uniquable(..) )
45 import CmdLineOpts ( opt_UnboxStrictFields )
47 import Maybes ( maybeToBool )
53 %************************************************************************
55 \subsection{Data constructors}
57 %************************************************************************
61 = MkData { -- Used for data constructors only;
62 -- there *is* no constructor for a newtype
64 dcUnique :: Unique, -- Cached from Name
69 -- data Eq a => T a = forall b. Ord b => MkT a [b]
71 dcType :: Type, -- Type of the constructor
72 -- forall ab . Ord b => a -> [b] -> MkT a
73 -- (this is *not* of the constructor Id:
74 -- see notes after this data type declaration)
76 -- The next six fields express the type of the constructor, in pieces
82 -- dcExTheta = [Ord b]
83 -- dcOrigArgTys = [a,List b]
86 dcTyVars :: [TyVar], -- Type vars and context for the data type decl
87 dcTheta :: ClassContext,
89 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
90 dcExTheta :: ClassContext, -- the existentially quantified stuff
92 dcOrigArgTys :: [Type], -- Original argument types
93 -- (before unboxing and flattening of
95 dcRepArgTys :: [Type], -- Constructor Argument types
96 dcTyCon :: TyCon, -- Result tycon
98 -- Now the strictness annotations and field labels of the constructor
99 dcUserStricts :: [StrictnessMark],
100 -- Strictness annotations, as placed on the data type defn,
101 -- in the same order as the argument types;
102 -- length = dataConNumFields dataCon
104 dcRealStricts :: [StrictnessMark],
105 -- Strictness annotations as deduced by the compiler. May
106 -- include some MarkedUnboxed fields that are MarkedStrict
108 -- length = dataConNumFields dataCon
110 dcFields :: [FieldLabel],
111 -- Field labels for this constructor, in the
112 -- same order as the argument types;
113 -- length = 0 (if not a record) or dataConSourceArity.
115 -- Finally, the curried function that corresponds to the constructor
116 -- mkT :: forall a b. (Eq a, Ord b) => a -> [b] -> T a
117 -- mkT = /\ab. \deq dord p qs. Con MkT [a, b, dord, p, qs]
118 -- This unfolding is built in MkId.mkDataConId
120 dcId :: Id -- The corresponding Id
126 fIRST_TAG = 1 -- Tags allocated from here for real constructors
129 The dcType field contains the type of the representation of a contructor
130 This may differ from the type of the contructor *Id* (built
131 by MkId.mkDataConId) for two reasons:
132 a) the constructor Id may be overloaded, but the dictionary isn't stored
133 e.g. data Eq a => T a = MkT a a
135 b) the constructor may store an unboxed version of a strict field.
137 Here's an example illustrating both:
138 data Ord a => T a = MkT Int! a
140 T :: Ord a => Int -> a -> T a
142 Trep :: Int# -> a -> T a
143 Actually, the unboxed part isn't implemented yet!
146 %************************************************************************
148 \subsection{Strictness indication}
150 %************************************************************************
153 data StrictnessMark = MarkedStrict
154 | MarkedUnboxed DataCon [Type]
157 markedStrict = MarkedStrict
158 notMarkedStrict = NotMarkedStrict
159 markedUnboxed = MarkedUnboxed (panic "markedUnboxed1") (panic "markedUnboxed2")
161 maybeMarkedUnboxed (MarkedUnboxed dc tys) = Just (dc,tys)
162 maybeMarkedUnboxed other = Nothing
166 %************************************************************************
168 \subsection{Instances}
170 %************************************************************************
173 instance Eq DataCon where
174 a == b = getUnique a == getUnique b
175 a /= b = getUnique a /= getUnique b
177 instance Ord DataCon where
178 a <= b = getUnique a <= getUnique b
179 a < b = getUnique a < getUnique b
180 a >= b = getUnique a >= getUnique b
181 a > b = getUnique a > getUnique b
182 compare a b = getUnique a `compare` getUnique b
184 instance Uniquable DataCon where
187 instance NamedThing DataCon where
190 instance Outputable DataCon where
191 ppr con = ppr (dataConName con)
193 instance Show DataCon where
194 showsPrec p con = showsPrecSDoc p (ppr con)
198 %************************************************************************
200 \subsection{Consruction}
202 %************************************************************************
206 -> [StrictnessMark] -> [FieldLabel]
207 -> [TyVar] -> ClassContext
208 -> [TyVar] -> ClassContext
209 -> [TauType] -> TyCon
212 -- Can get the tag from the TyCon
214 mkDataCon name arg_stricts fields tyvars theta ex_tyvars ex_theta orig_arg_tys tycon id
215 = ASSERT(length arg_stricts == length orig_arg_tys)
216 -- The 'stricts' passed to mkDataCon are simply those for the
217 -- source-language arguments. We add extra ones for the
218 -- dictionary arguments right here.
221 con = MkData {dcName = name, dcUnique = nameUnique name,
222 dcTyVars = tyvars, dcTheta = theta,
223 dcOrigArgTys = orig_arg_tys,
224 dcRepArgTys = rep_arg_tys,
225 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
226 dcRealStricts = all_stricts, dcUserStricts = user_stricts,
227 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcType = ty,
230 (real_arg_stricts, strict_arg_tyss)
231 = unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
232 rep_arg_tys = concat strict_arg_tyss
234 ex_dict_stricts = map mk_dict_strict_mark ex_theta
235 -- Add a strictness flag for the existential dictionary arguments
236 all_stricts = ex_dict_stricts ++ real_arg_stricts
237 user_stricts = ex_dict_stricts ++ arg_stricts
239 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
240 ty = mkSigmaTy (tyvars ++ ex_tyvars)
241 (classesToPreds ex_theta)
242 (mkFunTys rep_arg_tys
243 (mkTyConApp tycon (mkTyVarTys tyvars)))
245 mk_dict_strict_mark (clas,tys)
247 -- Don't mark newtype things as strict!
248 isDataTyCon (classTyCon clas) = MarkedStrict
249 | otherwise = NotMarkedStrict
253 dataConName :: DataCon -> Name
256 dataConTag :: DataCon -> ConTag
259 dataConTyCon :: DataCon -> TyCon
260 dataConTyCon = dcTyCon
262 dataConType :: DataCon -> Type
265 dataConId :: DataCon -> Id
269 dataConFieldLabels :: DataCon -> [FieldLabel]
270 dataConFieldLabels = dcFields
272 dataConStrictMarks :: DataCon -> [StrictnessMark]
273 dataConStrictMarks = dcRealStricts
275 dataConSourceArity :: DataCon -> Arity
276 -- Source-level arity of the data constructor
277 dataConSourceArity dc = length (dcOrigArgTys dc)
279 dataConRepStrictness :: DataCon -> [Demand]
280 -- Give the demands on the arguments of a
281 -- Core constructor application (Con dc args)
282 dataConRepStrictness dc
283 = go (dcRealStricts dc)
286 go (MarkedStrict : ss) = wwStrict : go ss
287 go (NotMarkedStrict : ss) = wwLazy : go ss
288 go (MarkedUnboxed con _ : ss) = go (dcRealStricts con ++ ss)
290 dataConSig :: DataCon -> ([TyVar], ClassContext,
291 [TyVar], ClassContext,
294 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
295 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
296 dcOrigArgTys = arg_tys, dcTyCon = tycon})
297 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
299 dataConArgTys :: DataCon
300 -> [Type] -- Instantiated at these types
301 -- NB: these INCLUDE the existentially quantified arg types
302 -> [Type] -- Needs arguments of these types
303 -- NB: these INCLUDE the existentially quantified dict args
304 -- but EXCLUDE the data-decl context which is discarded
306 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
307 dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
308 = map (substTy (mkTyVarSubst (tyvars ++ ex_tyvars) inst_tys))
309 ([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
312 These two functions get the real argument types of the constructor,
313 without substituting for any type variables. dataConAllRawArgTys is
314 like dataConRawArgTys except that the existential dictionary arguments
315 are included. dataConOrigArgTys is the same, but returns the types
316 written by the programmer.
319 dataConOrigArgTys :: DataCon -> [Type]
320 dataConOrigArgTys dc = dcOrigArgTys dc
322 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
323 dataConRawArgTys dc = dcRepArgTys dc
325 dataConAllRawArgTys :: DataCon -> [TauType]
326 dataConAllRawArgTys con =
327 [mkDictTy cls tys | (cls,tys) <- dcExTheta con] ++ dcRepArgTys con
330 dataConNumFields gives the number of actual fields in the
331 {\em representation} of the data constructor. This may be more than appear
332 in the source code; the extra ones are the existentially quantified
336 -- Number of type-instantiation arguments
337 -- All the remaining arguments of the DataCon are (notionally)
338 -- stored in the DataCon, and are matched in a case expression
339 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
341 dataConNumFields (MkData {dcExTheta = theta, dcRepArgTys = arg_tys})
342 = length theta + length arg_tys
345 = dataConNumFields con == 0 -- function of convenience
347 isTupleCon :: DataCon -> Bool
348 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
350 isUnboxedTupleCon :: DataCon -> Bool
351 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
353 isExistentialDataCon :: DataCon -> Bool
354 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)
358 %************************************************************************
360 \subsection{Splitting products}
362 %************************************************************************
365 splitProductType_maybe
366 :: Type -- A product type, perhaps
367 -> Maybe (TyCon, -- The type constructor
368 [Type], -- Type args of the tycon
369 DataCon, -- The data constructor
370 [Type]) -- Its *representation* arg types
372 -- Returns (Just ...) for any
373 -- single-constructor
374 -- non-recursive type
375 -- not existentially quantified
376 -- type whether a data type or a new type
378 -- Rejecing existentials is conservative. Maybe some things
379 -- could be made to work with them, but I'm not going to sweat
380 -- it through till someone finds it's important.
382 splitProductType_maybe ty
383 = case splitAlgTyConApp_maybe ty of
384 Just (tycon,ty_args,[data_con])
385 | isProductTyCon tycon -- Checks for non-recursive, non-existential
386 -> Just (tycon, ty_args, data_con, data_con_arg_tys)
388 data_con_arg_tys = map (substTy (mkTyVarSubst (dcTyVars data_con) ty_args))
389 (dcRepArgTys data_con)
393 -- We attempt to unbox/unpack a strict field when either:
394 -- (i) The tycon is imported, and the field is marked '! !', or
395 -- (ii) The tycon is defined in this module, the field is marked '!',
396 -- and the -funbox-strict-fields flag is on.
398 -- This ensures that if we compile some modules with -funbox-strict-fields and
399 -- some without, the compiler doesn't get confused about the constructor
402 unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
404 unbox_strict_arg_ty tycon strict_mark ty
405 | case strict_mark of
406 NotMarkedStrict -> False
407 MarkedUnboxed _ _ -> True
408 MarkedStrict -> opt_UnboxStrictFields &&
409 isLocallyDefined tycon &&
410 maybeToBool maybe_product &&
411 isDataTyCon arg_tycon
412 -- We can't look through newtypes in arguments (yet)
413 = (MarkedUnboxed con arg_tys, arg_tys)
416 = (strict_mark, [ty])
419 maybe_product = splitProductType_maybe ty
420 Just (arg_tycon, _, con, arg_tys) = maybe_product