mkDataCon,
dataConRepType, dataConSig, dataConFullSig,
dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
- dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys,
+ dataConUnivTyVars, dataConExTyVars, dataConAllTyVars,
dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta,
- dataConInstArgTys, dataConOrigArgTys,
+ dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType,
dataConStrictMarks, dataConExStricts,
import Util
import Maybes
import FastString
+import PackageConfig
+import Module
+
+import Data.Char
+import Data.Word
\end{code}
-- 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:
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 (substTyVars subst univ_tvs)
- Just (ftc, insttys) -> mkTyConApp ftc insttys -- data instance
- where
- subst = mkTopTvSubst eq_spec
+ res_ty
-dataConInstArgTys :: DataCon
+dataConInstArgTys :: DataCon -- A datacon with no existentials or equality constraints
+ -- However, it can have a dcTheta (notably it can be a
+ -- class dictionary, with superclasses)
-> [Type] -- Instantiated at these types
- -- NB: these INCLUDE the existentially quantified arg types
-> [Type] -- Needs arguments of these types
- -- NB: these INCLUDE the existentially quantified dict args
+ -- NB: these INCLUDE any dict args
-- but EXCLUDE the data-decl context which is discarded
-- It's all post-flattening etc; this is a representation type
-dataConInstArgTys dc@(MkData {dcRepArgTys = arg_tys,
- dcUnivTyVars = univ_tvs,
+dataConInstArgTys dc@(MkData {dcRepArgTys = rep_arg_tys,
+ dcUnivTyVars = univ_tvs, dcEqSpec = eq_spec,
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]
+ = ASSERT2 ( length univ_tvs == length inst_tys
+ , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
+ ASSERT2 ( null ex_tvs && null eq_spec, ppr dc )
+ map (substTyWith univ_tvs inst_tys) rep_arg_tys
+
+dataConInstOrigArgTys
+ :: DataCon -- Works for any DataCon
+ -> [Type] -- Includes existential tyvar args, but NOT
+ -- equality constraints or dicts
+ -> [Type] -- Returns just the instsantiated *value* arguments
+-- For vanilla datacons, it's all quite straightforward
+-- But for the call in MatchCon, we really do want just the value args
dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs}) inst_tys
- = ASSERT2( length tyvars == length 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
+ map (substTyWith tyvars inst_tys) arg_tys
+ where
+ tyvars = univ_tvs ++ ex_tvs
\end{code}
These two functions get the real argument types of the constructor,
dataConRepArgTys dc = dcRepArgTys dc
\end{code}
+The string <package>:<module>.<name> identifying a constructor, which is attached
+to its info table and used by the GHCi debugger and the heap profiler. We want
+this string to be UTF-8, so we get the bytes directly from the FastStrings.
+
+\begin{code}
+dataConIdentity :: DataCon -> [Word8]
+dataConIdentity dc = bytesFS (packageIdFS (modulePackageId mod)) ++
+ fromIntegral (ord ':') : bytesFS (moduleNameFS (moduleName mod)) ++
+ fromIntegral (ord '.') : bytesFS (occNameFS (nameOccName name))
+ where name = dataConName dc
+ mod = nameModule name
+\end{code}
+
\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
deepSplitProductType_maybe ty
= do { (res@(tycon, tycon_args, _, _)) <- splitProductType_maybe ty
; let {result
- | isClosedNewTyCon tycon && not (isRecursiveTyCon tycon)
- = deepSplitProductType_maybe (newTyConInstRhs tycon tycon_args)
+ | Just (ty', _co) <- instNewTyCon_maybe tycon tycon_args
+ , not (isRecursiveTyCon tycon)
+ = deepSplitProductType_maybe ty' -- Ignore the coercion?
| isNewTyCon tycon = Nothing -- cannot unbox through recursive
-- newtypes nor through families
| otherwise = Just res}
projects / ghc-hetmet.git / blobdiff