X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=a5ff5ad625390521d30e95b42f7a0465092a49c3;hb=fd7c5f3251794224e1d48d09eeffe18fd76420a2;hp=37f915be1dfca92944994916e3bc02fe5a1d3fae;hpb=ff8e1d01524b48e028b09e2b04b2e5303cb6d95f;p=ghc-hetmet.git diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 37f915b..a5ff5ad 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -57,7 +57,7 @@ module Type ( predTypeRep, mkPredTy, mkPredTys, pprSourceTyCon, mkFamilyTyConApp, -- Newtypes - splitRecNewType_maybe, newTyConInstRhs, + newTyConInstRhs, -- Lifting and boxity isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType, @@ -122,6 +122,7 @@ import Util import Outputable import UniqSet +import Data.List import Data.Maybe ( isJust ) \end{code} @@ -631,31 +632,6 @@ pprSourceTyCon tycon %************************************************************************ %* * - NewTypes -%* * -%************************************************************************ - -\begin{code} -splitRecNewType_maybe :: Type -> Maybe Type --- Sometimes we want to look through a recursive newtype, and that's what happens here --- It only strips *one layer* off, so the caller will usually call itself recursively --- Only applied to types of kind *, hence the newtype is always saturated -splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty' -splitRecNewType_maybe (TyConApp tc tys) - | isClosedNewTyCon tc - = ASSERT( tys `lengthIs` tyConArity tc ) -- splitRecNewType_maybe only be applied - -- to *types* (of kind *) - ASSERT( isRecursiveTyCon tc ) -- Guaranteed by coreView - case newTyConRhs tc of - (tvs, rep_ty) -> ASSERT( length tvs == length tys ) - Just (substTyWith tvs tys rep_ty) - -splitRecNewType_maybe other = Nothing -\end{code} - - -%************************************************************************ -%* * \subsection{Kinds and free variables} %* * %************************************************************************