X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcInstDcls.lhs;fp=ghc%2Fcompiler%2Ftypecheck%2FTcInstDcls.lhs;h=dcf8986795f46c1c1c11c95615dbc3b294055e38;hb=0600a65decbd51ded35b950073caafa645405de0;hp=6fdc327be604081be7b164261f03bae470840722;hpb=407228a08653fe2324762be0db3b34ba77b51c0d;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index 6fdc327..dcf8986 100644
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -9,7 +9,7 @@ module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
 #include "HsVersions.h"
 
 import HsSyn
-import TcBinds		( tcSpecSigs )
+import TcBinds		( tcSpecSigs, badBootDeclErr )
 import TcClassDcl	( tcMethodBind, mkMethodBind, badMethodErr, 
 			  tcClassDecl2, getGenericInstances )
 import TcRnMonad       
@@ -208,6 +208,11 @@ tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags))
     let dfun  = mkDictFunId dfun_name tyvars theta clas inst_tys
 	ispec = mkLocalInstance dfun overlap_flag
     in
+
+    tcIsHsBoot						`thenM` \ is_boot ->
+    checkTc (not is_boot || (isEmptyLHsBinds binds && null uprags))
+	    badBootDeclErr				`thenM_`
+
     returnM (Just (InstInfo { iSpec = ispec, iBinds = VanillaInst binds uprags }))
   where
     msg  = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))