Commit 0f43d0db authored by Simon Peyton Jones's avatar Simon Peyton Jones

More tc-tracing

parent e7c3878d
......@@ -1117,12 +1117,19 @@ addFunDepWork inerts work_ev cls
add_fds inert_ct
| isImprovable inert_ev
= emitFunDepDeriveds $
= do { traceTcS "addFunDepWork" (vcat
[ ppr work_ev
, pprCtLoc work_loc, ppr (isGivenLoc work_loc)
, pprCtLoc inert_loc, ppr (isGivenLoc inert_loc)
, pprCtLoc derived_loc, ppr (isGivenLoc derived_loc) ]) ;
emitFunDepDeriveds $
improveFromAnother derived_loc inert_pred work_pred
-- We don't really rewrite tys2, see below _rewritten_tys2, so that's ok
-- NB: We do create FDs for given to report insoluble equations that arise
-- from pairs of Givens, and also because of floating when we approximate
-- implications. The relevant test is: typecheck/should_fail/FDsFromGivens.hs
}
| otherwise
= return ()
where
......@@ -1739,7 +1746,7 @@ emitFunDepDeriveds fd_eqns
where
do_one_FDEqn (FDEqn { fd_qtvs = tvs, fd_eqs = eqs, fd_loc = loc })
| null tvs -- Common shortcut
= do { traceTcS "emitFunDepDeriveds 1" (ppr (ctl_depth loc) $$ ppr eqs)
= do { traceTcS "emitFunDepDeriveds 1" (ppr (ctl_depth loc) $$ ppr eqs $$ ppr (isGivenLoc loc))
; mapM_ (unifyDerived loc Nominal) eqs }
| otherwise
= do { traceTcS "emitFunDepDeriveds 2" (ppr (ctl_depth loc) $$ ppr eqs)
......
......@@ -96,7 +96,7 @@ module TcRnTypes(
bumpSubGoalDepth, subGoalDepthExceeded,
CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,
ctLocTypeOrKind_maybe,
ctLocDepth, bumpCtLocDepth,
ctLocDepth, bumpCtLocDepth, isGivenLoc,
setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,
CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
isVisibleOrigin, toInvisibleOrigin,
......
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