From: simonpj <unknown>
Date: Wed, 27 Mar 2002 12:07:45 +0000 (+0000)
Subject: [project @ 2002-03-27 12:07:42 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~2216
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0b98d0b4072d643f3aacfee5e38519c74af0dd5d;p=ghc-hetmet.git

[project @ 2002-03-27 12:07:42 by simonpj]
Comments and tracing only
---

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 1d41193..98e5b70 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -1469,13 +1469,13 @@ addFree avails free = returnNF_Tc (addToFM avails free IsFree)
 addWanted :: Avails -> Inst -> TcExpr -> [Inst] -> NF_TcM Avails
 addWanted avails wanted rhs_expr wanteds
 -- Do *not* add superclasses as well.  Here's an example of why not
--- 	class Eq a => Foo a b
+-- 	class Eq b => Foo a b
 --	instance Eq a => Foo [a] a
 -- If we are reducing
 --	(Foo [t] t)
 -- we'll first deduce that it holds (via the instance decl).  We
 -- must not then overwrite the Eq t constraint with a superclass selection!
--- 	ToDo: this isn't entirely unsatisfactory, because
+-- 	ToDo: this isn't entirely satisfactory, because
 --	      we may also lose some entirely-legitimate sharing this way
 
   = ASSERT( not (wanted `elemFM` avails) )
diff --git a/ghc/compiler/typecheck/TcUnify.lhs b/ghc/compiler/typecheck/TcUnify.lhs
index 03a3d81..9a574b3 100644
--- a/ghc/compiler/typecheck/TcUnify.lhs
+++ b/ghc/compiler/typecheck/TcUnify.lhs
@@ -311,8 +311,20 @@ tcGen expected_ty extra_tvs thing_inside	-- We expect expected_ty to be a forall
 
     newDicts SignatureOrigin theta			`thenNF_Tc` \ dicts ->
     tcSimplifyCheck sig_msg forall_tvs dicts lie	`thenTc` \ (free_lie, inst_binds) ->
+
+#ifdef DEBUG
+    zonkTcTyVars forall_tvs `thenNF_Tc` \ forall_tys ->
+    traceTc (text "tcGen" <+> vcat [text "extra_tvs" <+> ppr extra_tvs,
+				    text "expected_ty" <+> ppr expected_ty,
+				    text "inst ty" <+> ppr forall_tvs <+> ppr theta <+> ppr phi_ty,
+				    text "free_tvs" <+> ppr free_tvs,
+				    text "forall_tys" <+> ppr forall_tys])	`thenNF_Tc_`
+#endif
+
     checkSigTyVarsWrt free_tvs forall_tvs		`thenTc` \ zonked_tvs ->
 
+    traceTc (text "tcGen:done") `thenNF_Tc_`
+
     let
 	    -- This HsLet binds any Insts which came out of the simplification.
 	    -- It's a bit out of place here, but using AbsBind involves inventing
@@ -1060,6 +1072,10 @@ check_sig_tyvars extra_tvs sig_tvs
     let
 	env_tvs = gbl_tvs `unionVarSet` extra_tvs
     in
+    traceTc (text "check_sig_tyvars" <+> (vcat [text "sig_tys" <+> ppr sig_tys,
+				      text "gbl_tvs" <+> ppr gbl_tvs,
+				      text "extra_tvs" <+> ppr extra_tvs]))	`thenNF_Tc_`
+
     checkTcM (allDistinctTyVars sig_tys env_tvs)
 	     (complain sig_tys env_tvs)		`thenTc_`