Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
2d8a15ee
Commit
2d8a15ee
authored
Oct 21, 2003
by
simonpj
Browse files
[project @ 2003-10-21 12:48:57 by simonpj]
Wibble to reporting duplicate instance decls
parent
f7865a6b
Changes
1
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/typecheck/Inst.lhs
View file @
2d8a15ee
...
...
@@ -62,7 +62,7 @@ import TcType ( Type, TcType, TcThetaType, TcTyVarSet,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
isClassPred, isTyVarClassPred, isLinearPred,
getClassPredTys, getClassPredTys_maybe, mkPredName,
isInheritablePred, isIPPred,
isInheritablePred, isIPPred,
matchTys,
tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy
)
import HscTypes ( ExternalPackageState(..) )
...
...
@@ -77,11 +77,13 @@ import Subst ( substTy, substTyWith, substTheta, mkTyVarSubst )
import Literal ( inIntRange )
import Var ( TyVar )
import VarEnv ( TidyEnv, emptyTidyEnv, lookupSubstEnv, SubstResult(..) )
import VarSet ( elemVarSet, emptyVarSet, unionVarSet )
import VarSet ( elemVarSet, emptyVarSet, unionVarSet
, mkVarSet
)
import TysWiredIn ( floatDataCon, doubleDataCon )
import PrelNames ( integerTyConName, fromIntegerName, fromRationalName, rationalTyConName )
import BasicTypes( IPName(..), mapIPName, ipNameName )
import UniqSupply( uniqsFromSupply )
import CmdLineOpts( DynFlags )
import Maybes ( isJust )
import Outputable
\end{code}
...
...
@@ -556,7 +558,7 @@ checkNewInst :: DynFlags -> (InstEnv, InstEnv) -> DFunId -> TcM ()
-- Check that the proposed new instance is OK
checkNewInst dflags ies dfun
= do { -- Check functional dependencies
case checkFunDeps
(home_ie, pkg_ie)
dfun of
case checkFunDeps
ies
dfun of
Just dfuns -> funDepErr dfun dfuns
Nothing -> return ()
...
...
@@ -564,9 +566,9 @@ checkNewInst dflags ies dfun
; mappM_ (dupInstErr dfun) dup_dfuns }
where
(tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
(matches, _) = lookupInstEnv dflags ies cl
a
s tys
(matches, _) = lookupInstEnv dflags ies cls tys
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
-- dfun itself matches. If the match is 2-way, it's a duplicate
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment