dataConRepType, dataConSig, dataConFullSig,
dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
dataConUnivTyVars, dataConExTyVars, dataConAllTyVars,
- dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta,
+ dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta, dataConStupidTheta,
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
- dataConInstOrigArgTys, dataConRepArgTys,
+ dataConInstOrigArgTys, dataConInstOrigDictsAndArgTys,
+ dataConRepArgTys,
dataConFieldLabels, dataConFieldType,
dataConStrictMarks, dataConExStricts,
dataConSourceArity, dataConRepArity,
import Util
import Maybes
import FastString
+import Module
+
+import Data.Char
+import Data.Word
+import Data.List ( partition )
\end{code}
Note [Data Constructor Naming]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Each data constructor C has two, and possibly three, Names associated with it:
+Each data constructor C has two, and possibly up to four, Names associated with it:
- OccName Name space Used for
+ OccName Name space Name of
---------------------------------------------------------------------------
- * The "source data con" C DataName The DataCon itself
- * The "real data con" C VarName Its worker Id
- * The "wrapper data con" $WC VarName Wrapper Id (optional)
-
-Each of these three has a distinct Unique. The "source data con" name
+ * The "data con itself" C DataName DataCon
+ * The "worker data con" C VarName Id (the worker)
+ * The "wrapper data con" $WC VarName Id (the wrapper)
+ * The "newtype coercion" :CoT TcClsName TyCon
+
+EVERY data constructor (incl for newtypes) has the former two (the
+data con itself, and its worker. But only some data constructors have a
+wrapper (see Note [The need for a wrapper]).
+
+Each of these three has a distinct Unique. The "data con itself" name
appears in the output of the renamer, and names the Haskell-source
data constructor. The type checker translates it into either the wrapper Id
(if it exists) or worker Id (otherwise).
nothing for the wrapper to do. That is, if its defn would be
$wC = C
+Note [The need for a wrapper]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Why might the wrapper have anything to do? Two reasons:
* Unboxing strict fields (with -funbox-strict-fields)
The third argument is a coerion
[a] :: [a]:=:[a]
+INVARIANT: the dictionary constructor for a class
+ never has a wrapper.
A note about the stupid context
--
-- *** As declared by the user
-- data T a where
- -- MkT :: forall x y. (Ord x) => x -> y -> T (x,y)
+ -- MkT :: forall x y. (x~y,Ord x) => x -> y -> T (x,y)
-- *** As represented internally
-- data T a where
- -- MkT :: forall a. forall x y. (a:=:(x,y), Ord x) => x -> y -> T a
+ -- MkT :: forall a. forall x y. (a:=:(x,y),x~y,Ord x) => x -> y -> T a
--
-- The next six fields express the type of the constructor, in pieces
-- e.g.
-- dcUnivTyVars = [a]
-- dcExTyVars = [x,y]
-- dcEqSpec = [a:=:(x,y)]
- -- dcTheta = [Ord x]
+ -- dcEqTheta = [x~y]
+ -- dcDictTheta = [Ord x]
-- dcOrigArgTys = [a,List b]
-- dcRepTyCon = T
-- Its type is of form
-- forall a1..an . t1 -> ... tm -> T a1..an
-- No existentials, no coercions, nothing.
- -- That is: dcExTyVars = dcEqSpec = dcTheta = []
+ -- That is: dcExTyVars = dcEqSpec = dcEqTheta = dcDictTheta = []
-- NB 1: newtypes always have a vanilla data con
-- NB 2: a vanilla constructor can still be declared in GADT-style
-- syntax, provided its type looks like the above.
-- Each equality is of the form (a :=: ty), where 'a' is one of
-- the universally quantified type variables
- dcTheta :: ThetaType, -- The context of the constructor
+ -- The next two fields give the type context of the data constructor
+ -- (aside from the GADT constraints,
+ -- which are given by the dcExpSpec)
-- In GADT form, this is *exactly* what the programmer writes, even if
-- the context constrains only universally quantified variables
- -- MkT :: forall a. Eq a => a -> T a
- -- It may contain user-written equality predicates too
+ -- MkT :: forall a b. (a ~ b, Ord b) => a -> T a b
+ dcEqTheta :: ThetaType, -- The *equational* constraints
+ dcDictTheta :: ThetaType, -- The *type-class and implicit-param* constraints
dcStupidTheta :: ThetaType, -- The context of the data type declaration
-- data Eq a => T a = ...
-- so the error is detected properly... it's just that asaertions here
-- are a little dodgy.
- = ASSERT( not (any isEqPred theta) )
+ = -- ASSERT( not (any isEqPred theta) )
-- We don't currently allow any equality predicates on
-- a data constructor (apart from the GADT ones in eq_spec)
con
dcVanilla = is_vanilla, dcInfix = declared_infix,
dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
dcEqSpec = eq_spec,
- dcStupidTheta = stupid_theta, dcTheta = theta,
+ dcStupidTheta = stupid_theta,
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta,
dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
dcRepTyCon = tycon,
dcRepArgTys = rep_arg_tys,
-- The 'arg_stricts' passed to mkDataCon are simply those for the
-- source-language arguments. We add extra ones for the
-- dictionary arguments right here.
- dict_tys = mkPredTys theta
- real_arg_tys = dict_tys ++ orig_arg_tys
- real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
+ (eq_theta,dict_theta) = partition isEqPred theta
+ dict_tys = mkPredTys dict_theta
+ real_arg_tys = dict_tys ++ orig_arg_tys
+ real_stricts = map mk_dict_strict_mark dict_theta ++ arg_stricts
-- Example
-- data instance T (b,c) where
-- The representation tycon looks like this:
-- data :R7T b c where
-- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
+ -- In this case orig_res_ty = T (e,e)
orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)
-- Representation arguments and demands
tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
mkFunTys (mkPredTys (eqSpecPreds eq_spec)) $
+ mkFunTys (mkPredTys eq_theta) $
-- NB: the dict args are already in rep_arg_tys
-- because they might be flattened..
-- but the equality predicates are not
eqSpecPreds :: [(TyVar,Type)] -> ThetaType
eqSpecPreds spec = [ mkEqPred (mkTyVarTy tv, ty) | (tv,ty) <- spec ]
+mk_dict_strict_mark :: PredType -> StrictnessMark
mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
| otherwise = NotMarkedStrict
\end{code}
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
dataConEqSpec :: DataCon -> [(TyVar,Type)]
dataConEqSpec = dcEqSpec
-dataConTheta :: DataCon -> ThetaType
-dataConTheta = dcTheta
+dataConEqTheta :: DataCon -> ThetaType
+dataConEqTheta = dcEqTheta
+
+dataConDictTheta :: DataCon -> ThetaType
+dataConDictTheta = dcDictTheta
dataConWorkId :: DataCon -> Id
dataConWorkId dc = case dcIds dc of
dataConExStricts :: DataCon -> [StrictnessMark]
-- Strictness of *existential* arguments only
-- Usually empty, so we don't bother to cache this
-dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
+dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc
dataConSourceArity :: DataCon -> Arity
-- Source-level arity of the data constructor
-- {\em representation} of the data constructor. This may be more than appear
-- in the source code; the extra ones are the existentially quantified
-- dictionaries
+dataConRepArity :: DataCon -> Int
dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- dcTheta = theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
- = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys, res_ty)
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+ = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ eq_theta ++ dict_theta, arg_tys, res_ty)
dataConFullSig :: DataCon
- -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type], Type)
+ -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)
dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- dcTheta = theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
- = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+ = (univ_tvs, ex_tvs, eq_spec, eq_theta, dict_theta, arg_tys, res_ty)
dataConOrigResTy :: DataCon -> Type
dataConOrigResTy dc = dcOrigResTy dc
-- mentions the family tycon, not the internal one.
dataConUserType (MkData { dcUnivTyVars = univ_tvs,
dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- dcTheta = theta, dcOrigArgTys = arg_tys,
+ dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys,
dcOrigResTy = res_ty })
= mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
- mkFunTys (mkPredTys theta) $
+ mkFunTys (mkPredTys eq_theta) $
+ mkFunTys (mkPredTys dict_theta) $
mkFunTys arg_tys $
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
+
+dataConInstOrigDictsAndArgTys
+ :: DataCon -- Works for any DataCon
+ -> [Type] -- Includes existential tyvar args, but NOT
+ -- equality constraints or dicts
+ -> [Type] -- Returns just the instsantiated dicts and *value* arguments
+dataConInstOrigDictsAndArgTys dc@(MkData {dcOrigArgTys = arg_tys,
+ dcDictTheta = dicts,
+ dcUnivTyVars = univ_tvs,
+ dcExTyVars = ex_tvs}) inst_tys
+ = ASSERT2( length tyvars == length inst_tys
+ , ptext SLIT("dataConInstOrigDictsAndArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
+ map (substTyWith tyvars inst_tys) (mkPredTys dicts ++ 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
where
data_con = ASSERT( not (null (tyConDataCons tycon)) )
head (tyConDataCons tycon)
- other -> Nothing
+ _other -> Nothing
+splitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
splitProductType str ty
= case splitProductType_maybe ty of
Just stuff -> stuff
Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
+deepSplitProductType_maybe :: Type -> Maybe (TyCon, [Type], DataCon, [Type])
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}
; result
}
+deepSplitProductType :: String -> Type -> (TyCon, [Type], DataCon, [Type])
deepSplitProductType str ty
= case deepSplitProductType_maybe ty of
Just stuff -> stuff
projects / ghc-hetmet.git / blobdiff