From d29f86b1fe7daf919e9b47a9003daed74b812790 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Fri, 10 Nov 2006 13:15:13 +0000
Subject: [PATCH] Cosmetics and debug printing only

---
 compiler/types/Type.lhs    |   12 +++++++-----
 compiler/types/TypeRep.lhs |    6 +++---
 2 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 88a7bc7..de0215e 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -94,7 +94,7 @@ module Type (
 	substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar,
 
 	-- Pretty-printing
-	pprType, pprParendType, pprTyThingCategory,
+	pprType, pprParendType, pprTyThingCategory, pprForAll,
 	pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind
     ) where
 
@@ -1015,10 +1015,12 @@ cmpTypesX env ty        []        = GT
 -------------
 cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
 cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
-	-- Compare types as well as names for implicit parameters
-	-- This comparison is used exclusively (I think) for the
-	-- finite map built in TcSimplify
-cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2
+	-- Compare names only for implicit parameters
+	-- This comparison is used exclusively (I believe) 
+	-- for the Avails finite map built in TcSimplify
+	-- If the types differ we keep them distinct so that we see 
+	-- a distinct pair to run improvement on 
+cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` (cmpTypesX env tys1 tys2)
 cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2')
 
 -- Constructor order: IParam < ClassP < EqPred
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 5ee0a35..111d194 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -15,8 +15,8 @@ module TypeRep (
 	funTyCon,
 
 	-- Pretty-printing
-	pprType, pprParendType, pprTyThingCategory,
-	pprPred, pprTheta, pprThetaArrow, pprClassPred,
+	pprType, pprParendType, pprTyThingCategory, 
+	pprPred, pprTheta, pprForAll, pprThetaArrow, pprClassPred,
 
 	-- Kinds
 	liftedTypeKind, unliftedTypeKind, openTypeKind,
@@ -468,7 +468,7 @@ pprParendKind = pprParendType
 
 ppr_type :: Prec -> Type -> SDoc
 ppr_type p (TyVarTy tv)       = ppr tv
-ppr_type p (PredTy pred)      = braces (ppr pred)
+ppr_type p (PredTy pred)      = ifPprDebug (ptext SLIT("<pred>")) <> (ppr pred)
 ppr_type p (NoteTy other ty2) = ppr_type p ty2
 ppr_type p (TyConApp tc tys)  = ppr_tc_app p tc tys
 
-- 
1.7.10.4