X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FbasicTypes%2FDataCon.lhs;h=175427ac83d6179023aba8a05c66e34021c542b0;hb=ce9687a5f450014c5596b32de8e8a7b99b6389e8;hp=ac3ffa3d18a7d53ab4e0fddefb376d9174c4c5da;hpb=711e4d7a4d65472a3a1fb35bcad8e1c9a109c728;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs index ac3ffa3..175427a 100644 --- a/ghc/compiler/basicTypes/DataCon.lhs +++ b/ghc/compiler/basicTypes/DataCon.lhs @@ -10,12 +10,12 @@ module DataCon ( mkDataCon, dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon, dataConArgTys, dataConOrigArgTys, dataConInstOrigArgTys, - dataConRepArgTys, dataConTheta, + dataConRepArgTys, dataConTheta, dataConFieldLabels, dataConStrictMarks, dataConSourceArity, dataConRepArity, - dataConNumInstArgs, dataConId, dataConWrapId, dataConRepStrictness, + dataConNumInstArgs, dataConWorkId, dataConWrapId, dataConRepStrictness, isNullaryDataCon, isTupleCon, isUnboxedTupleCon, - isExistentialDataCon, classDataCon, + isExistentialDataCon, classDataCon, dataConExistentialTyVars, splitProductType_maybe, splitProductType, ) where @@ -42,7 +42,7 @@ import Unique ( Unique, Uniquable(..) ) import CmdLineOpts ( opt_UnboxStrictFields ) import Maybe import ListSetOps ( assoc ) -import Util ( zipEqual, zipWithEqual, equalLength ) +import Util ( zipEqual, zipWithEqual, equalLength, notNull ) \end{code} @@ -63,6 +63,41 @@ Every constructor, C, comes with a The worker is very like a primop, in that it has no binding, +A note about the stupid context +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Data types can have a context: + + data (Eq a, Ord b) => T a b = T1 a b | T2 a + +and that makes the constructors have a context too +(notice that T2's context is "thinned"): + + T1 :: (Eq a, Ord b) => a -> b -> T a b + T2 :: (Eq a) => a -> T a b + +Furthermore, this context pops up when pattern matching +(though GHC hasn't implemented this, but it is in H98, and +I've fixed GHC so that it now does): + + f (T2 x) = x +gets inferred type + f :: Eq a => T a b -> a + +I say the context is "stupid" because the dictionaries passed +are immediately discarded -- they do nothing and have no benefit. +It's a flaw in the language. + +Up to now [March 2002] I have put this stupid context into the type of +the "wrapper" constructors functions, T1 and T2, but that turned out +to be jolly inconvenient for generics, and record update, and other +functions that build values of type T (because they don't have +suitable dictionaries available). + +So now I've taken the stupid context out. I simply deal with it +separately in the type checker on occurrences of a constructor, either +in an expression or in a pattern. + + %************************************************************************ %* * @@ -83,9 +118,18 @@ data DataCon -- data Eq a => T a = forall b. Ord b => MkT a [b] dcRepType :: Type, -- Type of the constructor - -- forall ab . Ord b => a -> [b] -> MkT a - -- (this is *not* of the constructor Id: + -- forall a b . Ord b => a -> [b] -> MkT a + -- (this is *not* of the constructor wrapper Id: -- see notes after this data type declaration) + -- + -- Notice that the existential type parameters come *second*. + -- Reason: in a case expression we may find: + -- case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... } + -- It's convenient to apply the rep-type of MkT to 't', to get + -- forall b. Ord b => ... + -- and use that to check the pattern. Mind you, this is really only + -- use in CoreLint. + -- The next six fields express the type of the constructor, in pieces -- e.g. @@ -97,11 +141,23 @@ data DataCon -- dcOrigArgTys = [a,List b] -- dcTyCon = T - dcTyVars :: [TyVar], -- Type vars and context for the data type decl + dcTyVars :: [TyVar], -- Type vars for the data type decl -- These are ALWAYS THE SAME AS THE TYVARS -- FOR THE PARENT TyCon. We occasionally rely on -- this just to avoid redundant instantiation - dcTheta :: ThetaType, + + dcStupidTheta :: ThetaType, -- This is a "thinned" version of the context of + -- the data decl. + -- "Thinned", because the Report says + -- to eliminate any constraints that don't mention + -- tyvars free in the arg types for this constructor + -- + -- "Stupid", because the dictionaries aren't used for anything. + -- + -- Indeed, [as of March 02] they are no + -- longer in the type of the dataConWrapId, because + -- that makes it harder to use the wrap-id to rebuild + -- values after record selection or in generics. dcExTyVars :: [TyVar], -- Ditto for the context of the constructor, dcExTheta :: ThetaType, -- the existentially quantified stuff @@ -136,7 +192,7 @@ data DataCon -- -- An entirely separate wrapper function is built in TcTyDecls - dcId :: Id, -- The corresponding worker Id + dcWorkId :: Id, -- The corresponding worker Id -- Takes dcRepArgTys as its arguments dcWrapId :: Id -- The wrapper Id @@ -199,7 +255,7 @@ instance Show DataCon where %************************************************************************ %* * -\subsection{Consruction} +\subsection{Construction} %* * %************************************************************************ @@ -223,13 +279,13 @@ mkDataCon name arg_stricts fields con where con = MkData {dcName = name, dcUnique = nameUnique name, - dcTyVars = tyvars, dcTheta = theta, + dcTyVars = tyvars, dcStupidTheta = theta, dcOrigArgTys = orig_arg_tys, dcRepArgTys = rep_arg_tys, dcExTyVars = ex_tyvars, dcExTheta = ex_theta, dcStrictMarks = real_stricts, dcRepStrictness = rep_arg_stricts, dcFields = fields, dcTag = tag, dcTyCon = tycon, dcRepType = ty, - dcId = work_id, dcWrapId = wrap_id} + dcWorkId = work_id, dcWrapId = wrap_id} -- Strictness marks for source-args -- *after unboxing choices*, @@ -267,8 +323,8 @@ dataConTyCon = dcTyCon dataConRepType :: DataCon -> Type dataConRepType = dcRepType -dataConId :: DataCon -> Id -dataConId = dcId +dataConWorkId :: DataCon -> Id +dataConWorkId = dcWorkId dataConWrapId :: DataCon -> Id dataConWrapId = dcWrapId @@ -305,7 +361,7 @@ dataConSig :: DataCon -> ([TyVar], ThetaType, [TyVar], ThetaType, [Type], TyCon) -dataConSig (MkData {dcTyVars = tyvars, dcTheta = theta, +dataConSig (MkData {dcTyVars = tyvars, dcStupidTheta = theta, dcExTyVars = ex_tyvars, dcExTheta = ex_theta, dcOrigArgTys = arg_tys, dcTyCon = tycon}) = (tyvars, theta, ex_tyvars, ex_theta, arg_tys, tycon) @@ -323,7 +379,10 @@ dataConArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars, = map (substTyWith (tyvars ++ ex_tyvars) inst_tys) arg_tys dataConTheta :: DataCon -> ThetaType -dataConTheta dc = dcTheta dc +dataConTheta dc = dcStupidTheta dc + +dataConExistentialTyVars :: DataCon -> [TyVar] +dataConExistentialTyVars dc = dcExTyVars dc -- And the same deal for the original arg tys: @@ -358,7 +417,7 @@ isUnboxedTupleCon :: DataCon -> Bool isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc isExistentialDataCon :: DataCon -> Bool -isExistentialDataCon (MkData {dcExTyVars = tvs}) = not (null tvs) +isExistentialDataCon (MkData {dcExTyVars = tvs}) = notNull tvs \end{code}