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