X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FDataCon.lhs;h=a04f28f28e0587e498bfcd82b33ec44afae170fe;hp=5da66d9b6a9776550c25ac944580c33b65cbe0ec;hb=80c89b80c355b2aaebcd53330e6c6170c3f05aca;hpb=ef47b5c2f44fce638b623c9cf5bb2f7f62ba619d diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index 5da66d9..a04f28f 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -11,7 +11,8 @@ module DataCon ( dataConRepType, dataConSig, dataConFullSig, dataConName, dataConTag, dataConTyCon, dataConUserType, dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, dataConResTys, - dataConEqSpec, dataConTheta, dataConStupidTheta, + dataConInstTys, + dataConEqSpec, eqSpecPreds, dataConTheta, dataConStupidTheta, dataConInstArgTys, dataConOrigArgTys, dataConInstOrigArgTys, dataConRepArgTys, dataConFieldLabels, dataConFieldType, @@ -32,17 +33,17 @@ module DataCon ( import Type ( Type, ThetaType, substTyWith, substTyVar, mkTopTvSubst, mkForAllTys, mkFunTys, mkTyConApp, mkTyVarTy, mkTyVarTys, - splitTyConApp_maybe, newTyConInstRhs, + splitTyConApp_maybe, newTyConInstRhs, mkPredTys, isStrictPred, pprType, mkPredTy ) import Coercion ( isEqPred, mkEqPred ) import TyCon ( TyCon, FieldLabel, tyConDataCons, isProductTyCon, isTupleTyCon, isUnboxedTupleTyCon, - isNewTyCon, isRecursiveTyCon ) + isNewTyCon, isRecursiveTyCon, tyConFamily_maybe ) import Class ( Class, classTyCon ) import Name ( Name, NamedThing(..), nameUnique, mkSysTvName, mkSystemName ) -+ import Var ( TyVar, CoVar, Id, mkTyVar, tyVarKind, setVarUnique, -+ mkCoVar ) +import Var ( TyVar, CoVar, Id, mkTyVar, tyVarKind, setVarUnique, + mkCoVar ) import BasicTypes ( Arity, StrictnessMark(..) ) import Outputable import Unique ( Unique, Uniquable(..) ) @@ -104,22 +105,55 @@ data constructor. The type checker translates it into either the wrapper Id The data con has one or two Ids associated with it: - The "worker Id", is the actual data constructor. - Its type may be different to the Haskell source constructor - because: - - useless dict args are dropped - - strict args may be flattened - The worker is very like a primop, in that it has no binding. +The "worker Id", is the actual data constructor. +* Every data constructor (newtype or data type) has a worker - Newtypes have no worker Id +* The worker is very like a primop, in that it has no binding. +* For a *data* type, the worker *is* the data constructor; + it has no unfolding - The "wrapper Id", $WC, whose type is exactly what it looks like - in the source program. It is an ordinary function, - and it gets a top-level binding like any other function. +* For a *newtype*, the worker has a compulsory unfolding which + does a cast, e.g. + newtype T = MkT Int + The worker for MkT has unfolding + \(x:Int). x `cast` sym CoT + Here CoT is the type constructor, witnessing the FC axiom + axiom CoT : T = Int - The wrapper Id isn't generated for a data type if the worker - and wrapper are identical. It's always generated for a newtype. +The "wrapper Id", $WC, goes as follows + +* Its type is exactly what it looks like in the source program. + +* It is an ordinary function, and it gets a top-level binding + like any other function. + +* The wrapper Id isn't generated for a data type if there is + nothing for the wrapper to do. That is, if its defn would be + $wC = C + +Why might the wrapper have anything to do? Two reasons: + +* Unboxing strict fields (with -funbox-strict-fields) + data T = MkT !(Int,Int) + $wMkT :: (Int,Int) -> T + $wMkT (x,y) = MkT x y + Notice that the worker has two fields where the wapper has + just one. That is, the worker has type + MkT :: Int -> Int -> T + +* Equality constraints for GADTs + data T a where { MkT :: a -> T [a] } + + The worker gets a type with explicit equality + constraints, thus: + MkT :: forall a b. (a=[b]) => b -> T a + + The wrapper has the programmer-specified type: + $wMkT :: a -> T [a] + $wMkT a x = MkT [a] a [a] x + The third argument is a coerion + [a] :: [a]:=:[a] @@ -302,16 +336,19 @@ data DataCon -- An entirely separate wrapper function is built in TcTyDecls dcIds :: DataConIds, - dcInfix :: Bool -- True <=> declared infix + dcInfix :: Bool, -- True <=> declared infix -- Used for Template Haskell and 'deriving' only -- The actual fixity is stored elsewhere + + dcInstTys :: Maybe [Type] -- If this data constructor is part of a + -- data instance, then these are the type + -- patterns of the instance. } data DataConIds - = NewDC Id -- Newtypes have only a wrapper, but no worker - | AlgDC (Maybe Id) Id -- Algebraic data types always have a worker, and + = DCIds (Maybe Id) Id -- Algebraic data types always have a worker, and -- may or may not have a wrapper, depending on whether - -- the wrapper does anything. + -- the wrapper does anything. Newtypes just have a worker -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments @@ -319,7 +356,7 @@ data DataConIds -- The worker takes dcRepArgTys as its arguments -- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys - -- The 'Nothing' case of AlgDC is important + -- 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) @@ -401,6 +438,7 @@ mkDataCon :: Name -> [TyVar] -> [TyVar] -> [(TyVar,Type)] -> ThetaType -> [Type] -> TyCon + -> Maybe [Type] -> ThetaType -> DataConIds -> DataCon -- Can get the tag from the TyCon @@ -411,6 +449,7 @@ mkDataCon name declared_infix univ_tvs ex_tvs eq_spec theta orig_arg_tys tycon + mb_typats stupid_theta ids = ASSERT( not (any isEqPred theta) ) -- We don't currently allow any equality predicates on @@ -427,9 +466,11 @@ mkDataCon name declared_infix dcStupidTheta = stupid_theta, dcTheta = theta, dcOrigArgTys = orig_arg_tys, dcTyCon = tycon, dcRepArgTys = rep_arg_tys, - dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts, + dcStrictMarks = arg_stricts, + dcRepStrictness = rep_arg_stricts, dcFields = fields, dcTag = tag, dcRepType = ty, - dcIds = ids } + dcIds = ids, + dcInstTys = mb_typats } -- Strictness marks for source-args -- *after unboxing choices*, @@ -496,28 +537,24 @@ dataConTheta = dcTheta dataConWorkId :: DataCon -> Id dataConWorkId dc = case dcIds dc of - AlgDC _ wrk_id -> wrk_id - NewDC _ -> pprPanic "dataConWorkId" (ppr dc) + DCIds _ wrk_id -> wrk_id dataConWrapId_maybe :: DataCon -> Maybe Id -- Returns Nothing if there is no wrapper for an algebraic data con -- and also for a newtype (whose constructor is inlined compulsorily) dataConWrapId_maybe dc = case dcIds dc of - AlgDC mb_wrap _ -> mb_wrap - NewDC wrap -> Nothing + DCIds mb_wrap _ -> mb_wrap dataConWrapId :: DataCon -> Id -- Returns an Id which looks like the Haskell-source constructor dataConWrapId dc = case dcIds dc of - AlgDC (Just wrap) _ -> wrap - AlgDC Nothing wrk -> wrk -- worker=wrapper - NewDC wrap -> wrap + DCIds (Just wrap) _ -> wrap + DCIds Nothing wrk -> wrk -- worker=wrapper dataConImplicitIds :: DataCon -> [Id] dataConImplicitIds dc = case dcIds dc of - AlgDC (Just wrap) work -> [wrap,work] - AlgDC Nothing work -> [work] - NewDC wrap -> [wrap] + DCIds (Just wrap) work -> [wrap,work] + DCIds Nothing work -> [work] dataConFieldLabels :: DataCon -> [FieldLabel] dataConFieldLabels = dcFields @@ -572,20 +609,32 @@ dataConResTys dc = [substTyVar env tv | tv <- dcUnivTyVars dc] where env = mkTopTvSubst (dcEqSpec dc) +dataConInstTys :: DataCon -> Maybe [Type] +dataConInstTys = dcInstTys + dataConUserType :: DataCon -> Type -- The user-declared type of the data constructor -- in the nice-to-read form -- T :: forall a. a -> T [a] -- rather than -- T :: forall b. forall a. (a=[b]) => a -> T b +-- 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 }) + dcTyCon = tycon, dcInstTys = mb_insttys }) = mkForAllTys ((univ_tvs `minusList` map fst eq_spec) ++ ex_tvs) $ mkFunTys (mkPredTys theta) $ mkFunTys arg_tys $ - mkTyConApp tycon (map (substTyVar subst) univ_tvs) + case mb_insttys of + Nothing -> mkTyConApp tycon (map (substTyVar subst) univ_tvs) + Just insttys -> mkTyConApp ftycon insttys -- data instance + where + ftycon = case tyConFamily_maybe tycon of + Just ftycon -> ftycon + Nothing -> panic err + err = "dataConUserType: type patterns without family tycon" where subst = mkTopTvSubst eq_spec