Reject top-level banged bindings

Bizarrely, we were not rejecting
  !x = e

Fix:

* In the test in DsBinds.dsTopLHsBinds, use isBangedHsBind, not
  isBangedPatBind.  (Indeed the latter dies altogther.)

* Implement isBangedHsBind in HsUtils;
  be sure to handle AbsBinds

All this was shown up by Trac #13594

2 files changed, 11 insertions, 11 deletions

diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index edf2e1b349..5caf1a0f6c 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -29,7 +29,7 @@ module HsPat (
         mkPrefixConPat, mkCharLitPat, mkNilPat,
 
         looksLazyPatBind,
-        isBangedLPat, isBangedPatBind,
+        isBangedLPat,
         hsPatNeedsParens,
         isIrrefutableHsPat,
 
@@ -558,10 +558,6 @@ patterns are treated specially, of course.
 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 -}
 
-isBangedPatBind :: HsBind p -> Bool
-isBangedPatBind (PatBind {pat_lhs = pat}) = isBangedLPat pat
-isBangedPatBind _ = False
-
 isBangedLPat :: LPat p -> Bool
 isBangedLPat (L _ (ParPat p))   = isBangedLPat p
 isBangedLPat (L _ (BangPat {})) = True
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 5be757fb72..f409c2a7d2 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -72,7 +72,7 @@ module HsUtils(
   noRebindableInfo,
 
   -- Collecting binders
-  isUnliftedHsBind, isBangedBind,
+  isUnliftedHsBind, isBangedHsBind,
 
   collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
   collectHsIdBinders,
@@ -844,14 +844,18 @@ isUnliftedHsBind bind
   where
     is_unlifted_id id = isUnliftedType (idType id)
 
--- | Is a binding a strict variable bind (e.g. @!x = ...@)?
-isBangedBind :: HsBind GhcTc -> Bool
-isBangedBind b | isBangedPatBind b = True
-isBangedBind (FunBind {fun_matches = matches})
+-- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?
+isBangedHsBind :: HsBind GhcTc -> Bool
+isBangedHsBind (AbsBinds { abs_binds = binds })
+  = anyBag (isBangedHsBind . unLoc) binds
+isBangedHsBind (FunBind {fun_matches = matches})
   | [L _ match] <- unLoc $ mg_alts matches
   , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
   = True
-isBangedBind _ = False
+isBangedHsBind (PatBind {pat_lhs = pat})
+  = isBangedLPat pat
+isBangedHsBind _
+  = False
 
 collectLocalBinders :: HsLocalBindsLR idL idR -> [IdP idL]
 collectLocalBinders (HsValBinds binds) = collectHsIdBinders binds