Commit 2407332d authored by simonpj's avatar simonpj

[project @ 2004-03-17 10:12:31 by simonpj]

Fix debug-printing for Insts
parent a6001411
......@@ -5,10 +5,11 @@
\begin{code}
module Inst (
showLIE,
Inst,
pprInst, pprInsts, pprDFuns, pprDictsTheta, pprDictsInFull,
pprDFuns, pprDictsTheta, pprDictsInFull, -- User error messages
showLIE, pprInst, pprInsts, pprInstInFull, -- Debugging messages
tidyInsts, tidyMoreInsts,
newDictsFromOld, newDicts, cloneDict,
......@@ -705,8 +706,9 @@ lookupInst dict@(Dict _ pred@(ClassP clas tys) loc)
; case lookupInstEnv dflags (pkg_ie, tcg_inst_env tcg_env) clas tys of {
([(tenv, (_,_,dfun_id))], []) -> instantiate_dfun tenv dfun_id pred loc ;
(matches, unifs) -> do
{ traceTc (text "lookupInst" <+> vcat [text "matches" <+> ppr matches,
text "unifs" <+> ppr unifs])
{ traceTc (text "lookupInst fail" <+> vcat [text "dict" <+> ppr pred,
text "matches" <+> ppr matches,
text "unifs" <+> ppr unifs])
; return NoInstance } } } }
-- In the case of overlap (multiple matches) we report
-- NoInstance here. That has the effect of making the
......@@ -718,7 +720,10 @@ lookupInst (Dict _ _ _) = returnM NoInstance
-----------------
instantiate_dfun tenv dfun_id pred loc
= -- Record that this dfun is needed
= traceTc (text "lookupInst success" <+>
vcat [text "dict" <+> ppr pred,
text "witness" <+> ppr dfun_id <+> ppr (idType dfun_id) ]) `thenM_`
-- Record that this dfun is needed
record_dfun_usage dfun_id `thenM_`
-- It's possible that not all the tyvars are in
......
......@@ -35,7 +35,7 @@ import Inst ( lookupInst, LookupInstResult(..),
newDictsFromOld, tcInstClassOp,
getDictClassTys, isTyVarDict,
instLoc, zonkInst, tidyInsts, tidyMoreInsts,
Inst, pprInsts, pprDictsInFull, tcGetInstEnvs,
Inst, pprInsts, pprDictsInFull, pprInstInFull, tcGetInstEnvs,
isIPDict, isInheritableInst, pprDFuns, pprDictsTheta
)
import TcEnv ( tcGetGlobalTyVars, tcLookupId, findGlobals )
......@@ -1509,7 +1509,8 @@ reduceList (n,stack) try_me wanteds state
=
#ifdef DEBUG
(if n > 8 then
pprTrace "Jeepers! ReduceContext:" (reduceDepthMsg n stack)
pprTrace "Interesting! Context reduction stack deeper than 8:"
(nest 2 (pprStack stack))
else (\x->x))
#endif
go wanteds state
......@@ -2281,7 +2282,7 @@ badDerivedPred pred
reduceDepthErr n stack
= vcat [ptext SLIT("Context reduction stack overflow; size =") <+> int n,
ptext SLIT("Use -fcontext-stack20 to increase stack size to (e.g.) 20"),
nest 4 (pprDictsInFull stack)]
nest 4 (pprStack stack)]
reduceDepthMsg n stack = nest 4 (pprDictsInFull stack)
pprStack stack = vcat (map pprInstInFull stack)
\end{code}
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