X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=3f45db3f20a8bfbbfac93e390199b4e063cdfdbc;hb=236d504fc85de0749e7ed33dc4c067488ae04e3f;hp=571cd7010430599119781e722344ef252dc1549e;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 571cd70..3f45db3 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -19,6 +19,7 @@ import Inst
 import InstEnv
 import FamInst
 import FamInstEnv
+import MkCore	( nO_METHOD_BINDING_ERROR_ID )
 import TcDeriv
 import TcEnv
 import RnSource ( addTcgDUs )
@@ -834,7 +835,7 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
     ----------------------
     tc_body :: Id -> Bool -> LHsBind Name -> TcM (TcId, LHsBind Id)
     tc_body sel_id generated_code rn_bind 
-      = add_meth_ctxt generated_code rn_bind $
+      = add_meth_ctxt sel_id generated_code rn_bind $
         do { (meth_id, local_meth_id) <- mkMethIds clas tyvars dfun_ev_vars 
                                                    inst_tys sel_id
            ; (meth_id1, spec_prags) <- tcPrags NonRecursive False True 
@@ -924,8 +925,8 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
 	-- For instance decls that come from standalone deriving clauses
 	-- we want to print out the full source code if there's an error
 	-- because otherwise the user won't see the code at all
-    add_meth_ctxt generated_code rn_bind thing 
-      | generated_code = addLandmarkErrCtxt (derivBindCtxt clas inst_tys rn_bind) thing
+    add_meth_ctxt sel_id generated_code rn_bind thing 
+      | generated_code = addLandmarkErrCtxt (derivBindCtxt sel_id clas inst_tys rn_bind) thing
       | otherwise      = thing
 
 
@@ -1026,11 +1027,15 @@ mkMethIds clas tyvars dfun_ev_vars inst_tys sel_id
 wrapId :: HsWrapper -> id -> HsExpr id
 wrapId wrapper id = mkHsWrap wrapper (HsVar id)
 
-derivBindCtxt :: Class -> [Type ] -> LHsBind Name -> SDoc
-derivBindCtxt clas tys bind
-   = vcat [ ptext (sLit "When typechecking a standalone-derived method for")
-	    <+> quotes (pprClassPred clas tys) <> colon
-	  , nest 2 $ pprSetDepth AllTheWay $ ppr bind ]
+derivBindCtxt :: Id -> Class -> [Type ] -> LHsBind Name -> SDoc
+derivBindCtxt sel_id clas tys _bind
+   = vcat [ ptext (sLit "When typechecking the code for ") <+> quotes (ppr sel_id)
+          , nest 2 (ptext (sLit "in a standalone derived instance for")
+	  	    <+> quotes (pprClassPred clas tys) <> colon)
+          , nest 2 $ ptext (sLit "To see the code I am typechecking, use -ddump-deriv") ]
+
+-- Too voluminous
+--	  , nest 2 $ pprSetDepth AllTheWay $ ppr bind ]
 
 warnMissingMethod :: Id -> TcM ()
 warnMissingMethod sel_id