X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Ftypes%2FType.lhs;h=662dd6f993d1e62e3407373baa05c2241013d1d5;hb=9fd454ab395b70946928ed92c3cb7b28a4d036bc;hp=ab47c4c8427bc8531de729bf2c75ed059ae8bc51;hpb=4ff3da9aa11dc1c5d00f03248dc41c7d84309fa1;p=ghc-hetmet.git diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index ab47c4c..662dd6f 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -55,7 +55,7 @@ module Type ( splitTyConApp_maybe, splitTyConApp, splitNewTyConApp_maybe, splitNewTyConApp, - repType, repType', typePrimRep, coreView, tcView, kindView, + repType, typePrimRep, coreView, tcView, kindView, rttiView, mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, applyTy, applyTys, isForAllTy, dropForAlls, @@ -190,6 +190,18 @@ tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys tcView ty = Nothing ----------------------------------------------- +rttiView :: Type -> Type +-- Same, but for the RTTI system, which cannot deal with predicates nor polymorphism +rttiView (ForAllTy _ ty) = rttiView ty +rttiView (NoteTy _ ty) = rttiView ty +rttiView (FunTy PredTy{} ty) = rttiView ty +rttiView (FunTy NoteTy{} ty) = rttiView ty +rttiView ty@TyConApp{} | Just ty' <- coreView ty + = rttiView ty' +rttiView (TyConApp tc tys) = mkTyConApp tc (map rttiView tys) +rttiView ty = ty + +----------------------------------------------- {-# INLINE kindView #-} kindView :: Kind -> Maybe Kind -- C.f. coreView, tcView @@ -483,16 +495,6 @@ repType (TyConApp tc tys) repType ty = ty --- repType' aims to be a more thorough version of repType --- For now it simply looks through the TyConApp args too -repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined - | otherwise = go1 ty - where - go1 = go . repType - go (TyConApp tc tys) = mkTyConApp tc (map repType' tys) - go ty = ty - - -- ToDo: this could be moved to the code generator, using splitTyConApp instead -- of inspecting the type directly. typePrimRep :: Type -> PrimRep