summaryrefslogtreecommitdiff
path: root/compiler/GHC/HsToCore/Docs.hs
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-03-27 17:22:28 -0400
committerRyan Scott <ryan.gl.scott@gmail.com>2020-04-07 19:43:20 -0400
commit04b6cf947ea065a210a216cc91f918cc1660d430 (patch)
tree60d3192ca3997385988bab216707193cb4c3c2da /compiler/GHC/HsToCore/Docs.hs
parent255418da5d264fb2758bc70925adb2094f34adc3 (diff)
downloadhaskell-wip/strict-NoExtCon.tar.gz
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.
Diffstat (limited to 'compiler/GHC/HsToCore/Docs.hs')
-rw-r--r--compiler/GHC/HsToCore/Docs.hs8
1 files changed, 2 insertions, 6 deletions
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 967e4c3185..48a8ef6f20 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -151,12 +151,6 @@ getInstLoc = \case
-- equation. This does not happen for data family instances, for some
-- reason.
{ tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = L l _ }}}) -> l
- ClsInstD _ (XClsInstDecl _) -> error "getInstLoc"
- DataFamInstD _ (DataFamInstDecl (HsIB _ (XFamEqn _))) -> error "getInstLoc"
- TyFamInstD _ (TyFamInstDecl (HsIB _ (XFamEqn _))) -> error "getInstLoc"
- XInstDecl _ -> error "getInstLoc"
- DataFamInstD _ (DataFamInstDecl (XHsImplicitBndrs _)) -> error "getInstLoc"
- TyFamInstD _ (TyFamInstDecl (XHsImplicitBndrs _)) -> error "getInstLoc"
-- | Get all subordinate declarations inside a declaration, and their docs.
-- A subordinate declaration is something like the associate type or data
@@ -292,9 +286,11 @@ ungroup group_ =
mkDecls (typesigs . hs_valds) (SigD noExtField) group_ ++
mkDecls (valbinds . hs_valds) (ValD noExtField) group_
where
+ typesigs :: HsValBinds GhcRn -> [LSig GhcRn]
typesigs (XValBindsLR (NValBinds _ sig)) = filter (isUserSig . unLoc) sig
typesigs ValBinds{} = error "expected XValBindsLR"
+ valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
valbinds (XValBindsLR (NValBinds binds _)) =
concatMap bagToList . snd . unzip $ binds
valbinds ValBinds{} = error "expected XValBindsLR"