Use HsForAllTelescope to avoid inferred, visible foralls

Currently, `HsForAllTy` permits the combination of `ForallVis` and
`Inferred`, but you can't actually typecheck code that uses it
(e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a
new `HsForAllTelescope` data type that makes a type-level distinction
between visible and invisible `forall`s such that visible `forall`s
do not track `Specificity`. That part of the patch is actually quite
small; the rest is simply changing consumers of `HsType` to
accommodate this new type.

Fixes #18235. Bumps the `haddock` submodule.

2 files changed, 42 insertions, 20 deletions

diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index df6a0f47a8..3f3eb48b68 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -23,6 +23,7 @@ module GHC.Rename.HsType (
         checkPrecMatch, checkSectionPrec,
 
         -- Binding related stuff
+        bindHsForAllTelescope,
         bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
         rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars,
         FreeKiTyVars,
@@ -204,13 +205,11 @@ rnWcBody ctxt nwc_rdrs hs_ty
 
     rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
     -- A lot of faff just to allow the extra-constraints wildcard to appear
-    rn_ty env (HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs
-                          , hst_body = hs_body })
-      = bindLHsTyVarBndrs (rtke_ctxt env) WarnUnusedForalls
-                          Nothing tvs $ \ tvs' ->
+    rn_ty env (HsForAllTy { hst_tele = tele, hst_body = hs_body })
+      = bindHsForAllTelescope (rtke_ctxt env) tele $ \ tele' ->
         do { (hs_body', fvs) <- rn_lty env hs_body
-           ; return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField
-                                , hst_bndrs = tvs', hst_body = hs_body' }
+           ; return (HsForAllTy { hst_xforall = noExtField
+                                , hst_tele = tele', hst_body = hs_body' }
                     , fvs) }
 
     rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt
@@ -429,9 +428,10 @@ check_inferred_vars ctxt (Just msg) ty =
   where
     forallty_bndrs :: LHsType GhcPs -> [HsTyVarBndr Specificity GhcPs]
     forallty_bndrs (L _ ty) = case ty of
-      HsParTy _ ty'                  -> forallty_bndrs ty'
-      HsForAllTy { hst_bndrs = tvs } -> map unLoc tvs
-      _                              -> []
+      HsParTy _ ty' -> forallty_bndrs ty'
+      HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = tvs }}
+                    -> map unLoc tvs
+      _             -> []
 
 {- ******************************************************
 *                                                       *
@@ -559,14 +559,12 @@ rnLHsTyKi env (L loc ty)
 
 rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
 
-rnHsTyKi env ty@(HsForAllTy { hst_fvf = fvf, hst_bndrs = tyvars
-                            , hst_body = tau })
+rnHsTyKi env ty@(HsForAllTy { hst_tele = tele, hst_body = tau })
   = do { checkPolyKinds env ty
-       ; bindLHsTyVarBndrs (rtke_ctxt env) WarnUnusedForalls
-                           Nothing tyvars $ \ tyvars' ->
+       ; bindHsForAllTelescope (rtke_ctxt env) tele $ \ tele' ->
     do { (tau',  fvs) <- rnLHsTyKi env tau
-       ; return ( HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField
-                             , hst_bndrs = tyvars' , hst_body =  tau' }
+       ; return ( HsForAllTy { hst_xforall = noExtField
+                             , hst_tele = tele' , hst_body =  tau' }
                 , fvs) } }
 
 rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })
@@ -1051,6 +1049,19 @@ an LHsQTyVars can be semantically significant. As a result, we suppress
 -Wunused-foralls warnings in exactly one place: in bindHsQTyVars.
 -}
 
+bindHsForAllTelescope :: HsDocContext
+                      -> HsForAllTelescope GhcPs
+                      -> (HsForAllTelescope GhcRn -> RnM (a, FreeVars))
+                      -> RnM (a, FreeVars)
+bindHsForAllTelescope doc tele thing_inside =
+  case tele of
+    HsForAllVis { hsf_vis_bndrs = bndrs } ->
+      bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs $ \bndrs' ->
+        thing_inside $ mkHsForAllVisTele bndrs'
+    HsForAllInvis { hsf_invis_bndrs = bndrs } ->
+      bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs $ \bndrs' ->
+        thing_inside $ mkHsForAllInvisTele bndrs'
+
 -- | Should GHC warn if a quantified type variable goes unused? Usually, the
 -- answer is \"yes\", but in the particular case of binding 'LHsQTyVars', we
 -- avoid emitting warnings.
@@ -1820,8 +1831,8 @@ extract_lty (L _ ty) acc
       HsStarTy _ _                -> acc
       HsKindSig _ ty ki           -> extract_lty ty $
                                      extract_lty ki acc
-      HsForAllTy { hst_bndrs = tvs, hst_body = ty }
-                                  -> extract_hs_tv_bndrs tvs acc $
+      HsForAllTy { hst_tele = tele, hst_body = ty }
+                                  -> extract_hs_for_all_telescope tele acc $
                                      extract_lty ty []
       HsQualTy { hst_ctxt = ctxt, hst_body = ty }
                                   -> extract_lctxt ctxt $
@@ -1830,6 +1841,17 @@ extract_lty (L _ ty) acc
       -- We deal with these separately in rnLHsTypeWithWildCards
       HsWildCardTy {}             -> acc
 
+extract_hs_for_all_telescope :: HsForAllTelescope GhcPs
+                             -> FreeKiTyVars -- Accumulator
+                             -> FreeKiTyVars -- Free in body
+                             -> FreeKiTyVars
+extract_hs_for_all_telescope tele acc_vars body_fvs =
+  case tele of
+    HsForAllVis { hsf_vis_bndrs = bndrs } ->
+      extract_hs_tv_bndrs bndrs acc_vars body_fvs
+    HsForAllInvis { hsf_invis_bndrs = bndrs } ->
+      extract_hs_tv_bndrs bndrs acc_vars body_fvs
+
 extractHsTvBndrs :: [LHsTyVarBndr flag GhcPs]
                  -> FreeKiTyVars       -- Free in body
                  -> FreeKiTyVars       -- Free in result
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 533a794807..e610a60ff3 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -2182,13 +2182,13 @@ rnConDecl (XConDecl (ConDeclGADTPrefixPs { con_gp_names = names, con_gp_ty = ty
          -- Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)
          -- in GHC.Hs.Type.
        ; case res_ty of
-           L l (HsForAllTy { hst_fvf = fvf })
-             |  ForallVis <- fvf
+           L l (HsForAllTy { hst_tele = tele })
+             |  HsForAllVis{} <- tele
              -> setSrcSpan l $ addErr $ withHsDocContext ctxt $ vcat
                 [ text "Illegal visible, dependent quantification" <+>
                   text "in the type of a term"
                 , text "(GHC does not yet support this)" ]
-             |  ForallInvis <- fvf
+             |  HsForAllInvis{} <- tele
              -> nested_foralls_contexts_err l ctxt
            L l (HsQualTy {})
              -> nested_foralls_contexts_err l ctxt