From ad6bc60d7330ec56c08fd81e1d992b5ed2db8a57 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Tue, 28 Aug 2001 10:03:24 +0000
Subject: [PATCH 1/1] [project @ 2001-08-28 10:03:23 by simonpj] Add
 pprEquation

---
 ghc/compiler/typecheck/TcSimplify.lhs |    8 ++------
 ghc/compiler/types/FunDeps.lhs        |   11 ++++++++++-
 2 files changed, 12 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index b9da476..52c316c 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -46,7 +46,7 @@ import TcType		( ThetaType, PredType, mkClassPred, isOverloadedTy,
 import Id		( idType )
 import NameSet		( mkNameSet )
 import Class		( classBigSig )
-import FunDeps		( oclose, grow, improve )
+import FunDeps		( oclose, grow, improve, pprEquationDoc )
 import PrelInfo		( isNumericClass, isCreturnableClass, isCcallishClass )
 
 import Subst		( mkTopTyVarSubst, substTheta, substTy )
@@ -1128,7 +1128,7 @@ tcImprove avails
      if null eqns then
 	returnTc True
      else
-	traceTc (ptext SLIT("Improve:") <+> vcat (map ppr_eqn eqns))	`thenNF_Tc_`
+	traceTc (ptext SLIT("Improve:") <+> vcat (map pprEquationDoc eqns))	`thenNF_Tc_`
         mapTc_ unify eqns	`thenTc_`
 	returnTc False
   where
@@ -1136,10 +1136,6 @@ tcImprove avails
 	 = tcAddErrCtxt doc			$
 	   tcInstTyVars (varSetElems qtvs)	`thenNF_Tc` \ (_, _, tenv) ->
 	   unifyTauTy (substTy tenv t1) (substTy tenv t2)
-    ppr_eqn ((qtvs, t1, t2), doc)
-	= vcat [ptext SLIT("forall") <+> braces (pprWithCommas ppr (varSetElems qtvs))
-				     <+> ppr t1 <+> ptext SLIT(":=:") <+> ppr t2,
-		nest 2 doc]
 \end{code}
 
 The main context-reduction function is @reduce@.  Here's its game plan.
diff --git a/ghc/compiler/types/FunDeps.lhs b/ghc/compiler/types/FunDeps.lhs
index e971a20..1c71ed5 100644
--- a/ghc/compiler/types/FunDeps.lhs
+++ b/ghc/compiler/types/FunDeps.lhs
@@ -7,6 +7,7 @@ It's better to read it as: "if we know these, then we're going to know these"
 
 \begin{code}
 module FunDeps (
+ 	Equation, pprEquation, pprEquationDoc,
 	oclose, grow, improve, checkInstFDs, checkClsFD, pprFundeps
     ) where
 
@@ -20,6 +21,7 @@ import TcType		( Type, ThetaType, SourceType(..), PredType,
 			  predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred,
 			  unifyTyListsX, unifyExtendTysX, tcEqType
 			)
+import PprType		(  )
 import VarSet
 import VarEnv
 import Outputable
@@ -157,6 +159,10 @@ type Equation = (TyVarSet, Type, Type)	-- These two types should be equal, for s
 	--
 
 
+pprEquationDoc (eqn, doc) = vcat [pprEquation eqn, nest 2 doc]
+
+pprEquation (qtvs, t1, t2) = ptext SLIT("forall") <+> braces (pprWithCommas ppr (varSetElems qtvs))
+			     			  <+> ppr t1 <+> ptext SLIT(":=:") <+> ppr t2
 
 ----------
 improve :: InstEnv Id		-- Gives instances for given class
@@ -287,7 +293,10 @@ checkClsFD qtvs fd clas_tvs tys1 tys2
 -- unifyTyListsX will only bind variables in qtvs, so it's OK!
   = case unifyTyListsX qtvs ls1 ls2 of
 	Nothing   -> []
-	Just unif -> [ (qtvs', substTy full_unif r1, substTy full_unif r2)
+	Just unif -> -- pprTrace "checkFD" (vcat [ppr_fd fd,
+		     --			       ppr (varSetElems qtvs) <+> (ppr ls1 $$ ppr ls2),
+		     --			       ppr unif]) $ 
+		     [ (qtvs', substTy full_unif r1, substTy full_unif r2)
 		     | (r1,r2) <- rs1 `zip` rs2,
 		       not (maybeToBool (unifyExtendTysX qtvs unif r1 r2))]
 			-- Don't include any equations that already hold
-- 
1.7.10.4