[project @ 2002-03-27 12:07:42 by simonpj]
authorsimonpj <unknown>
Wed, 27 Mar 2002 12:07:45 +0000 (12:07 +0000)
committersimonpj <unknown>
Wed, 27 Mar 2002 12:07:45 +0000 (12:07 +0000)
Comments and tracing only

ghc/compiler/typecheck/TcSimplify.lhs
ghc/compiler/typecheck/TcUnify.lhs

index 1d41193..98e5b70 100644 (file)
@@ -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) )
index 03a3d81..9a574b3 100644 (file)
@@ -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_`