-- ** Type deconstruction
dataConRepType, dataConSig, dataConFullSig,
- dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
+ dataConName, dataConIdentity, dataConTag, dataConTyCon,
+ dataConOrigTyCon, dataConUserType,
dataConUnivTyVars, dataConExTyVars, dataConAllTyVars,
- dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta, dataConStupidTheta,
+ dataConEqSpec, eqSpecPreds, dataConTheta,
+ dataConStupidTheta,
dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
dataConInstOrigArgTys, dataConRepArgTys,
dataConFieldLabels, dataConFieldType,
-- ** Predicates on DataCons
isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
- isVanillaDataCon, classDataCon,
+ isVanillaDataCon, classDataCon, dataConCannotMatch,
-- * Splitting product types
splitProductType_maybe, splitProductType, deepSplitProductType,
#include "HsVersions.h"
import Type
+import Unify
import Coercion
import TyCon
import Class
import Unique
import ListSetOps
import Util
-import Maybes
import FastString
import Module
+import qualified Data.Data as Data
import Data.Char
import Data.Word
-import Data.List ( partition )
\end{code}
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Each data constructor C has two, and possibly up to four, Names associated with it:
- OccName Name space Name of
- ---------------------------------------------------------------------------
- * 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
+ OccName Name space Name of Notes
+ ---------------------------------------------------------------------------
+ The "data con itself" C DataName DataCon In dom( GlobalRdrEnv )
+ 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
\$wMkT :: a -> T [a]
\$wMkT a x = MkT [a] a [a] x
The third argument is a coerion
- [a] :: [a]:=:[a]
+ [a] :: [a]~[a]
INVARIANT: the dictionary constructor for a class
never has a wrapper.
-- *** As represented internally
-- data T a where
- -- MkT :: forall a. forall x y. (a:=:(x,y),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)]
- -- dcEqTheta = [x~y]
- -- dcDictTheta = [Ord x]
+ -- dcEqSpec = [a~(x,y)]
+ -- dcOtherTheta = [x~y, 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 = dcEqTheta = dcDictTheta = []
+ -- That is: dcExTyVars = dcEqSpec = dcOtherTheta = []
-- 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.
-- The declaration format is held in the TyCon (algTcGadtSyntax)
- dcUnivTyVars :: [TyVar], -- Universally-quantified type vars
+ dcUnivTyVars :: [TyVar], -- Universally-quantified type vars [a,b,c]
-- INVARIANT: length matches arity of the dcRepTyCon
+ --- result type of (rep) data con is exactly (T a b c)
dcExTyVars :: [TyVar], -- Existentially-quantified type vars
-- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
-- _as written by the programmer_
-- This field allows us to move conveniently between the two ways
-- of representing a GADT constructor's type:
- -- MkT :: forall a b. (a :=: [b]) => b -> T a
+ -- MkT :: forall a b. (a ~ [b]) => b -> T a
-- MkT :: forall b. b -> T [b]
- -- Each equality is of the form (a :=: ty), where 'a' is one of
+ -- Each equality is of the form (a ~ ty), where 'a' is one of
-- the universally quantified type variables
-- The next two fields give the type context of the data constructor
-- In GADT form, this is *exactly* what the programmer writes, even if
-- the context constrains only universally quantified variables
-- 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
+ dcOtherTheta :: ThetaType, -- The other constraints in the data con's type
+ -- other than those in the dcEqSpec
dcStupidTheta :: ThetaType, -- The context of the data type declaration
-- data Eq a => T a = ...
dcOrigArgTys :: [Type], -- Original argument types
-- (before unboxing and flattening of strict fields)
- dcOrigResTy :: Type, -- Original result type
+ dcOrigResTy :: Type, -- Original result type, as seen by the user
-- 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],
+ dcStrictMarks :: [HsBang],
-- Strictness annotations as decided by the compiler.
-- Does *not* include the existential dictionaries
-- length = dataConSourceArity dataCon
-- length = 0 (if not a record) or dataConSourceArity.
-- Constructor representation
- dcRepArgTys :: [Type], -- Final, representation argument types,
- -- after unboxing and flattening,
- -- and *including* existential dictionaries
+ dcRepArgTys :: [Type], -- Final, representation argument types,
+ -- after unboxing and flattening,
+ -- and *including* all existential evidence args
- dcRepStrictness :: [StrictnessMark], -- One for each *representation* argument
+ dcRepStrictness :: [StrictnessMark],
+ -- One for each *representation* *value* 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), x~y, Ord x) =>
+ -- forall a x y. (a~(x,y), x~y, Ord x) =>
-- x -> y -> T a
-- (this is *not* of the constructor wrapper Id:
-- see Note [Data con representation] below)
-- case (e :: T t) of
-- MkT x y co1 co2 (d:Ord x) (v:r) (w:F s) -> ...
-- It's convenient to apply the rep-type of MkT to 't', to get
- -- forall x y. (t:=:(x,y), x~y, Ord x) => x -> y -> T t
+ -- forall x y. (t~(x,y), x~y, Ord x) => x -> y -> T t
-- and use that to check the pattern. Mind you, this is really only
-- used in CoreLint.
instance Show DataCon where
showsPrec p con = showsPrecSDoc p (ppr con)
+
+instance Data.Typeable DataCon where
+ typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
+
+instance Data.Data DataCon where
+ -- don't traverse?
+ toConstr _ = abstractConstr "DataCon"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "DataCon"
\end{code}
-- | Build a new data constructor
mkDataCon :: Name
-> Bool -- ^ Is the constructor declared infix?
- -> [StrictnessMark] -- ^ Strictness annotations written in the source file
- -> [FieldLabel] -- ^ Field labels for the constructor, if it is a record, otherwise empty
+ -> [HsBang] -- ^ Strictness annotations written in the source file
+ -> [FieldLabel] -- ^ Field labels for the constructor, if it is a record,
+ -- otherwise empty
-> [TyVar] -- ^ Universally quantified type variables
-> [TyVar] -- ^ Existentially quantified type variables
-> [(TyVar,Type)] -- ^ GADT equalities
-> ThetaType -- ^ Theta-type occuring before the arguments proper
- -> [Type] -- ^ Argument types
- -> TyCon -- ^ Type constructor we are for
- -> ThetaType -- ^ The "stupid theta", context of the data declaration e.g. @data Eq a => T a ...@
+ -> [Type] -- ^ Original argument types
+ -> Type -- ^ Original result type
+ -> TyCon -- ^ Representation type constructor
+ -> ThetaType -- ^ The "stupid theta", context of the data declaration
+ -- e.g. @data Eq a => T a ...@
-> DataConIds -- ^ The Ids of the actual builder functions
-> DataCon
-- Can get the tag from the TyCon
fields
univ_tvs ex_tvs
eq_spec theta
- orig_arg_tys tycon
+ orig_arg_tys orig_res_ty rep_tycon
stupid_theta ids
-- Warning: mkDataCon is not a good place to check invariants.
-- If the programmer writes the wrong result type in the decl, thus:
dcVanilla = is_vanilla, dcInfix = declared_infix,
dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
dcEqSpec = eq_spec,
+ dcOtherTheta = theta,
dcStupidTheta = stupid_theta,
- dcEqTheta = eq_theta, dcDictTheta = dict_theta,
dcOrigArgTys = orig_arg_tys, dcOrigResTy = orig_res_ty,
- dcRepTyCon = tycon,
+ dcRepTyCon = rep_tycon,
dcRepArgTys = rep_arg_tys,
dcStrictMarks = arg_stricts,
dcRepStrictness = rep_arg_stricts,
-- The 'arg_stricts' passed to mkDataCon are simply those for the
-- source-language arguments. We add extra ones for the
-- dictionary arguments right here.
- (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
- -- 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
- -- In this case orig_res_ty = T (e,e)
- orig_res_ty = mkFamilyTyConApp tycon (substTyVars (mkTopTvSubst eq_spec) univ_tvs)
+ full_theta = eqSpecPreds eq_spec ++ theta
+ real_arg_tys = mkPredTys full_theta ++ orig_arg_tys
+ real_stricts = map mk_dict_strict_mark full_theta ++ arg_stricts
-- Representation arguments and demands
-- To do: eliminate duplication with MkId
(rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
- tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
+ tag = assoc "mkDataCon" (tyConDataCons rep_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
mkFunTys rep_arg_tys $
- mkTyConApp tycon (mkTyVarTys univ_tvs)
+ mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
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
+mk_dict_strict_mark :: PredType -> HsBang
+mk_dict_strict_mark pred | isStrictPred pred = HsStrict
+ | otherwise = HsNoBang
\end{code}
\begin{code}
dataConTyCon :: DataCon -> TyCon
dataConTyCon = dcRepTyCon
+-- | The original type constructor used in the definition of this data
+-- constructor. In case of a data family instance, that will be the family
+-- type constructor.
+dataConOrigTyCon :: DataCon -> TyCon
+dataConOrigTyCon dc
+ | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
+ | otherwise = dcRepTyCon dc
+
-- | The representation type of the data constructor, i.e. the sort
-- type that will represent values of this type at runtime
dataConRepType :: DataCon -> Type
dataConEqSpec :: DataCon -> [(TyVar,Type)]
dataConEqSpec = dcEqSpec
--- | The equational constraints on the data constructor type
-dataConEqTheta :: DataCon -> ThetaType
-dataConEqTheta = dcEqTheta
-
--- | The type class and implicit parameter contsraints on the data constructor type
-dataConDictTheta :: DataCon -> ThetaType
-dataConDictTheta = dcDictTheta
+-- | The *full* constraints on the constructor type
+dataConTheta :: DataCon -> ThetaType
+dataConTheta (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
+ = eqSpecPreds eq_spec ++ theta
-- | Get the Id of the 'DataCon' worker: a function that is the "actual"
-- constructor and has no top level binding in the program. The type may
-- | Extract the type for any given labelled field of the 'DataCon'
dataConFieldType :: DataCon -> FieldLabel -> Type
-dataConFieldType con label = expectJust "unexpected label" $
- lookup label (dcFields con `zip` dcOrigArgTys con)
+dataConFieldType con label
+ = case lookup label (dcFields con `zip` dcOrigArgTys con) of
+ Just ty -> ty
+ Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
-- | The strictness markings decided on by the compiler. Does not include those for
-- existential dictionaries. The list is in one-to-one correspondence with the arity of the 'DataCon'
-dataConStrictMarks :: DataCon -> [StrictnessMark]
+dataConStrictMarks :: DataCon -> [HsBang]
dataConStrictMarks = dcStrictMarks
--- | Strictness of /existential/ arguments only
-dataConExStricts :: DataCon -> [StrictnessMark]
+-- | Strictness of evidence arguments to the wrapper function
+dataConExStricts :: DataCon -> [HsBang]
-- Usually empty, so we don't bother to cache this
-dataConExStricts dc = map mk_dict_strict_mark $ dcDictTheta dc
+dataConExStricts dc = map mk_dict_strict_mark $ (dataConTheta dc)
-- | Source-level arity of the data constructor
dataConSourceArity :: DataCon -> Arity
--
-- 4) The /original/ result type of the 'DataCon'
dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
-dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- 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)
+dataConSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
+ dcEqSpec = eq_spec, dcOtherTheta = theta,
+ dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+ = (univ_tvs ++ ex_tvs, eqSpecPreds eq_spec ++ theta, arg_tys, res_ty)
-- | The \"full signature\" of the 'DataCon' returns, in order:
--
--
-- 4) The result of 'dataConDictTheta'
--
--- 5) The original argument types to the 'DataCon' (i.e. before any change of the representation of the type)
+-- 5) The original argument types to the 'DataCon' (i.e. before
+-- any change of the representation of the type)
--
-- 6) The original result type of the 'DataCon'
dataConFullSig :: DataCon
- -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, ThetaType, [Type], Type)
-dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
- 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)
+ -> ([TyVar], [TyVar], [(TyVar,Type)], ThetaType, [Type], Type)
+dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
+ dcEqSpec = eq_spec, dcOtherTheta = 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
--
-- rather than:
--
--- > T :: forall a c. forall b. (c=[a]) => a -> b -> T c
+-- > 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,
- dcEqTheta = eq_theta, dcDictTheta = dict_theta, dcOrigArgTys = arg_tys,
+ dcOtherTheta = theta, dcOrigArgTys = arg_tys,
dcOrigResTy = res_ty })
= mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $
- mkFunTys (mkPredTys eq_theta) $
- mkFunTys (mkPredTys dict_theta) $
+ mkFunTys (mkPredTys theta) $
mkFunTys arg_tys $
res_ty
[] -> panic "classDataCon"
\end{code}
+\begin{code}
+dataConCannotMatch :: [Type] -> DataCon -> Bool
+-- Returns True iff the data con *definitely cannot* match a
+-- scrutinee of type (T tys)
+-- where T is the type constructor for the data con
+-- NB: look at *all* equality constraints, not only those
+-- in dataConEqSpec; see Trac #5168
+dataConCannotMatch tys con
+ | null theta = False -- Common
+ | all isTyVarTy tys = False -- Also common
+ | otherwise
+ = typesCantMatch [(Type.substTy subst ty1, Type.substTy subst ty2)
+ | EqPred ty1 ty2 <- theta ]
+ where
+ dc_tvs = dataConUnivTyVars con
+ theta = dataConTheta con
+ subst = zipTopTvSubst dc_tvs tys
+\end{code}
+
%************************************************************************
%* *
\subsection{Splitting products}
Nothing -> pprPanic (str ++ ": not a product") (pprType ty)
-- | Compute the representation type strictness and type suitable for a 'DataCon'
-computeRep :: [StrictnessMark] -- ^ Original argument strictness
+computeRep :: [HsBang] -- ^ Original argument strictness
-> [Type] -- ^ Original argument types
-> ([StrictnessMark], -- Representation arg strictness
[Type]) -- And type
computeRep stricts tys
= unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
where
- unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
- unbox MarkedStrict ty = [(MarkedStrict, ty)]
- unbox MarkedUnboxed ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
- where
- (_tycon, _tycon_args, arg_dc, arg_tys)
- = deepSplitProductType "unbox_strict_arg_ty" ty
+ unbox HsNoBang ty = [(NotMarkedStrict, ty)]
+ unbox HsStrict ty = [(MarkedStrict, ty)]
+ unbox HsUnpackFailed ty = [(MarkedStrict, ty)]
+ unbox HsUnpack ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
+ where
+ (_tycon, _tycon_args, arg_dc, arg_tys)
+ = deepSplitProductType "unbox_strict_arg_ty" ty
\end{code}
projects / ghc-hetmet.git / blobdiff