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.

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 8a0b4f4..a8146ba 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -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.

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 8632895..e864b05 100644 (file)
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -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]
 

diff --git a/compiler/typecheck/TcTyFuns.lhs b/compiler/typecheck/TcTyFuns.lhs
index db65c41..7bb8680 100644 (file)
--- a/compiler/typecheck/TcTyFuns.lhs
+++ b/compiler/typecheck/TcTyFuns.lhs
@@ -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