diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 4190c9192bfbaab9c28c55e8169a58e61be25cc4..98f82054e2ce8413a1e818fa7ec934146cbf4ec0 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -1243,9 +1243,13 @@ warnDiscardedDoBindings rhs m_ty elt_ty
; when (warn_unused || warn_wrong) $
do { fam_inst_envs <- dsGetFamInstEnvs
; let norm_elt_ty = topNormaliseType fam_inst_envs elt_ty
-
- -- Warn about discarding non-() things in 'monadic' binding
- ; if warn_unused && not (isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty)
+ supressible_ty =
+ isUnitTy norm_elt_ty || isAnyTy norm_elt_ty || isZonkAnyTy norm_elt_ty
+ -- Warn about discarding things in 'monadic' binding,
+ -- however few types are excluded:
+ -- * Unit type `()`
+ -- * `ZonkAny` or `Any` type ` see Any8 of Note [Any types]
+ ; if warn_unused && not supressible_ty
then diagnosticDs (DsUnusedDoBind rhs elt_ty)
else