import VarSet
import VarEnv
import Maybes ( MaybeErr(..), returnMaB, failMaB, thenMaB, maybeToBool )
-import Name ( getSrcLoc )
+import Name ( getSrcLoc, nameModule )
+import SrcLoc ( SrcLoc, isGoodSrcLoc )
import TcType ( Type, tcTyConAppTyCon, mkTyVarTy,
tcSplitDFunTy, tyVarsOfTypes,
matchTys, unifyTyListsX, allDistinctTyVars
import TyCon ( TyCon )
import Outputable
import UniqFM ( UniqFM, lookupWithDefaultUFM, addToUFM, emptyUFM, eltsUFM )
-import Id ( idType )
+import Id ( idType, idName )
import ErrUtils ( Message )
import CmdLineOpts
+import Util ( notNull )
\end{code}
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
-- conflict with another. See notes below about fundeps.
- | not (null bad_fundeps)
+ | notNull bad_fundeps
= (inst_env, fundep_err : errs) -- Bad fundeps; report the first only
| otherwise
badFunDeps cls_inst_env clas ins_tv_set ins_tys
= [ dfun_id | fd <- fds,
(tvs, tys, dfun_id) <- cls_inst_env,
- not (null (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys))
+ notNull (checkClsFD (tvs `unionVarSet` ins_tv_set) fd clas_tvs tys ins_tys)
]
where
(clas_tvs, fds) = classTvsFds clas
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 = ppr (getSrcLoc dfun) <> colon <+> pprClassPred clas tys
- where
- (_,_,clas,tys) = tcSplitDFunTy (idType dfun)
+
+ ppr_dfun dfun = pp_loc <> colon <+> pprClassPred clas tys
+ where
+ (_,_,clas,tys) = tcSplitDFunTy (idType dfun)
+ loc = getSrcLoc dfun
+ mod = nameModule (idName dfun)
+
+ -- Worth trying to print a good location... imported dfuns
+ -- don't have a useful SrcLoc but we can say which module they come from
+ pp_loc | isGoodSrcLoc loc = ppr loc
+ | otherwise = ptext SLIT("In module") <+> ppr mod
\end{code}