Make NoExtCon fields strictwip/strict-NoExtCon

This changes every unused TTG extension constructor to be strict in
its field so that the pattern-match coverage checker is smart enough
any such constructors are unreachable in pattern matches. This lets
us remove nearly every use of `noExtCon` in the GHC API. The only
ones we cannot remove are ones underneath uses of `ghcPass`, but that
is only because GHC 8.8's and 8.10's coverage checkers weren't smart
enough to perform this kind of reasoning. GHC HEAD's coverage
checker, on the other hand, _is_ smart enough, so we guard these uses
of `noExtCon` with CPP for now.

Bumps the `haddock` submodule.

Fixes #17992.

1 files changed, 3 insertions, 43 deletions

diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index a2e67f1170..b72336b4fc 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -1,6 +1,7 @@
 {-
 Main functions for .hie file generation
 -}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -441,8 +442,6 @@ instance ProtectSig GhcTc where
 instance ProtectSig GhcRn where
   protectSig sc (HsWC a (HsIB b sig)) =
     HsWC a (HsIB b (SH sc sig))
-  protectSig _ (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
-  protectSig _ (XHsWildCardBndrs nec) = noExtCon nec
 
 class HasLoc a where
   -- ^ defined so that HsImplicitBndrs and HsWildCardBndrs can
@@ -457,7 +456,6 @@ instance HasLoc thing => HasLoc (PScoped thing) where
 
 instance HasLoc (LHsQTyVars GhcRn) where
   loc (HsQTvs _ vs) = loc vs
-  loc _ = noSrcSpan
 
 instance HasLoc thing => HasLoc (HsImplicitBndrs a thing) where
   loc (HsIB _ a) = loc a
@@ -488,7 +486,6 @@ instance HasLoc (HsDataDefn GhcRn) where
   loc def@(HsDataDefn{}) = loc $ dd_cons def
     -- Only used for data family instances, so we only need rhs
     -- Most probably the rest will be unhelpful anyway
-  loc _ = noSrcSpan
 
 {- Note [Real DataCon Name]
 The typechecker substitutes the conLikeWrapId for the name, but we don't want
@@ -753,7 +750,6 @@ instance ( a ~ GhcPass p
           in toHie $ patScopes Nothing rhsScope NoScope pats
       , toHie grhss
       ]
-    XMatch nec -> noExtCon nec
 
 instance ( ToHie (Context (Located (IdP a)))
          ) => ToHie (HsMatchContext a) where
@@ -842,7 +838,6 @@ instance ( a ~ GhcPass p
         ]
       CoPat _ _ _ _ ->
         []
-      XPat nec -> noExtCon nec
     where
       contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args
       contextify (InfixCon a b) = InfixCon a' b'
@@ -1039,7 +1034,6 @@ instance ( a ~ GhcPass p
       [ toHie expr
       ]
     Missing _ -> []
-    XTupArg nec -> noExtCon nec
 
 instance ( a ~ GhcPass p
          , ToHie (PScoped (LPat a))
@@ -1081,7 +1075,6 @@ instance ( a ~ GhcPass p
       RecStmt {recS_stmts = stmts} ->
         [ toHie $ map (RS $ combineScopes scope (mkScope span)) stmts
         ]
-      XStmtLR nec -> noExtCon nec
 
 instance ( ToHie (LHsExpr a)
          , ToHie (PScoped (LPat a))
@@ -1145,7 +1138,6 @@ instance ToHie (RFContext (LFieldOcc GhcRn)) where
     FieldOcc name _ ->
       [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name)
       ]
-    XFieldOcc nec -> noExtCon nec
 
 instance ToHie (RFContext (LFieldOcc GhcTc)) where
   toHie (RFC c rhs (L nspan f)) = concatM $ case f of
@@ -1153,7 +1145,6 @@ instance ToHie (RFContext (LFieldOcc GhcTc)) where
       let var' = setVarName var (removeDefSrcSpan $ varName var)
       in [ toHie $ C (RecField c rhs) (L nspan var')
          ]
-    XFieldOcc nec -> noExtCon nec
 
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
   toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
@@ -1162,7 +1153,6 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
       ]
     Ambiguous _name _ ->
       [ ]
-    XAmbiguousFieldOcc nec -> noExtCon nec
 
 instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
   toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
@@ -1174,7 +1164,6 @@ instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
       let var' = setVarName var (removeDefSrcSpan $ varName var)
       in [ toHie $ C (RecField c rhs) (L nspan var')
          ]
-    XAmbiguousFieldOcc nec -> noExtCon nec
 
 instance ( a ~ GhcPass p
          , ToHie (PScoped (LPat a))
@@ -1193,7 +1182,6 @@ instance ( a ~ GhcPass p
     [ toHie $ listScopes NoScope stmts
     , toHie $ PS Nothing sc NoScope pat
     ]
-  toHie (RS _ (XApplicativeArg nec)) = noExtCon nec
 
 instance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where
   toHie (PrefixCon args) = toHie args
@@ -1271,7 +1259,6 @@ instance ToHie (TyClGroup GhcRn) where
     , toHie roles
     , toHie instances
     ]
-  toHie (XTyClGroup nec) = noExtCon nec
 
 instance ToHie (LTyClDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
@@ -1317,7 +1304,6 @@ instance ToHie (LTyClDecl GhcRn) where
           context_scope = mkLScope context
           rhs_scope = foldl1' combineScopes $ map mkScope
             [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps]
-      XTyClDecl nec -> noExtCon nec
 
 instance ToHie (LFamilyDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
@@ -1332,7 +1318,6 @@ instance ToHie (LFamilyDecl GhcRn) where
           rhsSpan = sigSpan `combineScopes` injSpan
           sigSpan = mkScope $ getLoc sig
           injSpan = maybe NoScope (mkScope . getLoc) inj
-      XFamilyDecl nec -> noExtCon nec
 
 instance ToHie (FamilyInfo GhcRn) where
   toHie (ClosedTypeFamily (Just eqns)) = concatM $
@@ -1353,7 +1338,6 @@ instance ToHie (RScoped (LFamilyResultSig GhcRn)) where
       TyVarSig _ bndr ->
         [ toHie $ TVS (ResolvedScopes [sc]) NoScope bndr
         ]
-      XFamilyResultSig nec -> noExtCon nec
 
 instance ToHie (Located (FunDep (Located Name))) where
   toHie (L span fd@(lhs, rhs)) = concatM $
@@ -1377,7 +1361,6 @@ instance (ToHie rhs, HasLoc rhs)
     where scope = combineScopes patsScope rhsScope
           patsScope = mkScope (loc pats)
           rhsScope = mkScope (loc rhs)
-  toHie (XFamEqn nec) = noExtCon nec
 
 instance ToHie (LInjectivityAnn GhcRn) where
   toHie (L span ann) = concatM $ makeNode ann span : case ann of
@@ -1393,7 +1376,6 @@ instance ToHie (HsDataDefn GhcRn) where
     , toHie cons
     , toHie derivs
     ]
-  toHie (XHsDataDefn nec) = noExtCon nec
 
 instance ToHie (HsDeriving GhcRn) where
   toHie (L span clauses) = concatM
@@ -1408,7 +1390,6 @@ instance ToHie (LHsDerivingClause GhcRn) where
         , pure $ locOnly ispan
         , toHie $ map (TS (ResolvedScopes [])) tys
         ]
-      XHsDerivingClause nec -> noExtCon nec
 
 instance ToHie (Located (DerivStrategy GhcRn)) where
   toHie (L span strat) = concatM $ makeNode strat span : case strat of
@@ -1446,7 +1427,6 @@ instance ToHie (LConDecl GhcRn) where
           rhsScope = combineScopes ctxScope argsScope
           ctxScope = maybe NoScope mkLScope ctx
           argsScope = condecl_scope dets
-      XConDecl nec -> noExtCon nec
     where condecl_scope args = case args of
             PrefixCon xs -> foldr combineScopes NoScope $ map mkLScope xs
             InfixCon a b -> combineScopes (mkLScope a) (mkLScope b)
@@ -1466,7 +1446,6 @@ instance ( HasLoc thing
       , toHie $ TS sc a
       ]
     where span = loc a
-  toHie (TS _ (XHsImplicitBndrs nec)) = noExtCon nec
 
 instance ( HasLoc thing
          , ToHie (TScoped thing)
@@ -1476,7 +1455,6 @@ instance ( HasLoc thing
       , toHie $ TS sc a
       ]
     where span = loc a
-  toHie (TS _ (XHsWildCardBndrs nec)) = noExtCon nec
 
 instance ToHie (LStandaloneKindSig GhcRn) where
   toHie (L sp sig) = concatM [makeNode sig sp, toHie sig]
@@ -1487,7 +1465,6 @@ instance ToHie (StandaloneKindSig GhcRn) where
       [ toHie $ C TyDecl name
       , toHie $ TS (ResolvedScopes []) typ
       ]
-    XStandaloneKindSig nec -> noExtCon nec
 
 instance ToHie (SigContext (LSig GhcRn)) where
   toHie (SC (SI styp msp) (L sp sig)) = concatM $ makeNode sig sp : case sig of
@@ -1531,7 +1508,6 @@ instance ToHie (SigContext (LSig GhcRn)) where
         , toHie $ map (C Use) names
         , toHie $ fmap (C Use) typ
         ]
-      XSig nec -> noExtCon nec
 
 instance ToHie (LHsType GhcRn) where
   toHie x = toHie $ TS (ResolvedScopes []) x
@@ -1623,7 +1599,6 @@ instance ToHie (TVScoped (LHsTyVarBndr GhcRn)) where
         [ toHie $ C (TyVarBind sc tsc) var
         , toHie kind
         ]
-      XTyVarBndr nec -> noExtCon nec
 
 instance ToHie (TScoped (LHsQTyVars GhcRn)) where
   toHie (TS sc (HsQTvs implicits vars)) = concatM $
@@ -1633,7 +1608,6 @@ instance ToHie (TScoped (LHsQTyVars GhcRn)) where
     where
       varLoc = loc vars
       bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits
-  toHie (TS _ (XLHsQTyVars nec)) = noExtCon nec
 
 instance ToHie (LHsContext GhcRn) where
   toHie (L span tys) = concatM $
@@ -1647,7 +1621,6 @@ instance ToHie (LConDeclField GhcRn) where
         [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields
         , toHie typ
         ]
-      XConDeclField nec -> noExtCon nec
 
 instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where
   toHie (From expr) = toHie expr
@@ -1670,7 +1643,6 @@ instance ToHie (LSpliceDecl GhcRn) where
       SpliceDecl _ splice _ ->
         [ toHie splice
         ]
-      XSpliceDecl nec -> noExtCon nec
 
 instance ToHie (HsBracket a) where
   toHie _ = pure []
@@ -1717,8 +1689,10 @@ instance ( a ~ GhcPass p
       HsSpliced _ _ _ ->
         []
       XSplice x -> case ghcPass @p of
+#if __GLASGOW_HASKELL__ < 811
                      GhcPs -> noExtCon x
                      GhcRn -> noExtCon x
+#endif
                      GhcTc -> case x of
                                 HsSplicedT _ -> []
 
@@ -1728,7 +1702,6 @@ instance ToHie (LRoleAnnotDecl GhcRn) where
         [ toHie $ C Use var
         , concatMapM (pure . locOnly . getLoc) roles
         ]
-      XRoleAnnotDecl nec -> noExtCon nec
 
 instance ToHie (LInstDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
@@ -1741,7 +1714,6 @@ instance ToHie (LInstDecl GhcRn) where
       TyFamInstD _ d ->
         [ toHie $ L span d
         ]
-      XInstDecl nec -> noExtCon nec
 
 instance ToHie (LClsInstDecl GhcRn) where
   toHie (L span decl) = concatM
@@ -1775,21 +1747,18 @@ instance ToHie (LDerivDecl GhcRn) where
         , toHie strat
         , toHie overlap
         ]
-      XDerivDecl nec -> noExtCon nec
 
 instance ToHie (LFixitySig GhcRn) where
   toHie (L span sig) = concatM $ makeNode sig span : case sig of
       FixitySig _ vars _ ->
         [ toHie $ map (C Use) vars
         ]
-      XFixitySig nec -> noExtCon nec
 
 instance ToHie (LDefaultDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
       DefaultDecl _ typs ->
         [ toHie typs
         ]
-      XDefaultDecl nec -> noExtCon nec
 
 instance ToHie (LForeignDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
@@ -1803,7 +1772,6 @@ instance ToHie (LForeignDecl GhcRn) where
         , toHie $ TS (ResolvedScopes []) sig
         , toHie fe
         ]
-      XForeignDecl nec -> noExtCon nec
 
 instance ToHie ForeignImport where
   toHie (CImport (L a _) (L b _) _ _ (L c _)) = pure $ concat $
@@ -1823,14 +1791,12 @@ instance ToHie (LWarnDecls GhcRn) where
       Warnings _ _ warnings ->
         [ toHie warnings
         ]
-      XWarnDecls nec -> noExtCon nec
 
 instance ToHie (LWarnDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
       Warning _ vars _ ->
         [ toHie $ map (C Use) vars
         ]
-      XWarnDecl nec  -> noExtCon nec
 
 instance ToHie (LAnnDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
@@ -1838,7 +1804,6 @@ instance ToHie (LAnnDecl GhcRn) where
         [ toHie prov
         , toHie expr
         ]
-      XAnnDecl nec -> noExtCon nec
 
 instance ToHie (Context (Located a)) => ToHie (AnnProvenance a) where
   toHie (ValueAnnProvenance a) = toHie $ C Use a
@@ -1850,10 +1815,8 @@ instance ToHie (LRuleDecls GhcRn) where
       HsRules _ _ rules ->
         [ toHie rules
         ]
-      XRuleDecls nec -> noExtCon nec
 
 instance ToHie (LRuleDecl GhcRn) where
-  toHie (L _ (XRuleDecl nec)) = noExtCon nec
   toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM
         [ makeNode r span
         , pure $ locOnly $ getLoc rname
@@ -1876,7 +1839,6 @@ instance ToHie (RScoped (LRuleBndr GhcRn)) where
         [ toHie $ C (ValBind RegularBind sc Nothing) var
         , toHie $ TS (ResolvedScopes [sc]) typ
         ]
-      XRuleBndr nec -> noExtCon nec
 
 instance ToHie (LImportDecl GhcRn) where
   toHie (L span decl) = concatM $ makeNode decl span : case decl of
@@ -1885,7 +1847,6 @@ instance ToHie (LImportDecl GhcRn) where
         , toHie $ fmap (IEC ImportAs) as
         , maybe (pure []) goIE hidden
         ]
-      XImportDecl nec -> noExtCon nec
     where
       goIE (hiding, (L sp liens)) = concatM $
         [ pure $ locOnly sp
@@ -1916,7 +1877,6 @@ instance ToHie (IEContext (LIE GhcRn)) where
       IEGroup _ _ _ -> []
       IEDoc _ _ -> []
       IEDocNamed _ _ -> []
-      XIE nec -> noExtCon nec
 
 instance ToHie (IEContext (LIEWrappedName Name)) where
   toHie (IEC c (L span iewn)) = concatM $ makeNode iewn span : case iewn of