ConTag, fIRST_TAG,
mkDataCon,
dataConRepType, dataConSig, dataConFullSig,
- dataConName, dataConTag, dataConTyCon, dataConUserType,
- dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys,
+ dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
+ dataConUnivTyVars, dataConExTyVars, dataConAllTyVars,
dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta,
- dataConInstArgTys, dataConOrigArgTys,
+ dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType,
dataConStrictMarks, dataConExStricts,
-- dcEqSpec = [a:=:(x,y)]
-- dcTheta = [Ord x]
-- dcOrigArgTys = [a,List b]
- -- dcTyCon = T
+ -- dcRepTyCon = T
dcVanilla :: Bool, -- True <=> This is a vanilla Haskell 98 data constructor
-- Its type is of form
-- The declaration format is held in the TyCon (algTcGadtSyntax)
dcUnivTyVars :: [TyVar], -- Universally-quantified type vars
+ -- INVARIANT: length matches arity of the dcRepTyCon
+
dcExTyVars :: [TyVar], -- Existentially-quantified type vars
-- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
-- FOR THE PARENT TyCon. With GADTs the data con might not even have
dcOrigArgTys :: [Type], -- Original argument types
-- (before unboxing and flattening of strict fields)
-
- -- Result type of constructor is T t1..tn
- dcTyCon :: TyCon, -- Result tycon, T
+ dcOrigResTy :: Type, -- Original result type
+ -- NB: for a data instance, the original user result type may
+ -- differ from the DataCon's representation TyCon. Example
+ -- data instance T [a] where MkT :: a -> T [a]
+ -- The OrigResTy is T [a], but the dcRepTyCon might be :T123
-- Now the strictness annotations and field labels of the constructor
dcStrictMarks :: [StrictnessMark],
dcFields :: [FieldLabel],
-- Field labels for this constructor, in the
- -- same order as the argument types;
+ -- same order as the dcOrigArgTys;
-- length = 0 (if not a record) or dataConSourceArity.
-- Constructor representation
dcRepStrictness :: [StrictnessMark], -- One for each *representation* argument
-- See also Note [Data-con worker strictness] in MkId.lhs
+ -- Result type of constructor is T t1..tn
+ dcRepTyCon :: TyCon, -- Result tycon, T
+
dcRepType :: Type, -- Type of the constructor
-- forall a x y. (a:=:(x,y), Ord x) => x -> y -> MkT a
-- (this is *not* of the constructor wrapper Id:
-- The 'Nothing' case of DCIds is important
-- Not only is this efficient,
-- but it also ensures that the wrapper is replaced
- -- by the worker (becuase it *is* the wroker)
+ -- by the worker (becuase it *is* the worker)
-- even when there are no args. E.g. in
-- f (:) x
-- the (:) *is* the worker.
dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
dcEqSpec = eq_spec,
dcStupidTheta = stupid_theta, dcTheta = theta,
- dcOrigArgTys = orig_arg_tys, dcTyCon = tycon,
+ dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
+ dcRepTyCon = tycon,
dcRepArgTys = rep_arg_tys,
dcStrictMarks = arg_stricts,
dcRepStrictness = rep_arg_stricts,
real_arg_tys = dict_tys ++ orig_arg_tys
real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
+ -- Example
+ -- data instance T (b,c) where
+ -- TI :: forall e. e -> T (e,e)
+ --
+ -- The representation tycon looks like this:
+ -- data :R7T b c where
+ -- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
+ orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)
+
-- Representation arguments and demands
-- To do: eliminate duplication with MkId
(rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
dataConName :: DataCon -> Name
dataConName = dcName
+-- generate a name in the format: package:Module.OccName
+-- and the unique identity of the name
+dataConIdentity :: DataCon -> String
+dataConIdentity dataCon
+ = prettyName
+ where
+ prettyName = pretty packageModule ++ "." ++ pretty occ
+ nm = getName dataCon
+ packageModule = nameModule nm
+ occ = getOccName dataCon
+ pretty :: Outputable a => a -> String
+ pretty = showSDoc . ppr
+
dataConTag :: DataCon -> ConTag
dataConTag = dcTag
dataConTyCon :: DataCon -> TyCon
-dataConTyCon = dcTyCon
+dataConTyCon = dcRepTyCon
dataConRepType :: DataCon -> Type
dataConRepType = dcRepType
-- Core constructor application (Con dc args)
dataConRepStrictness dc = dcRepStrictness dc
-dataConSig :: DataCon -> ([TyVar], ThetaType, [Type])
+dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
- = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys)
+ dcTheta = theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+ = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys, res_ty)
dataConFullSig :: DataCon
- -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type])
+ -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type], Type)
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- dcTheta = theta, dcOrigArgTys = arg_tys, dcTyCon = tycon})
- = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys)
+ dcTheta = theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+ = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)
+
+dataConOrigResTy :: DataCon -> Type
+dataConOrigResTy dc = dcOrigResTy dc
dataConStupidTheta :: DataCon -> ThetaType
dataConStupidTheta dc = dcStupidTheta dc
-dataConResTys :: DataCon -> [Type]
-dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc]
- where
- env = mkTopTvSubst (dcEqSpec dc)
-
dataConUserType :: DataCon -> Type
-- The user-declared type of the data constructor
-- in the nice-to-read form
--- T :: forall a. a -> T [a]
+-- T :: forall a b. a -> b -> T [a]
-- rather than
--- T :: forall b. forall a. (a=[b]) => a -> T b
+-- T :: forall a c. forall b. (c=[a]) => a -> b -> T c
-- NB: If the constructor is part of a data instance, the result type
-- mentions the family tycon, not the internal one.
dataConUserType (MkData { dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
dcTheta = theta, dcOrigArgTys = arg_tys,
- dcTyCon = tycon })
+ dcOrigResTy = res_ty })
= mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
mkFunTys (mkPredTys theta) $
mkFunTys arg_tys $
- case tyConFamInst_maybe tycon of
- Nothing -> mkTyConApp tycon (map (substTyVar subst) univ_tvs)
- Just (ftc, insttys) -> mkTyConApp ftc insttys -- data instance
- where
- subst = mkTopTvSubst eq_spec
+ res_ty
dataConInstArgTys :: DataCon
-> [Type] -- Instantiated at these types
-- NB: these INCLUDE the existentially quantified dict args
-- but EXCLUDE the data-decl context which is discarded
-- It's all post-flattening etc; this is a representation type
-dataConInstArgTys (MkData {dcRepArgTys = arg_tys,
- dcUnivTyVars = univ_tvs,
- dcExTyVars = ex_tvs}) inst_tys
- = ASSERT( length tyvars == length inst_tys )
+dataConInstArgTys dc@(MkData {dcRepArgTys = arg_tys,
+ dcUnivTyVars = univ_tvs,
+ dcExTyVars = ex_tvs}) inst_tys
+ = ASSERT2 ( length tyvars == length inst_tys
+ , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys)
+
map (substTyWith tyvars inst_tys) arg_tys
where
tyvars = univ_tvs ++ ex_tvs
-- And the same deal for the original arg tys
dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
- dcUnivTyVars = univ_tvs,
- dcExTyVars = ex_tvs}) inst_tys
- = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys )
+ dcUnivTyVars = univ_tvs,
+ dcExTyVars = ex_tvs}) inst_tys
+ = ASSERT2( length tyvars == length inst_tys
+ , ptext SLIT("dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
map (substTyWith tyvars inst_tys) arg_tys
where
tyvars = univ_tvs ++ ex_tvs
\begin{code}
isTupleCon :: DataCon -> Bool
-isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
+isTupleCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc
isUnboxedTupleCon :: DataCon -> Bool
-isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
+isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc
isVanillaDataCon :: DataCon -> Bool
isVanillaDataCon dc = dcVanilla dc
classDataCon :: Class -> DataCon
classDataCon clas = case tyConDataCons (classTyCon clas) of
(dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
+ [] -> panic "classDataCon"
\end{code}
%************************************************************************
-- and for constructors visible
-> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
where
- data_con = head (tyConDataCons tycon)
+ data_con = ASSERT( not (null (tyConDataCons tycon)) )
+ head (tyConDataCons tycon)
other -> Nothing
splitProductType str ty