Commit 0b98d0b4 authored by simonpj's avatar simonpj
Browse files

[project @ 2002-03-27 12:07:42 by simonpj]

Comments and tracing only
parent b6beb173
......@@ -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) )
......
......@@ -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_`
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment