projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1996-07-25 20:43:49 by partain]
[ghc-hetmet.git]
/
ghc
/
compiler
/
typecheck
/
TcInstDcls.lhs
diff --git
a/ghc/compiler/typecheck/TcInstDcls.lhs
b/ghc/compiler/typecheck/TcInstDcls.lhs
index
e12fb7a
..
5194f9e
100644
(file)
--- a/
ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/
ghc/compiler/typecheck/TcInstDcls.lhs
@@
-61,7
+61,7
@@
import CmdLineOpts ( opt_GlasgowExts, opt_CompilingGhcInternals,
import Class ( GenClass, GenClassOp,
isCcallishClass, classBigSig,
classOps, classOpLocalType,
import Class ( GenClass, GenClassOp,
isCcallishClass, classBigSig,
classOps, classOpLocalType,
- classOpTagByString
+ classOpTagByString_maybe
)
import Id ( GenId, idType, isDefaultMethodId_maybe )
import ListSetOps ( minusList )
)
import Id ( GenId, idType, isDefaultMethodId_maybe )
import ListSetOps ( minusList )
@@
-80,7
+80,7
@@
import Type ( GenType(..), SYN_IE(ThetaType), mkTyVarTys,
splitSigmaTy, splitAppTy, isTyVarTy, matchTy, mkSigmaTy,
getTyCon_maybe, maybeBoxedPrimType, splitRhoTy, eqTy
)
splitSigmaTy, splitAppTy, isTyVarTy, matchTy, mkSigmaTy,
getTyCon_maybe, maybeBoxedPrimType, splitRhoTy, eqTy
)
-import TyVar ( GenTyVar, GenTyVarSet(..), mkTyVarSet, unionTyVarSets )
+import TyVar ( GenTyVar, SYN_IE(GenTyVarSet), mkTyVarSet, unionTyVarSets )
import TysWiredIn ( stringTy )
import Unique ( Unique )
import Util ( zipEqual, panic )
import TysWiredIn ( stringTy )
import Unique ( Unique )
import Util ( zipEqual, panic )
@@
-602,10
+602,13
@@
processInstBinds1 clas avail_insts method_ids mbind
-- Make a method id for the method
let
-- Make a method id for the method
let
- tag = classOpTagByString clas occ
- method_id = method_ids !! (tag-1)
- method_ty = tcIdType method_id
+ maybe_tag = classOpTagByString_maybe clas occ
+ (Just tag) = maybe_tag
+ method_id = method_ids !! (tag-1)
+ method_ty = tcIdType method_id
in
in
+ -- check that the method mentioned is actually in the class:
+ checkMaybeTc maybe_tag (instMethodNotInClassErr occ clas) `thenTc_`
tcInstTcType method_ty `thenNF_Tc` \ (method_tyvars, method_rho) ->
let
tcInstTcType method_ty `thenNF_Tc` \ (method_tyvars, method_rho) ->
let
@@
-921,6
+924,10
@@
omitDefaultMethodWarn clas_op clas_name inst_ty sty
ppr sty clas_op, ppStr "in instance",
ppPStr clas_name, pprParendGenType sty inst_ty]
ppr sty clas_op, ppStr "in instance",
ppPStr clas_name, pprParendGenType sty inst_ty]
+instMethodNotInClassErr occ clas sty
+ = ppHang (ppStr "Instance mentions a method not in the class")
+ 4 (ppBesides [ppStr "class `", ppr sty clas, ppStr "' method `",
+ ppPStr occ, ppStr "'"])
patMonoBindsCtxt pbind sty
= ppHang (ppStr "In a pattern binding:")
patMonoBindsCtxt pbind sty
= ppHang (ppStr "In a pattern binding:")