summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename/Bind.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Rename/Bind.hs')
-rw-r--r--compiler/GHC/Rename/Bind.hs21
1 files changed, 16 insertions, 5 deletions
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 503e56bd57..73af997a2e 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -26,7 +26,10 @@ module GHC.Rename.Bind (
rnMethodBinds, renameSigs,
rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl,
makeMiniFixityEnv, MiniFixityEnv,
- HsSigCtxt(..)
+ HsSigCtxt(..),
+
+ -- Utility for hs-boot files
+ rejectBootDecls
) where
import GHC.Prelude
@@ -56,6 +59,7 @@ import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Name.Reader ( RdrName, rdrNameOcc )
+import GHC.Types.SourceFile
import GHC.Types.SrcLoc as SrcLoc
import GHC.Data.List.SetOps ( findDupsEq )
import GHC.Types.Basic ( RecFlag(..), TypeOrKind(..) )
@@ -199,10 +203,20 @@ rnTopBindsLHSBoot fix_env binds
= do { topBinds <- rnTopBindsLHS fix_env binds
; case topBinds of
ValBinds x mbinds sigs ->
- do { mapM_ bindInHsBootFileErr mbinds
+ do { rejectBootDecls HsBoot BootBindsPs (bagToList $ mbinds)
; pure (ValBinds x emptyBag sigs) }
_ -> pprPanic "rnTopBindsLHSBoot" (ppr topBinds) }
+rejectBootDecls :: HsBootOrSig
+ -> (NonEmpty (LocatedA decl) -> BadBootDecls)
+ -> [LocatedA decl]
+ -> TcM ()
+rejectBootDecls _ _ [] = return ()
+rejectBootDecls hsc_src what (decl@(L loc _) : decls)
+ = addErrAt (locA loc)
+ $ TcRnIllegalHsBootOrSigDecl hsc_src
+ (what $ decl :| decls)
+
rnTopBindsBoot :: NameSet -> HsValBindsLR GhcRn GhcPs
-> RnM (HsValBinds GhcRn, DefUses)
-- A hs-boot file has no bindings.
@@ -1384,9 +1398,6 @@ misplacedSigErr :: LSig GhcRn -> RnM ()
misplacedSigErr (L loc sig)
= addErrAt (locA loc) $ TcRnMisplacedSigDecl sig
-bindInHsBootFileErr :: LHsBindLR GhcRn GhcPs -> RnM ()
-bindInHsBootFileErr (L loc _) = addErrAt (locA loc) TcRnBindInBootFile
-
nonStdGuardErr :: (Outputable body,
Anno (Stmt GhcRn body) ~ SrcSpanAnnA)
=> [LStmtLR GhcRn GhcRn body] -> TcRnMessage