X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=fd817956d23356001bbb09a08291ae30696a8a14;hb=d6b899273f0993030b33a7278329ba8b27f3b6e0;hp=480357e80b0054ed93bab6b30c62b568c3c8abb0;hpb=121da25a0d638bbe6c7f90525ff50b3a20949bbc;p=ghc-hetmet.git diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 480357e..fd81795 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -55,6 +55,7 @@ module Type ( -- Source types predTypeRep, mkPredTy, mkPredTys, + tyConOrigHead, pprSourceTyCon, -- Newtypes splitRecNewType_maybe, newTyConInstRhs, @@ -91,10 +92,10 @@ module Type ( -- Performing substitution on types substTy, substTys, substTyWith, substTheta, - substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar, + substPred, substTyVar, substTyVars, substTyVarBndr, deShadowTy, lookupTyVar, -- Pretty-printing - pprType, pprParendType, pprTyThingCategory, pprForAll, + pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprForAll, pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind ) where @@ -410,7 +411,6 @@ splitNewTyConApp_maybe other = Nothing newTyConInstRhs :: TyCon -> [Type] -> Type newTyConInstRhs tycon tys = let (tvs, ty) = newTyConRhs tycon in substTyWith tvs tys ty - \end{code} @@ -602,6 +602,23 @@ predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys -- Result might be a newtype application, but the consumer will -- look through that too if necessary predTypeRep (EqPred ty1 ty2) = pprPanic "predTypeRep" (ppr (EqPred ty1 ty2)) + +-- The original head is the tycon and its variables for a vanilla tycon and it +-- is the family tycon and its type indexes for a family instance. +tyConOrigHead :: TyCon -> (TyCon, [Type]) +tyConOrigHead tycon = case tyConFamInst_maybe tycon of + Nothing -> (tycon, mkTyVarTys (tyConTyVars tycon)) + Just famInst -> famInst + +-- Pretty prints a tycon, using the family instance in case of a +-- representation tycon. For example +-- e.g. data T [a] = ... +-- In that case we want to print `T [a]', where T is the family TyCon +pprSourceTyCon tycon + | Just (repTyCon, tys) <- tyConFamInst_maybe tycon + = ppr $ repTyCon `TyConApp` tys -- can't be FunTyCon + | otherwise + = ppr tycon \end{code} @@ -1305,6 +1322,9 @@ substTyVar subst@(TvSubst in_scope env) tv Just ty -> ty -- See Note [Apply Once] } +substTyVars :: TvSubst -> [TyVar] -> [Type] +substTyVars subst tvs = map (substTyVar subst) tvs + lookupTyVar :: TvSubst -> TyVar -> Maybe Type -- See Note [Extending the TvSubst] lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv