summaryrefslogtreecommitdiff
path: root/compiler/GHC/Rename
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/Rename
parent255418da5d264fb2758bc70925adb2094f34adc3 (diff)
downloadhaskell-04b6cf947ea065a210a216cc91f918cc1660d430.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/Rename')
-rw-r--r--compiler/GHC/Rename/Bind.hs17
-rw-r--r--compiler/GHC/Rename/Expr.hs29
-rw-r--r--compiler/GHC/Rename/Fixity.hs1
-rw-r--r--compiler/GHC/Rename/HsType.hs12
-rw-r--r--compiler/GHC/Rename/Module.hs41
-rw-r--r--compiler/GHC/Rename/Names.hs8
-rw-r--r--compiler/GHC/Rename/Pat.hs2
-rw-r--r--compiler/GHC/Rename/Splice.hs9
8 files changed, 2 insertions, 117 deletions
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index f1e10fc323..b8dbfd1e1c 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -219,19 +219,15 @@ rnLocalBindsAndThen (HsIPBinds x binds) thing_inside = do
(thing, fvs_thing) <- thing_inside (HsIPBinds x binds') fv_binds
return (thing, fvs_thing `plusFV` fv_binds)
-rnLocalBindsAndThen (XHsLocalBindsLR nec) _ = noExtCon nec
-
rnIPBinds :: HsIPBinds GhcPs -> RnM (HsIPBinds GhcRn, FreeVars)
rnIPBinds (IPBinds _ ip_binds ) = do
(ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
return (IPBinds noExtField ip_binds', plusFVs fvs_s)
-rnIPBinds (XHsIPBinds nec) = noExtCon nec
rnIPBind :: IPBind GhcPs -> RnM (IPBind GhcRn, FreeVars)
rnIPBind (IPBind _ ~(Left n) expr) = do
(expr',fvExpr) <- rnLExpr expr
return (IPBind noExtField (Left n) expr', fvExpr)
-rnIPBind (XIPBind nec) = noExtCon nec
{-
************************************************************************
@@ -630,10 +626,10 @@ makeMiniFixityEnv :: [LFixitySig GhcPs] -> RnM MiniFixityEnv
makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls
where
+ add_one_sig :: MiniFixityEnv -> LFixitySig GhcPs -> RnM MiniFixityEnv
add_one_sig env (L loc (FixitySig _ names fixity)) =
foldlM add_one env [ (loc,name_loc,name,fixity)
| L name_loc name <- names ]
- add_one_sig _ (L _ (XFixitySig nec)) = noExtCon nec
add_one env (loc, name_loc, name,fixity) = do
{ -- this fixity decl is a duplicate iff
@@ -744,8 +740,6 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
= hang (text "Illegal pattern synonym declaration")
2 (text "Use -XPatternSynonyms to enable this extension")
-rnPatSynBind _ (XPatSynBind nec) = noExtCon nec
-
{-
Note [Renaming pattern synonym variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1047,8 +1041,6 @@ renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty)
text "A COMPLETE pragma must mention at least one data constructor" $$
text "or pattern synonym defined in the same module."
-renameSig _ (XSig nec) = noExtCon nec
-
{-
Note [Orphan COMPLETE pragmas]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1115,8 +1107,6 @@ okHsSig ctxt (L _ sig)
(CompleteMatchSig {}, TopSigCtxt {} ) -> True
(CompleteMatchSig {}, _) -> False
- (XSig nec, _) -> noExtCon nec
-
-------------------
findDupSigs :: [LSig GhcPs] -> [NonEmpty (Located RdrName, Sig GhcPs)]
-- Check for duplicates on RdrName version,
@@ -1171,7 +1161,6 @@ rnMatchGroup ctxt rnBody (MG { mg_alts = L _ ms, mg_origin = origin })
; when (null ms && not empty_case_ok) (addErr (emptyCaseErr ctxt))
; (new_ms, ms_fvs) <- mapFvRn (rnMatch ctxt rnBody) ms
; return (mkMatchGroup origin new_ms, ms_fvs) }
-rnMatchGroup _ _ (XMatchGroup nec) = noExtCon nec
rnMatch :: Outputable (body GhcPs) => HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
@@ -1193,7 +1182,6 @@ rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss })
_ -> ctxt
; return (Match { m_ext = noExtField, m_ctxt = mf', m_pats = pats'
, m_grhss = grhss'}, grhss_fvs ) }}
-rnMatch' _ _ (XMatch nec) = noExtCon nec
emptyCaseErr :: HsMatchContext GhcRn -> SDoc
emptyCaseErr ctxt = hang (text "Empty list of alternatives in" <+> pp_ctxt)
@@ -1220,7 +1208,6 @@ rnGRHSs ctxt rnBody (GRHSs _ grhss (L l binds))
= rnLocalBindsAndThen binds $ \ binds' _ -> do
(grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss
return (GRHSs noExtField grhss' (L l binds'), fvGRHSs)
-rnGRHSs _ _ (XGRHSs nec) = noExtCon nec
rnGRHS :: HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
@@ -1248,7 +1235,6 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs)
is_standard_guard [] = True
is_standard_guard [L _ (BodyStmt {})] = True
is_standard_guard _ = False
-rnGRHS' _ _ (XGRHS nec) = noExtCon nec
{-
*********************************************************
@@ -1272,7 +1258,6 @@ rnSrcFixityDecl sig_ctxt = rn_decl
rn_decl (FixitySig _ fnames fixity)
= do names <- concatMapM lookup_one fnames
return (FixitySig noExtField names fixity)
- rn_decl (XFixitySig nec) = noExtCon nec
lookup_one :: Located RdrName -> RnM [Located Name]
lookup_one (L name_loc rdr_name)
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index d091dc66fa..20163e9d65 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -241,7 +241,6 @@ rnExpr (HsPragE x prag expr)
rn_prag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann
rn_prag (HsPragCore x1 src lbl) = HsPragCore x1 src lbl
rn_prag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo
- rn_prag (XHsPragE x) = noExtCon x
rnExpr (HsLam x matches)
= do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches
@@ -289,7 +288,6 @@ rnExpr (ExplicitTuple x tup_args boxity)
; return (L l (Present x e'), fvs) }
rnTupArg (L l (Missing _)) = return (L l (Missing noExtField)
, emptyFVs)
- rnTupArg (L _ (XTupArg nec)) = noExtCon nec
rnExpr (ExplicitSum x alt arity expr)
= do { (expr', fvs) <- rnLExpr expr
@@ -441,7 +439,6 @@ rnCmdTop = wrapLocFstM rnCmdTop'
; return (HsCmdTop (cmd_names `zip` cmd_names') cmd',
fvCmd `plusFV` cmd_fvs) }
- rnCmdTop' (XCmdTop nec) = noExtCon nec
rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd = wrapLocFstM rnCmd
@@ -514,8 +511,6 @@ rnCmd (HsCmdDo x (L l stmts))
rnStmts ArrowExpr rnLCmd stmts (\ _ -> return ((), emptyFVs))
; return ( HsCmdDo x (L l stmts'), fvs ) }
-rnCmd (XCmd nec) = noExtCon nec
-
---------------------------------------------------
type CmdNeeds = FreeVars -- Only inhabitants are
-- appAName, choiceAName, loopAName
@@ -545,8 +540,6 @@ methodNamesCmd (HsCmdLam _ match) = methodNamesMatch match
methodNamesCmd (HsCmdCase _ _ matches)
= methodNamesMatch matches `addOneFV` choiceAName
-methodNamesCmd (XCmd nec) = noExtCon nec
-
--methodNamesCmd _ = emptyFVs
-- Other forms can't occur in commands, but it's not convenient
-- to error here so we just do what's convenient.
@@ -558,20 +551,16 @@ methodNamesMatch (MG { mg_alts = L _ ms })
= plusFVs (map do_one ms)
where
do_one (L _ (Match { m_grhss = grhss })) = methodNamesGRHSs grhss
- do_one (L _ (XMatch nec)) = noExtCon nec
-methodNamesMatch (XMatchGroup nec) = noExtCon nec
-------------------------------------------------
-- gaw 2004
methodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs (GRHSs _ grhss _) = plusFVs (map methodNamesGRHS grhss)
-methodNamesGRHSs (XGRHSs nec) = noExtCon nec
-------------------------------------------------
methodNamesGRHS :: Located (GRHS GhcRn (LHsCmd GhcRn)) -> CmdNeeds
methodNamesGRHS (L _ (GRHS _ _ rhs)) = methodNamesLCmd rhs
-methodNamesGRHS (L _ (XGRHS nec)) = noExtCon nec
---------------------------------------------------
methodNamesStmts :: [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars
@@ -593,7 +582,6 @@ methodNamesStmt (TransStmt {}) = emptyFVs
methodNamesStmt ApplicativeStmt{} = emptyFVs
-- ParStmt and TransStmt can't occur in commands, but it's not
-- convenient to error here so we just do what's convenient
-methodNamesStmt (XStmtLR nec) = noExtCon nec
{-
************************************************************************
@@ -923,9 +911,6 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for
rnStmt _ _ (L _ ApplicativeStmt{}) _ =
panic "rnStmt: ApplicativeStmt"
-rnStmt _ _ (L _ (XStmtLR nec)) _ =
- noExtCon nec
-
rnParallelStmts :: forall thing. HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
@@ -955,7 +940,6 @@ rnParallelStmts ctxt return_op segs thing_inside
; let seg' = ParStmtBlock x stmts' used_bndrs return_op
; return ((seg':segs', thing), fvs) }
- rn_segs _ _ (XParStmtBlock nec:_) = noExtCon nec
cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
dupErr vs = addErr (text "Duplicate binding in parallel list comprehension for:"
@@ -1124,10 +1108,6 @@ rn_rec_stmt_lhs _ stmt@(L _ (ApplicativeStmt {})) -- Shouldn't appear yet
rn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))))
= panic "rn_rec_stmt LetStmt EmptyLocalBinds"
-rn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR nec))))
- = noExtCon nec
-rn_rec_stmt_lhs _ (L _ (XStmtLR nec))
- = noExtCon nec
rn_rec_stmts_lhs :: Outputable body => MiniFixityEnv
-> [LStmt GhcPs body]
@@ -1195,18 +1175,12 @@ rn_rec_stmt _ _ stmt@(L _ (ParStmt {}), _) -- Syntactically illegal in mdo
rn_rec_stmt _ _ stmt@(L _ (TransStmt {}), _) -- Syntactically illegal in mdo
= pprPanic "rn_rec_stmt: TransStmt" (ppr stmt)
-rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR nec))), _)
- = noExtCon nec
-
rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))), _)
= panic "rn_rec_stmt: LetStmt EmptyLocalBinds"
rn_rec_stmt _ _ stmt@(L _ (ApplicativeStmt {}), _)
= pprPanic "rn_rec_stmt: ApplicativeStmt" (ppr stmt)
-rn_rec_stmt _ _ (L _ (XStmtLR nec), _)
- = noExtCon nec
-
rn_rec_stmts :: Outputable (body GhcPs) =>
(Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
@@ -1854,7 +1828,6 @@ isStrictPattern lpat =
NPlusKPat{} -> True
SplicePat{} -> True
CoPat{} -> panic "isStrictPattern: CoPat"
- XPat nec -> noExtCon nec
{-
Note [ApplicativeDo and refutable patterns]
@@ -2065,7 +2038,6 @@ pprStmtCat (LetStmt {}) = text "let"
pprStmtCat (RecStmt {}) = text "rec"
pprStmtCat (ParStmt {}) = text "parallel"
pprStmtCat (ApplicativeStmt {}) = panic "pprStmtCat: ApplicativeStmt"
-pprStmtCat (XStmtLR nec) = noExtCon nec
------------
emptyInvalid :: Validity -- Payload is the empty document
@@ -2131,7 +2103,6 @@ okCompStmt dflags _ stmt
RecStmt {} -> emptyInvalid
LastStmt {} -> emptyInvalid -- Should not happen (dealt with by checkLastStmt)
ApplicativeStmt {} -> emptyInvalid
- XStmtLR nec -> noExtCon nec
---------
checkTupleSection :: [LHsTupArg GhcPs] -> RnM ()
diff --git a/compiler/GHC/Rename/Fixity.hs b/compiler/GHC/Rename/Fixity.hs
index 9400c0582f..b86be35160 100644
--- a/compiler/GHC/Rename/Fixity.hs
+++ b/compiler/GHC/Rename/Fixity.hs
@@ -216,4 +216,3 @@ lookupFieldFixityRn (Ambiguous _ lrdr) = get_ambiguous_fixity (unLoc lrdr)
format_ambig (elt, fix) = hang (ppr fix)
2 (pprNameProvenance elt)
-lookupFieldFixityRn (XAmbiguousFieldOcc nec) = noExtCon nec
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index f269653c62..9def0b83e3 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -137,10 +137,6 @@ rn_hs_sig_wc_type scoping ctxt
, hsib_body = hs_ty' }
; (res, fvs2) <- thing_inside sig_ty'
; return (res, fvs1 `plusFV` fvs2) } }
-rn_hs_sig_wc_type _ _ (HsWC _ (XHsImplicitBndrs nec)) _
- = noExtCon nec
-rn_hs_sig_wc_type _ _ (XHsWildCardBndrs nec) _
- = noExtCon nec
rnHsWcType :: HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType ctxt (HsWC { hswc_body = hs_ty })
@@ -149,7 +145,6 @@ rnHsWcType ctxt (HsWC { hswc_body = hs_ty })
; (wcs, hs_ty', fvs) <- rnWcBody ctxt nwc_rdrs hs_ty
; let sig_ty' = HsWC { hswc_ext = wcs, hswc_body = hs_ty' }
; return (sig_ty', fvs) }
-rnHsWcType _ (XHsWildCardBndrs nec) = noExtCon nec
rnWcBody :: HsDocContext -> [Located RdrName] -> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
@@ -311,7 +306,6 @@ rnHsSigType ctx level (HsIB { hsib_body = hs_ty })
; return ( HsIB { hsib_ext = vars
, hsib_body = body' }
, fvs ) } }
-rnHsSigType _ _ (XHsImplicitBndrs nec) = noExtCon nec
rnImplicitBndrs :: Bool -- True <=> bring into scope any free type variables
-- E.g. f :: forall a. a->b
@@ -986,8 +980,6 @@ bindLHsTyVarBndr doc mb_assoc (L loc (KindedTyVar x lrdr@(L lv _) kind))
$ thing_inside (L loc (KindedTyVar x (L lv tv_nm) kind'))
; return (b, fvs1 `plusFV` fvs2) }
-bindLHsTyVarBndr _ _ (L _ (XTyVarBndr nec)) _ = noExtCon nec
-
newTyVarNameRn :: Maybe a -> Located RdrName -> RnM Name
newTyVarNameRn mb_assoc (L loc rdr)
= do { rdr_env <- getLocalRdrEnv
@@ -1035,8 +1027,6 @@ rnField fl_env env (L l (ConDeclField _ names ty haddock_doc))
where
lbl = occNameFS $ rdrNameOcc rdr
fl = expectJust "rnField" $ lookupFsEnv fl_env lbl
- lookupField (XFieldOcc nec) = noExtCon nec
-rnField _ _ (L _ (XConDeclField nec)) = noExtCon nec
{-
************************************************************************
@@ -1278,7 +1268,6 @@ checkPrecMatch op (MG { mg_alts = (L _ ms) })
-- but the second eqn has no args (an error, but not discovered
-- until the type checker). So we don't want to crash on the
-- second eqn.
-checkPrecMatch _ (XMatchGroup nec) = noExtCon nec
checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
@@ -1659,7 +1648,6 @@ extractRdrKindSigVars (L _ resultSig)
extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVarsNoDups
extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig })
= maybe [] extractHsTyRdrTyVars ksig
-extractDataDefnKindVars (XHsDataDefn nec) = noExtCon nec
extract_lctxt :: LHsContext GhcPs
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 89bc307809..dd14b33275 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -234,7 +234,6 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
traceRn "finish Dus" (ppr src_dus ) ;
return (final_tcg_env, rn_group)
}}}}
-rnSrcDecls (XHsGroup nec) = noExtCon nec
addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
-- This function could be defined lower down in the module hierarchy,
@@ -302,7 +301,6 @@ rnSrcWarnDecls bndr_set decls'
= do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
rdr_names
; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }
- rn_deprec (XWarnDecl nec) = noExtCon nec
what = text "deprecation"
@@ -338,7 +336,6 @@ rnAnnDecl ann@(HsAnnotation _ s provenance expr)
rnLExpr expr
; return (HsAnnotation noExtField s provenance' expr',
provenance_fvs `plusFV` expr_fvs) }
-rnAnnDecl (XAnnDecl nec) = noExtCon nec
rnAnnProvenance :: AnnProvenance RdrName
-> RnM (AnnProvenance Name, FreeVars)
@@ -360,7 +357,6 @@ rnDefaultDecl (DefaultDecl _ tys)
; return (DefaultDecl noExtField tys', fvs) }
where
doc_str = DefaultDeclCtx
-rnDefaultDecl (XDefaultDecl nec) = noExtCon nec
{-
*********************************************************
@@ -395,8 +391,6 @@ rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })
-- we add it to the free-variable list. It might, for example,
-- be imported from another module
-rnHsForeignDecl (XForeignDecl nec) = noExtCon nec
-
-- | For Windows DLLs we need to know what packages imported symbols are from
-- to generate correct calls. Imported symbols are tagged with the current
-- package, so if they get inlined across a package boundary we'll still
@@ -442,8 +436,6 @@ rnSrcInstDecl (ClsInstD { cid_inst = cid })
; traceRn "rnSrcIstDecl end }" empty
; return (ClsInstD { cid_d_ext = noExtField, cid_inst = cid' }, fvs) }
-rnSrcInstDecl (XInstDecl nec) = noExtCon nec
-
-- | Warn about non-canonical typeclass instance declarations
--
-- A "non-canonical" instance definition can occur for instances of a
@@ -667,7 +659,6 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
-- the instance context after renaming. This is a bit
-- strange, but should not matter (and it would be more work
-- to remove the context).
-rnClsInstDecl (XClsInstDecl nec) = noExtCon nec
rnFamInstEqn :: HsDocContext
-> AssocTyFamInfo
@@ -756,8 +747,6 @@ rnFamInstEqn doc atfi rhs_kvars
, feqn_fixity = fixity
, feqn_rhs = payload' } },
all_fvs) }
-rnFamInstEqn _ _ _ (HsIB _ (XFamEqn nec)) _ = noExtCon nec
-rnFamInstEqn _ _ _ (XHsImplicitBndrs nec) _ = noExtCon nec
rnTyFamInstDecl :: AssocTyFamInfo
-> TyFamInstDecl GhcPs
@@ -805,8 +794,6 @@ rnTyFamInstEqn atfi ctf_info
withHsDocContext (TyFamilyCtx fam_rdr_name) $
wrongTyFamName fam_name tycon'
; pure (eqn', fvs) }
-rnTyFamInstEqn _ _ (HsIB _ (XFamEqn nec)) = noExtCon nec
-rnTyFamInstEqn _ _ (XHsImplicitBndrs nec) = noExtCon nec
rnTyFamDefltDecl :: Name
-> TyFamDefltDecl GhcPs
@@ -823,10 +810,6 @@ rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = eqn@(HsIB { hsib_body =
; (eqn', fvs) <-
rnFamInstEqn (TyDataCtx tycon) atfi rhs_kvs eqn rnDataDefn
; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) }
-rnDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn nec)))
- = noExtCon nec
-rnDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs nec))
- = noExtCon nec
-- Renaming of the associated types in instances.
@@ -980,7 +963,6 @@ rnSrcDerivDecl (DerivDecl _ ty mds overlap)
; return (DerivDecl noExtField ty' mds' overlap, fvs) }
where
loc = getLoc $ hsib_body $ hswc_body ty
-rnSrcDerivDecl (XDerivDecl nec) = noExtCon nec
standaloneDerivErr :: SDoc
standaloneDerivErr
@@ -1002,7 +984,6 @@ rnHsRuleDecls (HsRules { rds_src = src
; return (HsRules { rds_ext = noExtField
, rds_src = src
, rds_rules = rn_rules }, fvs) }
-rnHsRuleDecls (XRuleDecls nec) = noExtCon nec
rnHsRuleDecl :: RuleDecl GhcPs -> RnM (RuleDecl GhcRn, FreeVars)
rnHsRuleDecl (HsRule { rd_name = rule_name
@@ -1029,11 +1010,10 @@ rnHsRuleDecl (HsRule { rd_name = rule_name
, rd_lhs = lhs'
, rd_rhs = rhs' }, fv_lhs' `plusFV` fv_rhs') } }
where
+ get_var :: RuleBndr GhcPs -> Located RdrName
get_var (RuleBndrSig _ v _) = v
get_var (RuleBndr _ v) = v
- get_var (XRuleBndr nec) = noExtCon nec
in_rule = text "in the rule" <+> pprFullRuleName rule_name
-rnHsRuleDecl (XRuleDecl nec) = noExtCon nec
bindRuleTmVars :: HsDocContext -> Maybe ty_bndrs
-> [LRuleBndr GhcPs] -> [Name]
@@ -1397,7 +1377,6 @@ rnStandaloneKindSignature tc_names (StandaloneKindSig _ v ki)
standaloneKiSigErr =
hang (text "Illegal standalone kind signature")
2 (text "Did you mean to enable StandaloneKindSignatures?")
-rnStandaloneKindSignature _ (XStandaloneKindSig nec) = noExtCon nec
depAnalTyClDecls :: GlobalRdrEnv
-> KindSig_FV_Env
@@ -1466,7 +1445,6 @@ rnRoleAnnots tc_names role_annots
(text "role annotation")
tycon
; return $ RoleAnnotDecl noExtField tycon' roles }
- rn_role_annot1 (XRoleAnnotDecl nec) = noExtCon nec
dupRoleAnnotErr :: NonEmpty (LRoleAnnotDecl GhcPs) -> RnM ()
dupRoleAnnotErr list
@@ -1590,7 +1568,6 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,
, tcdRhs = rhs', tcdSExt = fvs }, fvs) } }
-- "data", "newtype" declarations
-rnTyClDecl (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec
rnTyClDecl (DataDecl
{ tcdLName = tycon, tcdTyVars = tyvars,
tcdFixity = fixity,
@@ -1677,8 +1654,6 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
where
cls_doc = ClassDeclCtx lcls
-rnTyClDecl (XTyClDecl nec) = noExtCon nec
-
-- Does the data type declaration include a CUSK?
data_decl_has_cusk :: LHsQTyVars pass -> NewOrData -> Bool -> Maybe (LHsKind pass') -> RnM Bool
data_decl_has_cusk tyvars new_or_data no_rhs_kvs kind_sig = do
@@ -1761,7 +1736,6 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
multipleDerivClausesErr
; (ds', fvs) <- mapFvRn (rnLHsDerivingClause doc) ds
; return (L loc ds', fvs) }
-rnDataDefn _ (XHsDataDefn nec) = noExtCon nec
warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
-> SrcSpan
@@ -1800,8 +1774,6 @@ rnLHsDerivingClause doc
, deriv_clause_strategy = dcs'
, deriv_clause_tys = L loc' dct' })
, fvs ) }
-rnLHsDerivingClause _ (L _ (XHsDerivingClause nec))
- = noExtCon nec
rnLDerivStrategy :: forall a.
HsDocContext
@@ -1912,7 +1884,6 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
= return (ClosedTypeFamily Nothing, emptyFVs)
rn_info _ OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
rn_info _ DataFamily = return (DataFamily, emptyFVs)
-rnFamDecl _ (XFamilyDecl nec) = noExtCon nec
rnFamResultSig :: HsDocContext
-> FamilyResultSig GhcPs
@@ -1944,7 +1915,6 @@ rnFamResultSig doc (TyVarSig _ tvbndr)
-- scoping checks that are irrelevant here
tvbndr $ \ tvbndr' ->
return (TyVarSig noExtField tvbndr', unitFV (hsLTyVarName tvbndr')) }
-rnFamResultSig _ (XFamilyResultSig nec) = noExtCon nec
-- Note [Renaming injectivity annotation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2154,8 +2124,6 @@ rnConDecl decl@(ConDeclGADT { con_names = names
, con_doc = mb_doc' },
all_fvs) } }
-rnConDecl (XConDecl nec) = noExtCon nec
-
rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs)
-> RnM (Maybe (LHsContext GhcRn), FreeVars)
@@ -2348,9 +2316,6 @@ add gp@(HsGroup {hs_ruleds = ts}) l (RuleD _ d) ds
= addl (gp { hs_ruleds = L l d : ts }) ds
add gp l (DocD _ d) ds
= addl (gp { hs_docs = (L l d) : (hs_docs gp) }) ds
-add (HsGroup {}) _ (SpliceD _ (XSpliceDecl nec)) _ = noExtCon nec
-add (HsGroup {}) _ (XHsDecl nec) _ = noExtCon nec
-add (XHsGroup nec) _ _ _ = noExtCon nec
add_tycld :: LTyClDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
@@ -2363,7 +2328,6 @@ add_tycld d [] = [TyClGroup { group_ext = noExtField
]
add_tycld d (ds@(TyClGroup { group_tyclds = tyclds }):dss)
= ds { group_tyclds = d : tyclds } : dss
-add_tycld _ (XTyClGroup nec: _) = noExtCon nec
add_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
@@ -2376,7 +2340,6 @@ add_instd d [] = [TyClGroup { group_ext = noExtField
]
add_instd d (ds@(TyClGroup { group_instds = instds }):dss)
= ds { group_instds = d : instds } : dss
-add_instd _ (XTyClGroup nec: _) = noExtCon nec
add_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
@@ -2389,7 +2352,6 @@ add_role_annot d [] = [TyClGroup { group_ext = noExtField
]
add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest)
= tycls { group_roles = d : roles } : rest
-add_role_annot _ (XTyClGroup nec: _) = noExtCon nec
add_kisig :: LStandaloneKindSig (GhcPass p)
-> [TyClGroup (GhcPass p)] -> [TyClGroup (GhcPass p)]
@@ -2402,7 +2364,6 @@ add_kisig d [] = [TyClGroup { group_ext = noExtField
]
add_kisig d (tycls@(TyClGroup { group_kisigs = kisigs }) : rest)
= tycls { group_kisigs = d : kisigs } : rest
-add_kisig _ (XTyClGroup nec : _) = noExtCon nec
add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a
add_bind b (ValBinds x bs sigs) = ValBinds x (bs `snocBag` b) sigs
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 5a5c7f1950..bf2f15829e 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -388,7 +388,6 @@ rnImportDecl this_mod
, ideclHiding = new_imp_details })
return (new_imp_decl, gbl_env, imports, mi_hpc iface)
-rnImportDecl _ (L _ (XImportDecl nec)) = noExtCon nec
-- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'.
@@ -765,7 +764,6 @@ getLocalNonValBinders fixity_env
= expectJust "getLocalNonValBinders/find_con_decl_fld" $
find (\ fl -> flLabel fl == lbl) flds
where lbl = occNameFS (rdrNameOcc rdr)
- find_con_decl_fld (L _ (XFieldOcc nec)) = noExtCon nec
new_assoc :: Bool -> LInstDecl GhcPs
-> RnM ([AvailInfo], [(Name, [FieldLabel])])
@@ -801,8 +799,6 @@ getLocalNonValBinders fixity_env
(avails, fldss)
<- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
pure (avails, concat fldss)
- new_assoc _ (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec
- new_assoc _ (L _ (XInstDecl nec)) = noExtCon nec
new_di :: Bool -> Maybe Name -> DataFamInstDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
@@ -816,16 +812,13 @@ getLocalNonValBinders fixity_env
-- main_name is not bound here!
fld_env = mk_fld_env (feqn_rhs ti_decl) sub_names flds'
; return (avail, fld_env) }
- new_di _ _ (DataFamInstDecl (XHsImplicitBndrs nec)) = noExtCon nec
new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl GhcPs
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d
-getLocalNonValBinders _ (XHsGroup nec) = noExtCon nec
newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
-newRecordSelector _ _ (L _ (XFieldOcc nec)) = noExtCon nec
newRecordSelector overload_ok (dc:_) (L loc (FieldOcc _ (L _ fld)))
= do { selName <- newTopSrcBinder $ L loc $ field
; return $ qualFieldLbl { flSelector = selName } }
@@ -1438,7 +1431,6 @@ findImportUsage imports used_gres
-- If you use 'signum' from Num, then the user may well have
-- imported Num(signum). We don't want to complain that
-- Num is not itself mentioned. Hence the two cases in add_unused_with.
- unused_decl (L _ (XImportDecl nec)) = noExtCon nec
{- Note [The ImportMap]
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index c8a2cbb023..166d46a05f 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -638,8 +638,6 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
sel (L ll lbl)))
, hsRecFieldArg = arg'
, hsRecPun = pun })) }
- rn_fld _ _ (L _ (HsRecField (L _ (XFieldOcc _)) _ _))
- = panic "rnHsRecFields"
rn_dotdot :: Maybe (Located Int) -- See Note [DotDot fields] in GHC.Hs.Pat
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 5c7d287a38..560b908bbc 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -182,8 +182,6 @@ rn_bracket _ (DecBrG {}) = panic "rn_bracket: unexpected DecBrG"
rn_bracket _ (TExpBr x e) = do { (e', fvs) <- rnLExpr e
; return (TExpBr x e', fvs) }
-rn_bracket _ (XBracket nec) = noExtCon nec
-
quotationCtxtDoc :: HsBracket GhcPs -> SDoc
quotationCtxtDoc br_body
= hang (text "In the Template Haskell quotation")
@@ -300,7 +298,6 @@ checkTopSpliceAllowed splice = do
spliceExtension (HsTypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell)
spliceExtension (HsUntypedSplice {}) = ("Top-level splices", LangExt.TemplateHaskell)
spliceExtension s@(HsSpliced {}) = pprPanic "spliceExtension" (ppr s)
- spliceExtension (XSplice nec) = noExtCon nec
------------------
@@ -322,7 +319,6 @@ runRnSplice flavour run_meta ppr_res splice
HsQuasiQuote _ _ q qs str -> mkQuasiQuoteExpr flavour q qs str
HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice)
HsSpliced {} -> pprPanic "runRnSplice" (ppr splice)
- XSplice nec -> noExtCon nec
-- Typecheck the expression
; meta_exp_ty <- tcMetaTy meta_ty_name
@@ -369,8 +365,6 @@ makePending _ splice@(HsTypedSplice {})
= pprPanic "makePending" (ppr splice)
makePending _ splice@(HsSpliced {})
= pprPanic "makePending" (ppr splice)
-makePending _ (XSplice nec)
- = noExtCon nec
------------------
mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
@@ -420,7 +414,6 @@ rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
, unitFV quoter') }
rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
-rnSplice (XSplice nec) = noExtCon nec
---------------------
rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
@@ -653,7 +646,6 @@ rnSpliceDecl (SpliceDecl _ (L loc splice) flg)
, SpliceDecl noExtField (L loc rn_splice) flg)
run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
-rnSpliceDecl (XSpliceDecl nec) = noExtCon nec
rnTopSpliceDecls :: HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
-- Declaration splice at the very top level of the module
@@ -731,7 +723,6 @@ spliceCtxt splice
HsTypedSplice {} -> text "typed splice:"
HsQuasiQuote {} -> text "quasi-quotation:"
HsSpliced {} -> text "spliced expression:"
- XSplice nec -> noExtCon nec
-- | The splice data to be logged
data SpliceInfo
View Lorry Controller Status