X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=de7e4606646981c9bf88ae2277c438363926edc6;hb=fa6c4bf01427a4191a595afecf90d96b27bad306;hp=a5ff5ad625390521d30e95b42f7a0465092a49c3;hpb=fd7c5f3251794224e1d48d09eeffe18fd76420a2;p=ghc-hetmet.git diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index a5ff5ad..de7e460 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -407,8 +407,6 @@ splitNewTyConApp_maybe (TyConApp tc tys) = Just (tc, tys) splitNewTyConApp_maybe (FunTy arg res) = Just (funTyCon, [arg,res]) splitNewTyConApp_maybe other = Nothing --- get instantiated newtype rhs, the arguments had better saturate --- the constructor newTyConInstRhs :: TyCon -> [Type] -> Type newTyConInstRhs tycon tys = let (tvs, ty) = newTyConRhs tycon in substTyWith tvs tys ty @@ -450,12 +448,15 @@ repType :: Type -> Type repType ty | Just ty' <- coreView ty = repType ty' repType (ForAllTy _ ty) = repType ty repType (TyConApp tc tys) - | isClosedNewTyCon tc = -- Recursive newtypes are opaque to coreView - -- but we must expand them here. Sure to - -- be saturated because repType is only applied - -- to types of kind * - ASSERT( {- isRecursiveTyCon tc && -} tys `lengthIs` tyConArity tc ) - repType (new_type_rep tc tys) + | isNewTyCon tc + , (tvs, rep_ty) <- newTyConRep tc + = -- Recursive newtypes are opaque to coreView + -- but we must expand them here. Sure to + -- be saturated because repType is only applied + -- to types of kind * + ASSERT( tys `lengthIs` tyConArity tc ) + repType (substTyWith tvs tys rep_ty) + repType ty = ty -- repType' aims to be a more thorough version of repType @@ -468,12 +469,6 @@ repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined go ty = ty --- new_type_rep doesn't ask any questions: --- it just expands newtype, whether recursive or not -new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon ) - case newTyConRep new_tycon of - (tvs, rep_ty) -> substTyWith tvs tys rep_ty - -- ToDo: this could be moved to the code generator, using splitTyConApp instead -- of inspecting the type directly. typePrimRep :: Type -> PrimRep @@ -488,7 +483,6 @@ typePrimRep ty = case repType ty of -- The reason is that f must have kind *->*, not *->*#, because -- (we claim) there is no way to constrain f's kind any other -- way. - \end{code} @@ -1473,8 +1467,6 @@ isSuperKind other = False isKind :: Kind -> Bool isKind k = isSuperKind (typeKind k) - - isSubKind :: Kind -> Kind -> Bool -- (k1 `isSubKind` k2) checks that k1 <: k2 isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc2