[project @ 2002-09-25 10:53:34 by simonpj]

Better error locations for instance errors

diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index c138fc6..646205d 100644 (file)
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -188,7 +188,7 @@ mkImpInstEnv dflags eps hpt
   where
          -- We shouldn't get instance conflict errors from
          -- the package and home type envs
-    add dfuns inst_env = WARN( not (null errs), vcat errs ) inst_env'
+    add dfuns inst_env = WARN( not (null errs), vcat (map snd errs) ) inst_env'
                       where
                         (inst_env', errs) = extendInstEnv dflags inst_env dfuns
 
@@ -327,8 +327,10 @@ add_err loc msg
         (warns, errs) <- readMutVar errs_var ;
         writeMutVar errs_var (warns, errs `snocBag` err) }
 
-addErrs :: [Message] -> TcRn m ()
-addErrs msgs = mappM_ addErr msgs
+addErrs :: [(SrcLoc,Message)] -> TcRn m ()
+addErrs msgs = mappM_ add msgs
+            where
+              add (loc,msg) = add_err loc msg
 
 addWarn :: Message -> TcRn m ()
 addWarn msg
@@ -563,7 +565,7 @@ getInstLoc origin
         return (origin, loc, (tcl_ctxt env)) }
 \end{code}
 
-    The addErr functions add an error message, but do not cause failure.
+    The addErrTc functions add an error message, but do not cause failure.
     The 'M' variants pass a TidyEnv that has already been used to
     tidy up the message; we then use it to tidy the context messages
 

diff --git a/ghc/compiler/types/InstEnv.lhs b/ghc/compiler/types/InstEnv.lhs
index 50b9ec1..73a6ce9 100644 (file)
--- a/ghc/compiler/types/InstEnv.lhs
+++ b/ghc/compiler/types/InstEnv.lhs
@@ -22,7 +22,7 @@ import VarSet
 import VarEnv
 import Maybes          ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
 import Name            ( getSrcLoc, nameModule )
-import SrcLoc          ( isGoodSrcLoc )
+import SrcLoc          ( SrcLoc, isGoodSrcLoc )
 import TcType          ( Type, tcTyConAppTyCon, mkTyVarTy,
                          tcSplitDFunTy, tyVarsOfTypes,
                          matchTys, unifyTyListsX, allDistinctTyVars
@@ -315,15 +315,15 @@ True => overlap is permitted, but only if one template matches the other;
         not if they unify but neither is 
 
 \begin{code}
-extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [Message])
+extendInstEnv :: DynFlags -> InstEnv -> [DFunId] -> (InstEnv, [(SrcLoc,Message)])
   -- Similar, but all we have is the DFuns
 extendInstEnv dflags env dfun_ids = foldl (addToInstEnv dflags) (env, []) dfun_ids
 
 
 addToInstEnv :: DynFlags
-             -> (InstEnv, [Message])
+             -> (InstEnv, [(SrcLoc,Message)])
             -> DFunId
-            -> (InstEnv, [Message])    -- Resulting InstEnv and augmented error messages
+            -> (InstEnv, [(SrcLoc,Message)])   -- Resulting InstEnv and augmented error messages
 
 addToInstEnv dflags (inst_env, errs) dfun_id
        -- Check first that the new instance doesn't 
@@ -441,9 +441,11 @@ overlapErr dfun1 dfun2 = addInstErr (ptext SLIT("Overlapping instance declaratio
 fundepErr  dfun1 dfun2 = addInstErr (ptext SLIT("Functional dependencies conflict between instance declarations:")) 
                                    dfun1 dfun2
 
+addInstErr :: SDoc -> DFunId -> DFunId -> (SrcLoc, Message)
 addInstErr what dfun1 dfun2 
- = hang what 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2)
+ = (getSrcLoc dfun1, hang what 2 (ppr_dfun dfun1 $$ ppr_dfun dfun2))
   where
+   
     ppr_dfun dfun = pp_loc <> colon <+> pprClassPred clas tys
       where
        (_,_,clas,tys) = tcSplitDFunTy (idType dfun)