X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Ftypecheck%2FTcInstDcls.lhs;h=5194f9ec7d54122ae55d65c2a4fc069e3f60f5a6;hb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;hp=e12fb7ae82a15177d27e86a82b09ce0302cc5a02;hpb=12899612693163154531da3285ec99c1c8ca2226;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index e12fb7a..5194f9e 100644
--- 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,
-			  classOpTagByString
+			  classOpTagByString_maybe
 			  )
 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
 			)
-import TyVar		( GenTyVar, GenTyVarSet(..), mkTyVarSet, unionTyVarSets )
+import TyVar		( GenTyVar, SYN_IE(GenTyVarSet), mkTyVarSet, unionTyVarSets )
 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
-	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
+    -- 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
@@ -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]
 
+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:")