Fix #2044 (:printing impredicatively typed things)

[ghc-hetmet.git] / compiler / types / Type.lhs

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 67b58a3..df9e3c7 100644 (file)
--- 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,