X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FType.lhs;h=df9e3c7218730eec854b89575f2b778af27a0bcf;hb=e314b86f6290e5440a46cd5cc29f7878cb78c6fb;hp=67b58a37269e0fb3ccafe2abbbd357fd0da1a569;hpb=467f588c25e6d7825a11eff018a67727b3dea71b;p=ghc-hetmet.git diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs index 67b58a37..df9e3c7 100644 --- a/compiler/types/Type.lhs +++ b/compiler/types/Type.lhs @@ -55,7 +55,7 @@ module Type ( splitTyConApp_maybe, splitTyConApp, splitNewTyConApp_maybe, splitNewTyConApp, - repType, typePrimRep, coreView, tcView, kindView, rttiView, + repType, typePrimRep, coreView, tcView, kindView, mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, applyTy, applyTys, isForAllTy, dropForAlls, @@ -130,6 +130,7 @@ import TyCon import StaticFlags import Util import Outputable +import FastString import Data.List import Data.Maybe ( isJust ) @@ -187,16 +188,6 @@ tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys tcView _ = Nothing ----------------------------------------------- -rttiView :: Type -> Type --- Same, but for the RTTI system, which cannot deal with predicates nor polymorphism -rttiView (ForAllTy _ ty) = rttiView ty -rttiView (FunTy PredTy{} 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 @@ -1272,11 +1263,9 @@ mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst zipOpenTvSubst tyvars tys -#ifdef DEBUG - | length tyvars /= length tys + | debugIsOn && (length tyvars /= length tys) = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst | otherwise -#endif = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys) -- mkTopTvSubst is called when doing top-level substitutions. @@ -1287,20 +1276,16 @@ mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs) zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst zipTopTvSubst tyvars tys -#ifdef DEBUG - | length tyvars /= length tys + | debugIsOn && (length tyvars /= length tys) = pprTrace "zipTopTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst | otherwise -#endif = TvSubst emptyInScopeSet (zipTyEnv tyvars tys) zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv zipTyEnv tyvars tys -#ifdef DEBUG - | length tyvars /= length tys + | debugIsOn && (length tyvars /= length tys) = pprTrace "mkTopTvSubst" (ppr tyvars $$ ppr tys) emptyVarEnv | otherwise -#endif = zip_ty_env tyvars tys emptyVarEnv -- Later substitutions in the list over-ride earlier ones,