Replace HsImplicitBndrs with HsOuterTyVarBndrs

This refactors the GHC AST to remove `HsImplicitBndrs` and replace it with
`HsOuterTyVarBndrs`, a type which records whether the outermost quantification
in a type is explicit (i.e., with an outermost, invisible `forall`) or
implicit. As a result of this refactoring, it is now evident in the AST where
the `forall`-or-nothing rule applies: it's all the places that use
`HsOuterTyVarBndrs`. See the revamped `Note [forall-or-nothing rule]` in
`GHC.Hs.Type` (previously in `GHC.Rename.HsType`).

Moreover, the places where `ScopedTypeVariables` brings lexically scoped type
variables into scope are a subset of the places that adhere to the
`forall`-or-nothing rule, so this also makes places that interact with
`ScopedTypeVariables` easier to find. See the revamped
`Note [Lexically scoped type variables]` in `GHC.Hs.Type` (previously in
`GHC.Tc.Gen.Sig`).

`HsOuterTyVarBndrs` are used in type signatures (see `HsOuterSigTyVarBndrs`)
and type family equations (see `HsOuterFamEqnTyVarBndrs`). The main difference
between the former and the latter is that the former cares about specificity
but the latter does not.

There are a number of knock-on consequences:

* There is now a dedicated `HsSigType` type, which is the combination of
  `HsOuterSigTyVarBndrs` and `HsType`. `LHsSigType` is now an alias for an
  `XRec` of `HsSigType`.
* Working out the details led us to a substantial refactoring of
  the handling of explicit (user-written) and implicit type-variable
  bindings in `GHC.Tc.Gen.HsType`.

  Instead of a confusing family of higher order functions, we now
  have a local data type, `SkolemInfo`, that controls how these
  binders are kind-checked.

  It remains very fiddly, not fully satisfying. But it's better
  than it was.

Fixes #16762. Bumps the Haddock submodule.

Co-authored-by: Simon Peyton Jones <simonpj@microsoft.com>
Co-authored-by: Richard Eisenberg <rae@richarde.dev>
Co-authored-by: Zubin Duggal <zubin@cmi.ac.in>

1 files changed, 37 insertions, 43 deletions

diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index c06373eb62..70bb33b7d0 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -512,27 +512,12 @@ This case in handled in the instance for HsPatSigType
 -}
 
 class HasLoc a where
-  -- ^ defined so that HsImplicitBndrs and HsWildCardBndrs can
-  -- know what their implicit bindings are scoping over
+  -- ^ conveniently calculate locations for things without locations attached
   loc :: a -> SrcSpan
 
-instance HasLoc thing => HasLoc (TScoped thing) where
-  loc (TS _ a) = loc a
-
 instance HasLoc thing => HasLoc (PScoped thing) where
   loc (PS _ _ _ a) = loc a
 
-instance HasLoc (LHsQTyVars GhcRn) where
-  loc (HsQTvs _ vs) = loc vs
-
-instance HasLoc thing => HasLoc (HsImplicitBndrs a thing) where
-  loc (HsIB _ a) = loc a
-  loc _ = noSrcSpan
-
-instance HasLoc thing => HasLoc (HsWildCardBndrs a thing) where
-  loc (HsWC _ a) = loc a
-  loc _ = noSrcSpan
-
 instance HasLoc (Located a) where
   loc (L l _) = l
 
@@ -541,9 +526,11 @@ instance HasLoc a => HasLoc [a] where
   loc xs = foldl1' combineSrcSpans $ map loc xs
 
 instance HasLoc a => HasLoc (FamEqn (GhcPass s) a) where
-  loc (FamEqn _ a Nothing b _ c) = foldl1' combineSrcSpans [loc a, loc b, loc c]
-  loc (FamEqn _ a (Just tvs) b _ c) = foldl1' combineSrcSpans
-                                              [loc a, loc tvs, loc b, loc c]
+  loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of
+    HsOuterImplicit{} ->
+      foldl1' combineSrcSpans [loc a, loc b, loc c]
+    HsOuterExplicit{hso_bndrs = tvs} ->
+      foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c]
 
 instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where
   loc (HsValArg tm) = loc tm
@@ -1477,9 +1464,9 @@ instance (ToHie rhs, HasLoc rhs)
 
 instance (ToHie rhs, HasLoc rhs)
     => ToHie (FamEqn GhcRn rhs) where
-  toHie fe@(FamEqn _ var tybndrs pats _ rhs) = concatM $
+  toHie fe@(FamEqn _ var outer_bndrs pats _ rhs) = concatM $
     [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var
-    , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs
+    , toHie $ TVS (ResolvedScopes []) scope outer_bndrs
     , toHie pats
     , toHie rhs
     ]
@@ -1517,7 +1504,7 @@ instance ToHie (Located (HsDerivingClause GhcRn)) where
 
 instance ToHie (Located (DerivClauseTys GhcRn)) where
   toHie (L span dct) = concatM $ makeNode dct span : case dct of
-      DctSingle _ ty -> [ toHie $ TS (ResolvedScopes[]) ty ]
+      DctSingle _ ty -> [ toHie $ TS (ResolvedScopes []) ty ]
       DctMulti _ tys -> [ toHie $ map (TS (ResolvedScopes [])) tys ]
 
 instance ToHie (Located (DerivStrategy GhcRn)) where
@@ -1525,7 +1512,7 @@ instance ToHie (Located (DerivStrategy GhcRn)) where
       StockStrategy -> []
       AnyclassStrategy -> []
       NewtypeStrategy -> []
-      ViaStrategy s -> [ toHie $ TS (ResolvedScopes []) s ]
+      ViaStrategy s -> [ toHie (TS (ResolvedScopes []) s) ]
 
 instance ToHie (Located OverlapMode) where
   toHie (L span _) = locOnly span
@@ -1535,11 +1522,15 @@ instance ToHie a => ToHie (HsScaled GhcRn a) where
 
 instance ToHie (Located (ConDecl GhcRn)) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
-      ConDeclGADT { con_names = names, con_qvars = exp_vars, con_g_ext = imp_vars
+      ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs
                   , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ } ->
         [ toHie $ map (C (Decl ConDec $ getRealSpan span)) names
-        , concatM $ [ bindingsOnly bindings
-                    , toHie $ tvScopes resScope NoScope exp_vars ]
+        , case outer_bndrs of
+            HsOuterImplicit{hso_ximplicit = imp_vars} ->
+              bindingsOnly $ map (C $ TyVarBind (mkScope outer_bndrs_loc) resScope)
+                             imp_vars
+            HsOuterExplicit{hso_bndrs = exp_bndrs} ->
+              toHie $ tvScopes resScope NoScope exp_bndrs
         , toHie ctx
         , toHie args
         , toHie typ
@@ -1552,7 +1543,6 @@ instance ToHie (Located (ConDecl GhcRn)) where
             RecConGADT x     -> mkLScope x
           tyScope = mkLScope typ
           resScope = ResolvedScopes [ctxScope, rhsScope]
-          bindings = map (C $ TyVarBind (mkScope (loc exp_vars)) resScope) imp_vars
       ConDeclH98 { con_name = name, con_ex_tvs = qvars
                  , con_mb_cxt = ctx, con_args = dets } ->
         [ toHie $ C (Decl ConDec $ getRealSpan span) name
@@ -1576,21 +1566,17 @@ instance ToHie (Located [Located (ConDeclField GhcRn)]) where
     , toHie decls
     ]
 
-instance ( HasLoc thing
-         , ToHie (TScoped thing)
-         ) => ToHie (TScoped (HsImplicitBndrs GhcRn thing)) where
-  toHie (TS sc (HsIB ibrn a)) = concatM $
-      [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) ibrn
+instance ToHie (TScoped (HsWildCardBndrs GhcRn (Located (HsSigType GhcRn)))) where
+  toHie (TS sc (HsWC names a)) = concatM $
+      [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names
       , toHie $ TS sc a
       ]
     where span = loc a
 
-instance ( HasLoc thing
-         , ToHie (TScoped thing)
-         ) => ToHie (TScoped (HsWildCardBndrs GhcRn thing)) where
+instance ToHie (TScoped (HsWildCardBndrs GhcRn (Located (HsType GhcRn)))) where
   toHie (TS sc (HsWC names a)) = concatM $
       [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names
-      , toHie $ TS sc a
+      , toHie a
       ]
     where span = loc a
 
@@ -1650,18 +1636,26 @@ instance HiePass p => ToHie (SigContext (Located (Sig (GhcPass p)))) where
           , toHie $ fmap (C Use) typ
           ]
 
-instance ToHie (Located (HsType GhcRn)) where
-  toHie x = toHie $ TS (ResolvedScopes []) x
+instance ToHie (TScoped (Located (HsSigType GhcRn))) where
+  toHie (TS tsc (L span t@HsSig{sig_bndrs=bndrs,sig_body=body})) = concatM $ makeNode t span :
+      [ toHie (TVS tsc (mkScope span) bndrs)
+      , toHie body
+      ]
+
+instance Data flag => ToHie (TVScoped (HsOuterTyVarBndrs flag GhcRn)) where
+  toHie (TVS tsc sc bndrs) = case bndrs of
+    HsOuterImplicit xs -> bindingsOnly $ map (C $ TyVarBind sc tsc) xs
+    HsOuterExplicit _ xs -> toHie $ tvScopes tsc sc xs
 
-instance ToHie (TScoped (Located (HsType GhcRn))) where
-  toHie (TS tsc (L span t)) = concatM $ makeNode t span : case t of
+instance ToHie (Located (HsType GhcRn)) where
+  toHie (L span t) = concatM $ makeNode t span : case t of
       HsForAllTy _ tele body ->
         let scope = mkScope $ getLoc body in
         [ case tele of
             HsForAllVis { hsf_vis_bndrs = bndrs } ->
-              toHie $ tvScopes tsc scope bndrs
+              toHie $ tvScopes (ResolvedScopes []) scope bndrs
             HsForAllInvis { hsf_invis_bndrs = bndrs } ->
-              toHie $ tvScopes tsc scope bndrs
+              toHie $ tvScopes (ResolvedScopes []) scope bndrs
         , toHie body
         ]
       HsQualTy _ ctx body ->
@@ -1677,7 +1671,7 @@ instance ToHie (TScoped (Located (HsType GhcRn))) where
         ]
       HsAppKindTy _ ty ki ->
         [ toHie ty
-        , toHie $ TS (ResolvedScopes []) ki
+        , toHie ki
         ]
       HsFunTy _ w a b ->
         [ toHie (arrowToHsType w)