\section[TcBinds]{TcBinds}
\begin{code}
-module TcBinds ( tcBindsAndThen, tcTopBinds, tcHsBootSigs, tcMonoBinds, tcSpecSigs ) where
+module TcBinds ( tcBindsAndThen, tcTopBinds,
+ tcHsBootSigs, tcMonoBinds, tcSpecSigs,
+ badBootDeclErr ) where
#include "HsVersions.h"
import VarSet
import SrcLoc ( Located(..), unLoc, noLoc, getLoc )
import Bag
+import ErrUtils ( Message )
import Util ( isIn )
import BasicTypes ( TopLevelFlag(..), RecFlag(..), isNonRec, isRec,
isNotTopLevel, isAlwaysActive )
tcHsBootSigs :: [HsBindGroup Name] -> TcM [Id]
-- A hs-boot file has only one BindGroup, and it only has type
-- signatures in it. The renamer checked all this
-tcHsBootSigs [HsBindGroup _ sigs _]
- = mapM (addLocM tc_boot_sig) (filter isVanillaLSig sigs)
+tcHsBootSigs [HsBindGroup binds sigs _]
+ = do { checkTc (isEmptyLHsBinds binds) badBootDeclErr
+ ; mapM (addLocM tc_boot_sig) (filter isVanillaLSig sigs) }
where
tc_boot_sig (Sig (L _ name) ty)
= do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
; return (mkVanillaGlobal name sigma_ty vanillaIdInfo) }
-- Notice that we make GlobalIds, not LocalIds
+badBootDeclErr :: Message
+badBootDeclErr = ptext SLIT("Illegal declarations in an hs-boot file")
+
tcBindsAndThen
:: (HsBindGroup TcId -> thing -> thing) -- Combinator
-> [HsBindGroup Name]
#include "HsVersions.h"
import HsSyn
-import TcBinds ( tcSpecSigs )
+import TcBinds ( tcSpecSigs, badBootDeclErr )
import TcClassDcl ( tcMethodBind, mkMethodBind, badMethodErr,
tcClassDecl2, getGenericInstances )
import TcRnMonad
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"))
kcTyClDecl decl@(ClassDecl {tcdCtxt = ctxt, tcdSigs = sigs})
= kcTyClDeclBody decl $ \ tvs' ->
- do { ctxt' <- kcHsContext ctxt
+ do { is_boot <- tcIsHsBoot
+ ; checkTc (not is_boot) badBootClassDeclErr
+ ; ctxt' <- kcHsContext ctxt
; sigs' <- mappM (wrapLocM kc_sig) sigs
; return (decl {tcdTyVars = tvs', tcdCtxt = ctxt', tcdSigs = sigs'}) }
where
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
+
+badBootClassDeclErr = ptext SLIT("Illegal class declaration in hs-boot file")
\end{code}