2 % (c) The GRASP/AQUA Project, Glasgow University, 1998
4 \section[DataCon]{@DataCon@: Data Constructors}
11 dataConType, dataConSig, dataConName, dataConTag,
12 dataConOrigArgTys, dataConArgTys, dataConRawArgTys, dataConTyCon,
13 dataConFieldLabels, dataConStrictMarks, dataConSourceArity,
14 dataConNumFields, dataConNumInstArgs, dataConId,
15 isNullaryDataCon, isTupleCon, isUnboxedTupleCon,
19 #include "HsVersions.h"
21 import CmdLineOpts ( opt_DictsStrict )
23 import Type ( Type, ThetaType, TauType,
24 mkSigmaTy, mkFunTys, mkTyConApp,
25 mkTyVarTys, mkDictTy, substTy,
26 splitAlgTyConApp_maybe
29 import TyCon ( TyCon, tyConDataCons, isDataTyCon,
30 isTupleTyCon, isUnboxedTupleTyCon )
31 import Class ( classTyCon )
32 import Name ( Name, NamedThing(..), nameUnique, isLocallyDefinedName )
33 import Var ( TyVar, Id )
35 import FieldLabel ( FieldLabel )
36 import BasicTypes ( StrictnessMark(..), Arity )
38 import Unique ( Unique, Uniquable(..) )
39 import CmdLineOpts ( opt_UnboxStrictFields )
46 %************************************************************************
48 \subsection{Data constructors}
50 %************************************************************************
54 = MkData { -- Used for data constructors only;
55 -- there *is* no constructor for a newtype
57 dcUnique :: Unique, -- Cached from Name
62 -- data Eq a => T a = forall b. Ord b => MkT a [b]
64 dcType :: Type, -- Type of the constructor
65 -- forall ab . Ord b => a -> [b] -> MkT a
66 -- (this is *not* of the constructor Id:
67 -- see notes after this data type declaration)
69 -- The next six fields express the type of the constructor, in pieces
75 -- dcExTheta = [Ord b]
76 -- dcOrigArgTys = [a,List b]
79 dcTyVars :: [TyVar], -- Type vars and context for the data type decl
82 dcExTyVars :: [TyVar], -- Ditto for the context of the constructor,
83 dcExTheta :: ThetaType, -- the existentially quantified stuff
85 dcOrigArgTys :: [Type], -- Original argument types
86 -- (before unboxing and flattening of
88 dcRepArgTys :: [Type], -- Constructor Argument types
89 dcTyCon :: TyCon, -- Result tycon
91 -- Now the strictness annotations and field labels of the constructor
92 dcUserStricts :: [StrictnessMark],
93 -- Strictness annotations, as placed on the data type defn,
94 -- in the same order as the argument types;
95 -- length = dataConNumFields dataCon
97 dcRealStricts :: [StrictnessMark],
98 -- Strictness annotations as deduced by the compiler. May
99 -- include some MarkedUnboxed fields that are MarkedStrict
101 -- length = dataConNumFields dataCon
103 dcFields :: [FieldLabel],
104 -- Field labels for this constructor, in the
105 -- same order as the argument types;
106 -- length = 0 (if not a record) or dataConSourceArity.
108 -- Finally, the curried function that corresponds to the constructor
109 -- mkT :: forall a b. (Eq a, Ord b) => a -> [b] -> T a
110 -- mkT = /\ab. \deq dord p qs. Con MkT [a, b, dord, p, qs]
111 -- This unfolding is built in MkId.mkDataConId
113 dcId :: Id -- The corresponding Id
119 fIRST_TAG = 1 -- Tags allocated from here for real constructors
122 The dcType field contains the type of the representation of a contructor
123 This may differ from the type of the contructor *Id* (built
124 by MkId.mkDataConId) for two reasons:
125 a) the constructor Id may be overloaded, but the dictionary isn't stored
126 e.g. data Eq a => T a = MkT a a
128 b) the constructor may store an unboxed version of a strict field.
130 Here's an example illustrating both:
131 data Ord a => T a = MkT Int! a
133 T :: Ord a => Int -> a -> T a
135 Trep :: Int# -> a -> T a
136 Actually, the unboxed part isn't implemented yet!
140 instance Eq DataCon where
141 a == b = getUnique a == getUnique b
142 a /= b = getUnique a /= getUnique b
144 instance Ord DataCon where
145 a <= b = getUnique a <= getUnique b
146 a < b = getUnique a < getUnique b
147 a >= b = getUnique a >= getUnique b
148 a > b = getUnique a > getUnique b
149 compare a b = getUnique a `compare` getUnique b
151 instance Uniquable DataCon where
154 instance NamedThing DataCon where
157 instance Outputable DataCon where
158 ppr con = ppr (dataConName con)
160 instance Show DataCon where
161 showsPrec p con = showsPrecSDoc p (ppr con)
166 -> [StrictnessMark] -> [FieldLabel]
167 -> [TyVar] -> ThetaType
168 -> [TyVar] -> ThetaType
169 -> [TauType] -> TyCon
172 -- Can get the tag from the TyCon
174 mkDataCon name arg_stricts fields tyvars theta ex_tyvars ex_theta orig_arg_tys tycon id
175 = ASSERT(length arg_stricts == length orig_arg_tys)
176 -- The 'stricts' passed to mkDataCon are simply those for the
177 -- source-language arguments. We add extra ones for the
178 -- dictionary arguments right here.
181 con = MkData {dcName = name, dcUnique = nameUnique name,
182 dcTyVars = tyvars, dcTheta = theta,
183 dcOrigArgTys = orig_arg_tys,
184 dcRepArgTys = rep_arg_tys,
185 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
186 dcRealStricts = all_stricts, dcUserStricts = user_stricts,
187 dcFields = fields, dcTag = tag, dcTyCon = tycon, dcType = ty,
190 (real_arg_stricts, strict_arg_tyss)
191 = unzip (zipWith (unbox_strict_arg_ty tycon) arg_stricts orig_arg_tys)
192 rep_arg_tys = concat strict_arg_tyss
194 ex_dict_stricts = map mk_dict_strict_mark ex_theta
195 -- Add a strictness flag for the existential dictionary arguments
196 all_stricts = ex_dict_stricts ++ real_arg_stricts
197 user_stricts = ex_dict_stricts ++ arg_stricts
199 tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
200 ty = mkSigmaTy (tyvars ++ ex_tyvars)
202 (mkFunTys rep_arg_tys
203 (mkTyConApp tycon (mkTyVarTys tyvars)))
205 mk_dict_strict_mark (clas,tys)
207 -- Don't mark newtype things as strict!
208 isDataTyCon (classTyCon clas) = MarkedStrict
209 | otherwise = NotMarkedStrict
211 -- We attempt to unbox/unpack a strict field when either:
212 -- (i) The tycon is imported, and the field is marked '! !', or
213 -- (ii) The tycon is defined in this module, the field is marked '!',
214 -- and the -funbox-strict-fields flag is on.
216 -- This ensures that if we compile some modules with -funbox-strict-fields and
217 -- some without, the compiler doesn't get confused about the constructor
220 unbox_strict_arg_ty :: TyCon -> StrictnessMark -> Type -> (StrictnessMark, [Type])
221 unbox_strict_arg_ty tycon NotMarkedStrict ty
222 = (NotMarkedStrict, [ty])
223 unbox_strict_arg_ty tycon MarkedStrict ty
224 | not opt_UnboxStrictFields
225 || not (isLocallyDefinedName (getName tycon)) = (MarkedStrict, [ty])
226 unbox_strict_arg_ty tycon marked_unboxed ty
227 -- MarkedUnboxed || (MarkedStrict && opt_UnboxStrictFields && not imported)
228 = case splitAlgTyConApp_maybe ty of
230 -> panic (showSDoc (hcat [
231 text "unbox_strict_arg_ty: constructors for ",
233 text " not available."
235 Just (tycon,ty_args,[con])
236 -> case maybe_unpack_fields emptyUniqSet
237 (zip (dataConOrigArgTys con ty_args)
240 Nothing -> (MarkedStrict, [ty])
241 Just tys -> (MarkedUnboxed con tys, tys)
242 _ -> (MarkedStrict, [ty])
244 -- bail out if we encounter the same tycon twice. This avoids problems like
249 -- where no useful unpacking can be done.
251 maybe_unpack_field :: UniqSet TyCon -> Type -> StrictnessMark -> Maybe [Type]
252 maybe_unpack_field set ty NotMarkedStrict
254 maybe_unpack_field set ty MarkedStrict | not opt_UnboxStrictFields
256 maybe_unpack_field set ty strict
257 = case splitAlgTyConApp_maybe ty of
258 Just (tycon,ty_args,[con])
260 | tycon `elementOfUniqSet` set -> Nothing
261 -- don't unpack constructors with existential tyvars
262 | not (null ex_tyvars) -> Nothing
265 let set' = addOneToUniqSet set tycon in
266 maybe_unpack_fields set'
267 (zip (dataConOrigArgTys con ty_args)
269 where (_, _, ex_tyvars, _, _, _) = dataConSig con
272 maybe_unpack_fields :: UniqSet TyCon -> [(Type,StrictnessMark)] -> Maybe [Type]
273 maybe_unpack_fields set tys
274 | all isJust unpacked_fields = Just (concat (catMaybes unpacked_fields))
275 | otherwise = Nothing
276 where unpacked_fields = map (\(ty,str) -> maybe_unpack_field set ty str) tys
281 dataConName :: DataCon -> Name
284 dataConTag :: DataCon -> ConTag
287 dataConTyCon :: DataCon -> TyCon
288 dataConTyCon = dcTyCon
290 dataConType :: DataCon -> Type
293 dataConId :: DataCon -> Id
297 dataConFieldLabels :: DataCon -> [FieldLabel]
298 dataConFieldLabels = dcFields
300 dataConStrictMarks :: DataCon -> [StrictnessMark]
301 dataConStrictMarks = dcRealStricts
303 dataConRawArgTys :: DataCon -> [TauType] -- a function of convenience
304 dataConRawArgTys = dcRepArgTys
306 dataConSourceArity :: DataCon -> Arity
307 -- Source-level arity of the data constructor
308 dataConSourceArity dc = length (dcOrigArgTys dc)
310 dataConSig :: DataCon -> ([TyVar], ThetaType,
314 dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta,
315 dcExTyVars = ex_tyvars, dcExTheta = ex_theta,
316 dcOrigArgTys = arg_tys, dcTyCon = tycon})
317 = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon)
319 dataConArgTys, dataConOrigArgTys :: DataCon
320 -> [Type] -- Instantiated at these types
321 -- NB: these INCLUDE the existentially quantified arg types
322 -> [Type] -- Needs arguments of these types
323 -- NB: these INCLUDE the existentially quantified dict args
324 -- but EXCLUDE the data-decl context which is discarded
326 dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars,
327 dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
328 = map (substTy (zipVarEnv (tyvars ++ ex_tyvars) inst_tys))
329 ([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
331 dataConOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars,
332 dcExTyVars = ex_tyvars, dcExTheta = ex_theta}) inst_tys
333 = map (substTy (zipVarEnv (tyvars ++ ex_tyvars) inst_tys))
334 ([mkDictTy cls tys | (cls,tys) <- ex_theta] ++ arg_tys)
337 dataConNumFields gives the number of actual fields in the
338 {\em representation} of the data constructor. This may be more than appear
339 in the source code; the extra ones are the existentially quantified
343 -- Number of type-instantiation arguments
344 -- All the remaining arguments of the DataCon are (notionally)
345 -- stored in the DataCon, and are matched in a case expression
346 dataConNumInstArgs (MkData {dcTyVars = tyvars}) = length tyvars
348 dataConNumFields (MkData {dcExTheta = theta, dcRepArgTys = arg_tys})
349 = length theta + length arg_tys
352 = dataConNumFields con == 0 -- function of convenience
354 isTupleCon :: DataCon -> Bool
355 isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
357 isUnboxedTupleCon :: DataCon -> Bool
358 isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
360 isExistentialDataCon :: DataCon -> Bool
361 isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs)