Commit 2d8a15ee authored by simonpj's avatar simonpj
Browse files

[project @ 2003-10-21 12:48:57 by simonpj]

Wibble to reporting duplicate instance decls
parent f7865a6b
...@@ -62,7 +62,7 @@ import TcType ( Type, TcType, TcThetaType, TcTyVarSet, ...@@ -62,7 +62,7 @@ import TcType ( Type, TcType, TcThetaType, TcTyVarSet,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred, tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
isClassPred, isTyVarClassPred, isLinearPred, isClassPred, isTyVarClassPred, isLinearPred,
getClassPredTys, getClassPredTys_maybe, mkPredName, getClassPredTys, getClassPredTys_maybe, mkPredName,
isInheritablePred, isIPPred, isInheritablePred, isIPPred, matchTys,
tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy
) )
import HscTypes ( ExternalPackageState(..) ) import HscTypes ( ExternalPackageState(..) )
...@@ -77,11 +77,13 @@ import Subst ( substTy, substTyWith, substTheta, mkTyVarSubst ) ...@@ -77,11 +77,13 @@ import Subst ( substTy, substTyWith, substTheta, mkTyVarSubst )
import Literal ( inIntRange ) import Literal ( inIntRange )
import Var ( TyVar ) import Var ( TyVar )
import VarEnv ( TidyEnv, emptyTidyEnv, lookupSubstEnv, SubstResult(..) ) import VarEnv ( TidyEnv, emptyTidyEnv, lookupSubstEnv, SubstResult(..) )
import VarSet ( elemVarSet, emptyVarSet, unionVarSet ) import VarSet ( elemVarSet, emptyVarSet, unionVarSet, mkVarSet )
import TysWiredIn ( floatDataCon, doubleDataCon ) import TysWiredIn ( floatDataCon, doubleDataCon )
import PrelNames ( integerTyConName, fromIntegerName, fromRationalName, rationalTyConName ) import PrelNames ( integerTyConName, fromIntegerName, fromRationalName, rationalTyConName )
import BasicTypes( IPName(..), mapIPName, ipNameName ) import BasicTypes( IPName(..), mapIPName, ipNameName )
import UniqSupply( uniqsFromSupply ) import UniqSupply( uniqsFromSupply )
import CmdLineOpts( DynFlags )
import Maybes ( isJust )
import Outputable import Outputable
\end{code} \end{code}
...@@ -556,7 +558,7 @@ checkNewInst :: DynFlags -> (InstEnv, InstEnv) -> DFunId -> TcM () ...@@ -556,7 +558,7 @@ checkNewInst :: DynFlags -> (InstEnv, InstEnv) -> DFunId -> TcM ()
-- Check that the proposed new instance is OK -- Check that the proposed new instance is OK
checkNewInst dflags ies dfun checkNewInst dflags ies dfun
= do { -- Check functional dependencies = do { -- Check functional dependencies
case checkFunDeps (home_ie, pkg_ie) dfun of case checkFunDeps ies dfun of
Just dfuns -> funDepErr dfun dfuns Just dfuns -> funDepErr dfun dfuns
Nothing -> return () Nothing -> return ()
...@@ -564,9 +566,9 @@ checkNewInst dflags ies dfun ...@@ -564,9 +566,9 @@ checkNewInst dflags ies dfun
; mappM_ (dupInstErr dfun) dup_dfuns } ; mappM_ (dupInstErr dfun) dup_dfuns }
where where
(tvs, _, cls, tys) = tcSplitDFunTy (idType dfun) (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
(matches, _) = lookupInstEnv dflags ies clas tys (matches, _) = lookupInstEnv dflags ies cls tys
dup_dfuns = [dfun | (_, (_, dup_tys, dup_dfun)) <- matches, dup_dfuns = [dfun | (_, (_, dup_tys, dup_dfun)) <- matches,
isJust (matchTys tvs tys dup_tys)] isJust (matchTys (mkVarSet tvs) tys dup_tys)]
-- Find memebers of the match list which -- Find memebers of the match list which
-- dfun itself matches. If the match is 2-way, it's a duplicate -- dfun itself matches. If the match is 2-way, it's a duplicate
......
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