Commit 9091712c authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Fix Trac #3193: improve line number reporting for equality constraints

When reporting an error from a failed equality constraint, we were
setting the *context* but not the *line number* in TcTyFuns.eqInstMisMatch
As a result, the line number didn't match the context at all.  It's
trivial to fix.

I'm 99% certain this fixes #3193, but it's too complicated to
reproduce, so I have not actually tested it.
parent a4cb6516
......@@ -711,11 +711,11 @@ getInstLoc origin
= do { loc <- getSrcSpanM ; env <- getLclEnv ;
return (InstLoc origin loc (tcl_ctxt env)) }
addInstCtxt :: InstLoc -> TcM a -> TcM a
setInstCtxt :: InstLoc -> TcM a -> TcM a
-- Add the SrcSpan and context from the first Inst in the list
-- (they all have similar locations)
addInstCtxt (InstLoc _ src_loc ctxt) thing_inside
= setSrcSpan src_loc (updCtxt (\_ -> ctxt) thing_inside)
setInstCtxt (InstLoc _ src_loc ctxt) thing_inside
= setSrcSpan src_loc (setErrCtxt ctxt thing_inside)
\end{code}
The addErrTc functions add an error message, but do not cause failure.
......
......@@ -3107,7 +3107,7 @@ groupErrs report_err (inst:insts)
(friends, others) = partition is_friend insts
loc_msg = showSDoc (pprInstLoc (instLoc inst))
is_friend friend = showSDoc (pprInstLoc (instLoc friend)) == loc_msg
do_one insts = addInstCtxt (instLoc (head insts)) (report_err insts)
do_one insts = setInstCtxt (instLoc (head insts)) (report_err insts)
-- Add location and context information derived from the Insts
-- Add the "arising from..." part to a message about bunch of dicts
......@@ -3316,7 +3316,7 @@ monomorphism_fix dflags
warnDefault :: [(Inst, Class, Var)] -> Type -> TcM ()
warnDefault ups default_ty = do
warn_flag <- doptM Opt_WarnTypeDefaults
addInstCtxt (instLoc (head (dicts))) (warnTc warn_flag warn_msg)
setInstCtxt (instLoc (head (dicts))) (warnTc warn_flag warn_msg)
where
dicts = [d | (d,_,_) <- ups]
......
......@@ -1599,10 +1599,9 @@ somethingdifferent message.
eqInstMisMatch :: Inst -> TcM a
eqInstMisMatch inst
= ASSERT( isEqInst inst )
setErrCtxt ctxt $ failWithMisMatch ty_act ty_exp
setInstCtxt (instLoc inst) $ failWithMisMatch ty_act ty_exp
where
(ty_act, ty_exp) = eqInstTys inst
InstLoc _ _ ctxt = instLoc inst
-----------------------
failWithMisMatch :: TcType -> TcType -> TcM a
......
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