[project @ 2005-05-03 13:41:01 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcBinds.lhs

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 021655b..6243fc6 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -4,7 +4,9 @@
 \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"
 
@@ -52,6 +54,7 @@ import NameSet
 import VarSet
 import SrcLoc          ( Located(..), unLoc, noLoc, getLoc )
 import Bag
+import ErrUtils                ( Message )
 import Util            ( isIn )
 import BasicTypes      ( TopLevelFlag(..), RecFlag(..), isNonRec, isRec, 
                          isNotTopLevel, isAlwaysActive )
@@ -110,14 +113,18 @@ tcTopBinds binds
 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]