summaryrefslogtreecommitdiff
path: root/compiler/rename
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2019-03-19 17:47:55 -0400
committerBen Gamari <ben@well-typed.com>2019-07-09 11:52:45 -0400
commit6a03d77b9a9915e4b37fe1ea6688c135e7b00654 (patch)
tree4154abaa768adbfadc4eb17db620c3ed08b82c5f /compiler/rename
parent5af815f2e43e9f1b5ca9ec0803f9fccabb49e2fe (diff)
downloadhaskell-6a03d77b9a9915e4b37fe1ea6688c135e7b00654.tar.gz
Use an empty data type in TTG extension constructors (#15247)
To avoid having to `panic` any time a TTG extension constructor is consumed, this MR introduces an uninhabited 'NoExtCon' type and uses that in every extension constructor's type family instance where it is appropriate. This also introduces a 'noExtCon' function which eliminates a 'NoExtCon', much like 'Data.Void.absurd' eliminates a 'Void'. I also renamed the existing `NoExt` type to `NoExtField` to better distinguish it from `NoExtCon`. Unsurprisingly, there is a lot of code churn resulting from this. Bumps the Haddock submodule. Fixes #15247.
Diffstat (limited to 'compiler/rename')
-rw-r--r--compiler/rename/RnBinds.hs68
-rw-r--r--compiler/rename/RnEnv.hs4
-rw-r--r--compiler/rename/RnExpr.hs124
-rw-r--r--compiler/rename/RnFixity.hs2
-rw-r--r--compiler/rename/RnNames.hs50
-rw-r--r--compiler/rename/RnPat.hs14
-rw-r--r--compiler/rename/RnSource.hs130
-rw-r--r--compiler/rename/RnSplice.hs51
-rw-r--r--compiler/rename/RnTypes.hs86
9 files changed, 265 insertions, 264 deletions
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 22f2cf3e9f..db21552221 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -215,19 +215,19 @@ 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 _) _ = panic "rnLocalBindsAndThen"
+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 noExt ip_binds', plusFVs fvs_s)
-rnIPBinds (XHsIPBinds _) = panic "rnIPBinds"
+ 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 noExt (Left n) expr', fvExpr)
-rnIPBind (XIPBind _) = panic "rnIPBind"
+ return (IPBind noExtField (Left n) expr', fvExpr)
+rnIPBind (XIPBind nec) = noExtCon nec
{-
************************************************************************
@@ -422,19 +422,19 @@ rnBindLHS name_maker _ bind@(PatBind { pat_lhs = pat })
rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name })
= do { name <- applyNameMaker name_maker rdr_name
; return (bind { fun_id = name
- , fun_ext = noExt }) }
+ , fun_ext = noExtField }) }
rnBindLHS name_maker _ (PatSynBind x psb@PSB{ psb_id = rdrname })
| isTopRecNameMaker name_maker
= do { addLocM checkConName rdrname
; name <- lookupLocatedTopBndrRn rdrname -- Should be in scope already
- ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) }
+ ; return (PatSynBind x psb{ psb_ext = noExtField, psb_id = name }) }
| otherwise -- Pattern synonym, not at top level
= do { addErr localPatternSynonymErr -- Complain, but make up a fake
-- name so that we can carry on
; name <- applyNameMaker name_maker rdrname
- ; return (PatSynBind x psb{ psb_ext = noExt, psb_id = name }) }
+ ; return (PatSynBind x psb{ psb_ext = noExtField, psb_id = name }) }
where
localPatternSynonymErr :: SDoc
localPatternSynonymErr
@@ -629,7 +629,7 @@ makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls
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 _)) = panic "makeMiniFixityEnv"
+ add_one_sig _ (L _ (XFixitySig nec)) = noExtCon nec
add_one env (loc, name_loc, name,fixity) = do
{ -- this fixity decl is a duplicate iff
@@ -740,7 +740,7 @@ 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 _) = panic "rnPatSynBind"
+rnPatSynBind _ (XPatSynBind nec) = noExtCon nec
{-
Note [Renaming pattern synonym variables]
@@ -895,7 +895,7 @@ rnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest
= setSrcSpan loc $ do
do { sel_name <- wrapLocM (lookupInstDeclBndr cls (text "method")) name
-- We use the selector name as the binder
- ; let bind' = bind { fun_id = sel_name, fun_ext = noExt }
+ ; let bind' = bind { fun_id = sel_name, fun_ext = noExtField }
; return (L loc bind' `consBag` rest ) }
-- Report error for all other forms of bindings
@@ -959,13 +959,13 @@ renameSigs ctxt sigs
renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars)
renameSig _ (IdSig _ x)
- = return (IdSig noExt x, emptyFVs) -- Actually this never occurs
+ = return (IdSig noExtField x, emptyFVs) -- Actually this never occurs
renameSig ctxt sig@(TypeSig _ vs ty)
= do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
; let doc = TypeSigCtx (ppr_sig_bndrs vs)
; (new_ty, fvs) <- rnHsSigWcType BindUnlessForall doc ty
- ; return (TypeSig noExt new_vs new_ty, fvs) }
+ ; return (TypeSig noExtField new_vs new_ty, fvs) }
renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
= do { defaultSigs_on <- xoptM LangExt.DefaultSignatures
@@ -973,7 +973,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
addErr (defaultSigErr sig)
; new_v <- mapM (lookupSigOccRn ctxt sig) vs
; (new_ty, fvs) <- rnHsSigType ty_ctxt ty
- ; return (ClassOpSig noExt is_deflt new_v new_ty, fvs) }
+ ; return (ClassOpSig noExtField is_deflt new_v new_ty, fvs) }
where
(v1:_) = vs
ty_ctxt = GenericCtx (text "a class method signature for"
@@ -981,7 +981,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
renameSig _ (SpecInstSig _ src ty)
= do { (new_ty, fvs) <- rnHsSigType SpecInstSigCtx ty
- ; return (SpecInstSig noExt src new_ty,fvs) }
+ ; return (SpecInstSig noExtField src new_ty,fvs) }
-- {-# SPECIALISE #-} pragmas can refer to imported Ids
-- so, in the top-level case (when mb_names is Nothing)
@@ -992,7 +992,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl)
TopSigCtxt {} -> lookupLocatedOccRn v
_ -> lookupSigOccRn ctxt sig v
; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
- ; return (SpecSig noExt new_v new_ty inl, fvs) }
+ ; return (SpecSig noExtField new_v new_ty inl, fvs) }
where
ty_ctxt = GenericCtx (text "a SPECIALISE signature for"
<+> quotes (ppr v))
@@ -1002,27 +1002,27 @@ renameSig ctxt sig@(SpecSig _ v tys inl)
renameSig ctxt sig@(InlineSig _ v s)
= do { new_v <- lookupSigOccRn ctxt sig v
- ; return (InlineSig noExt new_v s, emptyFVs) }
+ ; return (InlineSig noExtField new_v s, emptyFVs) }
renameSig ctxt (FixSig _ fsig)
= do { new_fsig <- rnSrcFixityDecl ctxt fsig
- ; return (FixSig noExt new_fsig, emptyFVs) }
+ ; return (FixSig noExtField new_fsig, emptyFVs) }
renameSig ctxt sig@(MinimalSig _ s (L l bf))
= do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
- return (MinimalSig noExt s (L l new_bf), emptyFVs)
+ return (MinimalSig noExtField s (L l new_bf), emptyFVs)
renameSig ctxt sig@(PatSynSig _ vs ty)
= do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
; (ty', fvs) <- rnHsSigType ty_ctxt ty
- ; return (PatSynSig noExt new_vs ty', fvs) }
+ ; return (PatSynSig noExtField new_vs ty', fvs) }
where
ty_ctxt = GenericCtx (text "a pattern synonym signature for"
<+> ppr_sig_bndrs vs)
renameSig ctxt sig@(SCCFunSig _ st v s)
= do { new_v <- lookupSigOccRn ctxt sig v
- ; return (SCCFunSig noExt st new_v s, emptyFVs) }
+ ; return (SCCFunSig noExtField st new_v s, emptyFVs) }
-- COMPLETE Sigs can refer to imported IDs which is why we use
-- lookupLocatedOccRn rather than lookupSigOccRn
@@ -1035,7 +1035,7 @@ renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty)
-- Why 'any'? See Note [Orphan COMPLETE pragmas]
addErrCtxt (text "In" <+> ppr sig) $ failWithTc orphanError
- return (CompleteMatchSig noExt s (L l new_bf) new_mty, emptyFVs)
+ return (CompleteMatchSig noExtField s (L l new_bf) new_mty, emptyFVs)
where
orphanError :: SDoc
orphanError =
@@ -1043,7 +1043,7 @@ 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 _) = panic "renameSig"
+renameSig _ (XSig nec) = noExtCon nec
{-
Note [Orphan COMPLETE pragmas]
@@ -1070,7 +1070,7 @@ complexity of supporting them properly doesn't seem worthwhile.
ppr_sig_bndrs :: [Located RdrName] -> SDoc
ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
-okHsSig :: HsSigCtxt -> LSig a -> Bool
+okHsSig :: HsSigCtxt -> LSig (GhcPass a) -> Bool
okHsSig ctxt (L _ sig)
= case (sig, ctxt) of
(ClassOpSig {}, ClsDeclCtxt {}) -> True
@@ -1111,7 +1111,7 @@ okHsSig ctxt (L _ sig)
(CompleteMatchSig {}, TopSigCtxt {} ) -> True
(CompleteMatchSig {}, _) -> False
- (XSig _, _) -> panic "okHsSig"
+ (XSig nec, _) -> noExtCon nec
-------------------
findDupSigs :: [LSig GhcPs] -> [NonEmpty (Located RdrName, Sig GhcPs)]
@@ -1167,7 +1167,7 @@ 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 {}) = panic "rnMatchGroup"
+rnMatchGroup _ _ (XMatchGroup nec) = noExtCon nec
rnMatch :: Outputable (body GhcPs) => HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
@@ -1187,9 +1187,9 @@ rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss })
(FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ })
-> mf { mc_fun = L lf funid }
_ -> ctxt
- ; return (Match { m_ext = noExt, m_ctxt = mf', m_pats = pats'
+ ; return (Match { m_ext = noExtField, m_ctxt = mf', m_pats = pats'
, m_grhss = grhss'}, grhss_fvs ) }}
-rnMatch' _ _ (XMatch _) = panic "rnMatch'"
+rnMatch' _ _ (XMatch nec) = noExtCon nec
emptyCaseErr :: HsMatchContext Name -> SDoc
emptyCaseErr ctxt = hang (text "Empty list of alternatives in" <+> pp_ctxt)
@@ -1215,8 +1215,8 @@ rnGRHSs :: HsMatchContext Name
rnGRHSs ctxt rnBody (GRHSs _ grhss (L l binds))
= rnLocalBindsAndThen binds $ \ binds' _ -> do
(grhss', fvGRHSs) <- mapFvRn (rnGRHS ctxt rnBody) grhss
- return (GRHSs noExt grhss' (L l binds'), fvGRHSs)
-rnGRHSs _ _ (XGRHSs _) = panic "rnGRHSs"
+ return (GRHSs noExtField grhss' (L l binds'), fvGRHSs)
+rnGRHSs _ _ (XGRHSs nec) = noExtCon nec
rnGRHS :: HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
@@ -1236,7 +1236,7 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs)
; unless (pattern_guards_allowed || is_standard_guard guards')
(addWarn NoReason (nonStdGuardErr guards'))
- ; return (GRHS noExt guards' rhs', fvs) }
+ ; return (GRHS noExtField guards' rhs', fvs) }
where
-- Standard Haskell 1.4 guards are just a single boolean
-- expression, rather than a list of qualifiers as in the
@@ -1244,7 +1244,7 @@ rnGRHS' ctxt rnBody (GRHS _ guards rhs)
is_standard_guard [] = True
is_standard_guard [L _ (BodyStmt {})] = True
is_standard_guard _ = False
-rnGRHS' _ _ (XGRHS _) = panic "rnGRHS'"
+rnGRHS' _ _ (XGRHS nec) = noExtCon nec
{-
*********************************************************
@@ -1267,8 +1267,8 @@ rnSrcFixityDecl sig_ctxt = rn_decl
-- return a fixity sig for each (slightly odd)
rn_decl (FixitySig _ fnames fixity)
= do names <- concatMapM lookup_one fnames
- return (FixitySig noExt names fixity)
- rn_decl (XFixitySig _) = panic "rnSrcFixityDecl"
+ 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/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 772122bb99..91cf8f22f4 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1658,10 +1658,10 @@ lookupSyntaxNames :: [Name] -- Standard names
lookupSyntaxNames std_names
= do { rebindable_on <- xoptM LangExt.RebindableSyntax
; if not rebindable_on then
- return (map (HsVar noExt . noLoc) std_names, emptyFVs)
+ return (map (HsVar noExtField . noLoc) std_names, emptyFVs)
else
do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names
- ; return (map (HsVar noExt . noLoc) usr_names, mkFVs usr_names) } }
+ ; return (map (HsVar noExtField . noLoc) usr_names, mkFVs usr_names) } }
-- Error messages
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 98d487df2d..eadb4bca03 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -100,7 +100,7 @@ finishHsVar (L l name)
= do { this_mod <- getModule
; when (nameIsLocalOrFrom this_mod name) $
checkThLocalName name
- ; return (HsVar noExt (L l name), unitFV name) }
+ ; return (HsVar noExtField (L l name), unitFV name) }
rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
rnUnboundVar v
@@ -112,11 +112,11 @@ rnUnboundVar v
; uv <- if startsWithUnderscore occ
then return (TrueExprHole occ)
else OutOfScope occ <$> getGlobalRdrEnv
- ; return (HsUnboundVar noExt uv, emptyFVs) }
+ ; return (HsUnboundVar noExtField uv, emptyFVs) }
else -- Fail immediately (qualified name)
do { n <- reportUnboundName v
- ; return (HsVar noExt (noLoc n), emptyFVs) } }
+ ; return (HsVar noExtField (noLoc n), emptyFVs) } }
rnExpr (HsVar _ (L l v))
= do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields
@@ -126,14 +126,14 @@ rnExpr (HsVar _ (L l v))
Just (Left name)
| name == nilDataConName -- Treat [] as an ExplicitList, so that
-- OverloadedLists works correctly
- -> rnExpr (ExplicitList noExt Nothing [])
+ -> rnExpr (ExplicitList noExtField Nothing [])
| otherwise
-> finishHsVar (L l name) ;
Just (Right [s]) ->
- return ( HsRecFld noExt (Unambiguous s (L l v) ), unitFV s) ;
+ return ( HsRecFld noExtField (Unambiguous s (L l v) ), unitFV s) ;
Just (Right fs@(_:_:_)) ->
- return ( HsRecFld noExt (Ambiguous noExt (L l v))
+ return ( HsRecFld noExtField (Ambiguous noExtField (L l v))
, mkFVs fs);
Just (Right []) -> panic "runExpr/HsVar" } }
@@ -290,9 +290,9 @@ rnExpr (ExplicitTuple x tup_args boxity)
where
rnTupArg (L l (Present x e)) = do { (e',fvs) <- rnLExpr e
; return (L l (Present x e'), fvs) }
- rnTupArg (L l (Missing _)) = return (L l (Missing noExt)
+ rnTupArg (L l (Missing _)) = return (L l (Missing noExtField)
, emptyFVs)
- rnTupArg (L _ (XTupArg {})) = panic "rnExpr.XTupArg"
+ rnTupArg (L _ (XTupArg nec)) = noExtCon nec
rnExpr (ExplicitSum x alt arity expr)
= do { (expr', fvs) <- rnLExpr expr
@@ -304,18 +304,18 @@ rnExpr (RecordCon { rcon_con_name = con_id
; (flds, fvs) <- rnHsRecFields (HsRecFieldCon con_name) mk_hs_var rec_binds
; (flds', fvss) <- mapAndUnzipM rn_field flds
; let rec_binds' = HsRecFields { rec_flds = flds', rec_dotdot = dd }
- ; return (RecordCon { rcon_ext = noExt
+ ; return (RecordCon { rcon_ext = noExtField
, rcon_con_name = con_lname, rcon_flds = rec_binds' }
, fvs `plusFV` plusFVs fvss `addOneFV` con_name) }
where
- mk_hs_var l n = HsVar noExt (L l n)
+ mk_hs_var l n = HsVar noExtField (L l n)
rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
; return (L l (fld { hsRecFieldArg = arg' }), fvs) }
rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
= do { (expr', fvExpr) <- rnLExpr expr
; (rbinds', fvRbinds) <- rnHsRecUpdFields rbinds
- ; return (RecordUpd { rupd_ext = noExt, rupd_expr = expr'
+ ; return (RecordUpd { rupd_ext = noExtField, rupd_expr = expr'
, rupd_flds = rbinds' }
, fvExpr `plusFV` fvRbinds) }
@@ -323,7 +323,7 @@ rnExpr (ExprWithTySig _ expr pty)
= do { (pty', fvTy) <- rnHsSigWcType BindUnlessForall ExprWithTySigCtx pty
; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $
rnLExpr expr
- ; return (ExprWithTySig noExt expr' pty', fvExpr `plusFV` fvTy) }
+ ; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) }
rnExpr (HsIf x _ p b1 b2)
= do { (p', fvP) <- rnLExpr p
@@ -444,7 +444,7 @@ rnCmdTop = wrapLocFstM rnCmdTop'
; return (HsCmdTop (cmd_names `zip` cmd_names') cmd',
fvCmd `plusFV` cmd_fvs) }
- rnCmdTop' (XCmdTop{}) = panic "rnCmdTop"
+ rnCmdTop' (XCmdTop nec) = noExtCon nec
rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd = wrapLocFstM rnCmd
@@ -518,7 +518,7 @@ rnCmd (HsCmdDo x (L l stmts))
; return ( HsCmdDo x (L l stmts'), fvs ) }
rnCmd cmd@(HsCmdWrap {}) = pprPanic "rnCmd" (ppr cmd)
-rnCmd cmd@(XCmd {}) = pprPanic "rnCmd" (ppr cmd)
+rnCmd (XCmd nec) = noExtCon nec
---------------------------------------------------
type CmdNeeds = FreeVars -- Only inhabitants are
@@ -550,7 +550,7 @@ methodNamesCmd (HsCmdLam _ match) = methodNamesMatch match
methodNamesCmd (HsCmdCase _ _ matches)
= methodNamesMatch matches `addOneFV` choiceAName
-methodNamesCmd (XCmd {}) = panic "methodNamesCmd"
+methodNamesCmd (XCmd nec) = noExtCon nec
--methodNamesCmd _ = emptyFVs
-- Other forms can't occur in commands, but it's not convenient
@@ -563,20 +563,20 @@ 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 _)) = panic "methodNamesMatch.XMatch"
-methodNamesMatch (XMatchGroup _) = panic "methodNamesMatch"
+ 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 _) = panic "methodNamesGRHSs"
+methodNamesGRHSs (XGRHSs nec) = noExtCon nec
-------------------------------------------------
methodNamesGRHS :: Located (GRHS GhcRn (LHsCmd GhcRn)) -> CmdNeeds
methodNamesGRHS (L _ (GRHS _ _ rhs)) = methodNamesLCmd rhs
-methodNamesGRHS (L _ (XGRHS _)) = panic "methodNamesGRHS"
+methodNamesGRHS (L _ (XGRHS nec)) = noExtCon nec
---------------------------------------------------
methodNamesStmts :: [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars
@@ -598,7 +598,7 @@ 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 {}) = panic "methodNamesStmt"
+methodNamesStmt (XStmtLR nec) = noExtCon nec
{-
************************************************************************
@@ -811,7 +811,7 @@ rnStmt ctxt rnBody (L loc (LastStmt _ body noret _)) thing_inside
-- #15607
; (thing, fvs3) <- thing_inside []
- ; return (([(L loc (LastStmt noExt body' noret ret_op), fv_expr)]
+ ; return (([(L loc (LastStmt noExtField body' noret ret_op), fv_expr)]
, thing), fv_expr `plusFV` fvs1 `plusFV` fvs3) }
rnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside
@@ -826,7 +826,7 @@ rnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside
-- Here "gd" is a guard
; (thing, fvs3) <- thing_inside []
- ; return ( ([(L loc (BodyStmt noExt body' then_op guard_op), fv_expr)]
+ ; return ( ([(L loc (BodyStmt noExtField body' then_op guard_op), fv_expr)]
, thing), fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }
rnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside
@@ -838,7 +838,7 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside
; rnPat (StmtCtxt ctxt) pat $ \ pat' -> do
{ (thing, fvs3) <- thing_inside (collectPatBinders pat')
- ; return (( [( L loc (BindStmt noExt pat' body' bind_op fail_op)
+ ; return (( [( L loc (BindStmt noExtField pat' body' bind_op fail_op)
, fv_expr )]
, thing),
fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
@@ -848,7 +848,7 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside
rnStmt _ _ (L loc (LetStmt _ (L l binds))) thing_inside
= do { rnLocalBindsAndThen binds $ \binds' bind_fvs -> do
{ (thing, fvs) <- thing_inside (collectLocalBinders binds')
- ; return ( ([(L loc (LetStmt noExt (L l binds')), bind_fvs)], thing)
+ ; return ( ([(L loc (LetStmt noExtField (L l binds')), bind_fvs)], thing)
, fvs) } }
rnStmt ctxt rnBody (L loc (RecStmt { recS_stmts = rec_stmts })) thing_inside
@@ -886,7 +886,7 @@ rnStmt ctxt _ (L loc (ParStmt _ segs _ _)) thing_inside
; (bind_op, fvs2) <- lookupStmtName ctxt bindMName
; (return_op, fvs3) <- lookupStmtName ctxt returnMName
; ((segs', thing), fvs4) <- rnParallelStmts (ParStmtCtxt ctxt) return_op segs thing_inside
- ; return (([(L loc (ParStmt noExt segs' mzip_op bind_op), fvs4)], thing)
+ ; return (([(L loc (ParStmt noExtField segs' mzip_op bind_op), fvs4)], thing)
, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = form
@@ -919,7 +919,7 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for
-- See Note [TransStmt binder map] in HsExpr
; traceRn "rnStmt: implicitly rebound these used binders:" (ppr bndr_map)
- ; return (([(L loc (TransStmt { trS_ext = noExt
+ ; return (([(L loc (TransStmt { trS_ext = noExtField
, trS_stmts = stmts', trS_bndrs = bndr_map
, trS_by = by', trS_using = using', trS_form = form
, trS_ret = return_op, trS_bind = bind_op
@@ -928,8 +928,8 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for
rnStmt _ _ (L _ ApplicativeStmt{}) _ =
panic "rnStmt: ApplicativeStmt"
-rnStmt _ _ (L _ XStmtLR{}) _ =
- panic "rnStmt: XStmtLR"
+rnStmt _ _ (L _ (XStmtLR nec)) _ =
+ noExtCon nec
rnParallelStmts :: forall thing. HsStmtContext Name
-> SyntaxExpr GhcRn
@@ -960,7 +960,7 @@ rnParallelStmts ctxt return_op segs thing_inside
; let seg' = ParStmtBlock x stmts' used_bndrs return_op
; return ((seg':segs', thing), fvs) }
- rn_segs _ _ (XParStmtBlock{}:_) = panic "rnParallelStmts"
+ 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:"
@@ -980,12 +980,12 @@ lookupStmtNamePoly ctxt name
= do { rebindable_on <- xoptM LangExt.RebindableSyntax
; if rebindable_on
then do { fm <- lookupOccRn (nameRdrName name)
- ; return (HsVar noExt (noLoc fm), unitFV fm) }
+ ; return (HsVar noExtField (noLoc fm), unitFV fm) }
else not_rebindable }
| otherwise
= not_rebindable
where
- not_rebindable = return (HsVar noExt (noLoc name), emptyFVs)
+ not_rebindable = return (HsVar noExtField (noLoc name), emptyFVs)
-- | Is this a context where we respect RebindableSyntax?
-- but ListComp are never rebindable
@@ -1093,23 +1093,23 @@ rn_rec_stmt_lhs :: Outputable body => MiniFixityEnv
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmt_lhs _ (L loc (BodyStmt _ body a b))
- = return [(L loc (BodyStmt noExt body a b), emptyFVs)]
+ = return [(L loc (BodyStmt noExtField body a b), emptyFVs)]
rn_rec_stmt_lhs _ (L loc (LastStmt _ body noret a))
- = return [(L loc (LastStmt noExt body noret a), emptyFVs)]
+ = return [(L loc (LastStmt noExtField body noret a), emptyFVs)]
rn_rec_stmt_lhs fix_env (L loc (BindStmt _ pat body a b))
= do
-- should the ctxt be MDo instead?
(pat', fv_pat) <- rnBindPat (localRecNameMaker fix_env) pat
- return [(L loc (BindStmt noExt pat' body a b), fv_pat)]
+ return [(L loc (BindStmt noExtField pat' body a b), fv_pat)]
rn_rec_stmt_lhs _ (L _ (LetStmt _ (L _ binds@(HsIPBinds {}))))
= failWith (badIpBinds (text "an mdo expression") binds)
rn_rec_stmt_lhs fix_env (L loc (LetStmt _ (L l (HsValBinds x binds))))
= do (_bound_names, binds') <- rnLocalValBindsLHS fix_env binds
- return [(L loc (LetStmt noExt (L l (HsValBinds x binds'))),
+ return [(L loc (LetStmt noExtField (L l (HsValBinds x binds'))),
-- Warning: this is bogus; see function invariant
emptyFVs
)]
@@ -1129,10 +1129,10 @@ 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 _))))
- = panic "rn_rec_stmt LetStmt XHsLocalBindsLR"
-rn_rec_stmt_lhs _ (L _ (XStmtLR _))
- = panic "rn_rec_stmt XStmtLR"
+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]
@@ -1161,13 +1161,13 @@ rn_rec_stmt rnBody _ (L loc (LastStmt _ body noret _), _)
= do { (body', fv_expr) <- rnBody body
; (ret_op, fvs1) <- lookupSyntaxName returnMName
; return [(emptyNameSet, fv_expr `plusFV` fvs1, emptyNameSet,
- L loc (LastStmt noExt body' noret ret_op))] }
+ L loc (LastStmt noExtField body' noret ret_op))] }
rn_rec_stmt rnBody _ (L loc (BodyStmt _ body _ _), _)
= do { (body', fvs) <- rnBody body
; (then_op, fvs1) <- lookupSyntaxName thenMName
; return [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
- L loc (BodyStmt noExt body' then_op noSyntaxExpr))] }
+ L loc (BodyStmt noExtField body' then_op noSyntaxExpr))] }
rn_rec_stmt rnBody _ (L loc (BindStmt _ pat' body _ _), fv_pat)
= do { (body', fv_expr) <- rnBody body
@@ -1178,7 +1178,7 @@ rn_rec_stmt rnBody _ (L loc (BindStmt _ pat' body _ _), fv_pat)
; let bndrs = mkNameSet (collectPatBinders pat')
fvs = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
; return [(bndrs, fvs, bndrs `intersectNameSet` fvs,
- L loc (BindStmt noExt pat' body' bind_op fail_op))] }
+ L loc (BindStmt noExtField pat' body' bind_op fail_op))] }
rn_rec_stmt _ _ (L _ (LetStmt _ (L _ binds@(HsIPBinds {}))), _)
= failWith (badIpBinds (text "an mdo expression") binds)
@@ -1188,7 +1188,7 @@ rn_rec_stmt _ all_bndrs (L loc (LetStmt _ (L l (HsValBinds x binds'))), _)
-- fixities and unused are handled above in rnRecStmtsAndThen
; let fvs = allUses du_binds
; return [(duDefs du_binds, fvs, emptyNameSet,
- L loc (LetStmt noExt (L l (HsValBinds x binds'))))] }
+ L loc (LetStmt noExtField (L l (HsValBinds x binds'))))] }
-- no RecStmt case because they get flattened above when doing the LHSes
rn_rec_stmt _ _ stmt@(L _ (RecStmt {}), _)
@@ -1200,8 +1200,8 @@ 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 _))), _)
- = panic "rn_rec_stmt: LetStmt XHsLocalBindsLR"
+rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (XHsLocalBindsLR nec))), _)
+ = noExtCon nec
rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))), _)
= panic "rn_rec_stmt: LetStmt EmptyLocalBinds"
@@ -1209,8 +1209,8 @@ rn_rec_stmt _ _ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))), _)
rn_rec_stmt _ _ stmt@(L _ (ApplicativeStmt {}), _)
= pprPanic "rn_rec_stmt: ApplicativeStmt" (ppr stmt)
-rn_rec_stmt _ _ stmt@(L _ (XStmtLR {}), _)
- = pprPanic "rn_rec_stmt: XStmtLR" (ppr stmt)
+rn_rec_stmt _ _ (L _ (XStmtLR nec), _)
+ = noExtCon nec
rn_rec_stmts :: Outputable (body GhcPs) =>
(Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
@@ -1647,12 +1647,12 @@ stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BindStmt _ pat rhs _ _), _))
tail _tail_fvs
| not (isStrictPattern pat), (False,tail') <- needJoin monad_names tail
-- See Note [ApplicativeDo and strict patterns]
- = mkApplicativeStmt ctxt [ApplicativeArgOne noExt pat rhs False] False tail'
+ = mkApplicativeStmt ctxt [ApplicativeArgOne noExtField pat rhs False] False tail'
stmtTreeToStmts monad_names ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),_))
tail _tail_fvs
| (False,tail') <- needJoin monad_names tail
= mkApplicativeStmt ctxt
- [ApplicativeArgOne noExt nlWildPatName rhs True] False tail'
+ [ApplicativeArgOne noExtField nlWildPatName rhs True] False tail'
stmtTreeToStmts _monad_names _ctxt (StmtTreeOne (s,_)) tail _tail_fvs =
return (s : tail, emptyNameSet)
@@ -1671,9 +1671,9 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do
return (stmts, unionNameSets (fvs:fvss))
where
stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BindStmt _ pat exp _ _), _))
- = return (ApplicativeArgOne noExt pat exp False, emptyFVs)
+ = return (ApplicativeArgOne noExtField pat exp False, emptyFVs)
stmtTreeArg _ctxt _tail_fvs (StmtTreeOne (L _ (BodyStmt _ exp _ _), _)) =
- return (ApplicativeArgOne noExt nlWildPatName exp True, emptyFVs)
+ return (ApplicativeArgOne noExtField nlWildPatName exp True, emptyFVs)
stmtTreeArg ctxt tail_fvs tree = do
let stmts = flattenStmtTree tree
pvarset = mkNameSet (concatMap (collectStmtBinders.unLoc.fst) stmts)
@@ -1688,8 +1688,8 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do
return (unLoc tup, emptyNameSet)
| otherwise -> do
(ret,fvs) <- lookupStmtNamePoly ctxt returnMName
- return (HsApp noExt (noLoc ret) tup, fvs)
- return ( ApplicativeArgMany noExt stmts' mb_ret pat
+ return (HsApp noExtField (noLoc ret) tup, fvs)
+ return ( ApplicativeArgMany noExtField stmts' mb_ret pat
, fvs1 `plusFV` fvs2)
@@ -1832,7 +1832,7 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts
-- an infinite loop (#14163).
go lets indep bndrs ((L loc (BindStmt _ pat body bind_op fail_op), fvs): rest)
| isEmptyNameSet (bndrs `intersectNameSet` fvs) && not (isStrictPattern pat)
- = go lets ((L loc (BindStmt noExt pat body bind_op fail_op), fvs) : indep)
+ = go lets ((L loc (BindStmt noExtField pat body bind_op fail_op), fvs) : indep)
bndrs' rest
where bndrs' = bndrs `unionNameSet` mkNameSet (collectPatBinders pat)
-- If we encounter a LetStmt that doesn't depend on a BindStmt in this
@@ -1840,9 +1840,9 @@ slurpIndependentStmts stmts = go [] [] emptyNameSet stmts
-- grouping more BindStmts.
-- TODO: perhaps we shouldn't do this if there are any strict bindings,
-- because we might be moving evaluation earlier.
- go lets indep bndrs ((L loc (LetStmt noExt binds), fvs) : rest)
+ go lets indep bndrs ((L loc (LetStmt noExtField binds), fvs) : rest)
| isEmptyNameSet (bndrs `intersectNameSet` fvs)
- = go ((L loc (LetStmt noExt binds), fvs) : lets) indep bndrs rest
+ = go ((L loc (LetStmt noExtField binds), fvs) : lets) indep bndrs rest
go _ [] _ _ = Nothing
go _ [_] _ _ = Nothing
go lets indep _ stmts = Just (reverse lets, reverse indep, stmts)
@@ -1875,7 +1875,7 @@ mkApplicativeStmt ctxt args need_join body_stmts
; return (Just join_op, fvs) }
else
return (Nothing, emptyNameSet)
- ; let applicative_stmt = noLoc $ ApplicativeStmt noExt
+ ; let applicative_stmt = noLoc $ ApplicativeStmt noExtField
(zip (fmap_op : repeat ap_op) args)
mb_join
; return ( applicative_stmt : body_stmts
@@ -1889,7 +1889,7 @@ needJoin :: MonadNames
needJoin _monad_names [] = (False, []) -- we're in an ApplicativeArg
needJoin monad_names [L loc (LastStmt _ e _ t)]
| Just arg <- isReturnApp monad_names e =
- (False, [L loc (LastStmt noExt arg True t)])
+ (False, [L loc (LastStmt noExtField arg True t)])
needJoin _monad_names stmts = (True, stmts)
-- | @Just e@, if the expression is @return e@ or @return $ e@,
@@ -1978,7 +1978,7 @@ checkStmt ctxt (L _ stmt)
msg = sep [ text "Unexpected" <+> pprStmtCat stmt <+> ptext (sLit "statement")
, text "in" <+> pprAStmtContext ctxt ]
-pprStmtCat :: Stmt a body -> SDoc
+pprStmtCat :: Stmt (GhcPass a) body -> SDoc
pprStmtCat (TransStmt {}) = text "transform"
pprStmtCat (LastStmt {}) = text "return expression"
pprStmtCat (BodyStmt {}) = text "body"
@@ -1987,7 +1987,7 @@ pprStmtCat (LetStmt {}) = text "let"
pprStmtCat (RecStmt {}) = text "rec"
pprStmtCat (ParStmt {}) = text "parallel"
pprStmtCat (ApplicativeStmt {}) = panic "pprStmtCat: ApplicativeStmt"
-pprStmtCat (XStmtLR {}) = panic "pprStmtCat: XStmtLR"
+pprStmtCat (XStmtLR nec) = noExtCon nec
------------
emptyInvalid :: Validity -- Payload is the empty document
@@ -2053,7 +2053,7 @@ okCompStmt dflags _ stmt
RecStmt {} -> emptyInvalid
LastStmt {} -> emptyInvalid -- Should not happen (dealt with by checkLastStmt)
ApplicativeStmt {} -> emptyInvalid
- XStmtLR{} -> panic "okCompStmt"
+ XStmtLR nec -> noExtCon nec
---------
checkTupleSection :: [LHsTupArg GhcPs] -> RnM ()
@@ -2134,7 +2134,7 @@ getMonadFailOp
(nlHsApp (noLoc $ syn_expr fromStringExpr)
(noLoc $ syn_expr arg_syn_expr))
let failAfterFromStringExpr :: HsExpr GhcRn =
- unLoc $ mkHsLam [noLoc $ VarPat noExt $ noLoc arg_name] body
+ unLoc $ mkHsLam [noLoc $ VarPat noExtField $ noLoc arg_name] body
let failAfterFromStringSynExpr :: SyntaxExpr GhcRn =
mkSyntaxExpr failAfterFromStringExpr
return (failAfterFromStringSynExpr, failFvs `plusFV` fromStringFvs)
diff --git a/compiler/rename/RnFixity.hs b/compiler/rename/RnFixity.hs
index 1fa81c8fc2..665d87747b 100644
--- a/compiler/rename/RnFixity.hs
+++ b/compiler/rename/RnFixity.hs
@@ -211,4 +211,4 @@ lookupFieldFixityRn (Ambiguous _ lrdr) = get_ambiguous_fixity (unLoc lrdr)
format_ambig (elt, fix) = hang (ppr fix)
2 (pprNameProvenance elt)
-lookupFieldFixityRn (XAmbiguousFieldOcc{}) = panic "lookupFieldFixityRn"
+lookupFieldFixityRn (XAmbiguousFieldOcc nec) = noExtCon nec
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index 9a69423209..5bfc1a37d8 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -263,7 +263,7 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
rnImportDecl :: Module -> LImportDecl GhcPs
-> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl this_mod
- (L loc decl@(ImportDecl { ideclExt = noExt
+ (L loc decl@(ImportDecl { ideclExt = noExtField
, ideclName = loc_imp_mod_name
, ideclPkgQual = mb_pkg
, ideclSource = want_boot, ideclSafe = mod_safe
@@ -376,11 +376,11 @@ rnImportDecl this_mod
_ -> return ()
)
- let new_imp_decl = L loc (decl { ideclExt = noExt, ideclSafe = mod_safe'
+ let new_imp_decl = L loc (decl { ideclExt = noExtField, ideclSafe = mod_safe'
, ideclHiding = new_imp_details })
return (new_imp_decl, gbl_env, imports, mi_hpc iface)
-rnImportDecl _ (L _ (XImportDecl _)) = panic "rnImportDecl"
+rnImportDecl _ (L _ (XImportDecl nec)) = noExtCon nec
-- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'.
@@ -723,7 +723,7 @@ 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 _)) = panic "getLocalNonValBinders"
+ find_con_decl_fld (L _ (XFieldOcc nec)) = noExtCon nec
new_assoc :: Bool -> LInstDecl GhcPs
-> RnM ([AvailInfo], [(Name, [FieldLabel])])
@@ -759,8 +759,8 @@ getLocalNonValBinders fixity_env
(avails, fldss)
<- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
pure (avails, concat fldss)
- new_assoc _ (L _ (ClsInstD _ (XClsInstDecl _))) = panic "new_assoc"
- new_assoc _ (L _ (XInstDecl _)) = panic "new_assoc"
+ 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])])
@@ -774,16 +774,16 @@ 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 _)) = panic "new_di"
+ 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 _) = panic "getLocalNonValBinders"
+getLocalNonValBinders _ (XHsGroup nec) = noExtCon nec
newRecordSelector :: Bool -> [Name] -> LFieldOcc GhcPs -> RnM FieldLabel
newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
-newRecordSelector _ _ (L _ (XFieldOcc _)) = panic "newRecordSelector"
+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 } }
@@ -966,7 +966,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
case ie of
IEVar _ (L l n) -> do
(name, avail, _) <- lookup_name ie $ ieWrappedName n
- return ([(IEVar noExt (L l (replaceWrappedName n name)),
+ return ([(IEVar noExtField (L l (replaceWrappedName n name)),
trimAvail avail name)], [])
IEThingAll _ (L l tc) -> do
@@ -985,7 +985,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
| otherwise
-> []
- renamed_ie = IEThingAll noExt (L l (replaceWrappedName tc name))
+ renamed_ie = IEThingAll noExtField (L l (replaceWrappedName tc name))
sub_avails = case avail of
Avail {} -> []
AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)]
@@ -1014,7 +1014,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
IEThingWith xt ltc@(L l rdr_tc) wc rdr_ns rdr_fs ->
ASSERT2(null rdr_fs, ppr rdr_fs) do
(name, avail, mb_parent)
- <- lookup_name (IEThingAbs noExt ltc) (ieWrappedName rdr_tc)
+ <- lookup_name (IEThingAbs noExtField ltc) (ieWrappedName rdr_tc)
let (ns,subflds) = case avail of
AvailTC _ ns' subflds' -> (ns',subflds')
@@ -1038,7 +1038,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
case mb_parent of
-- non-associated ty/cls
Nothing
- -> return ([(IEThingWith noExt (L l name') wc childnames'
+ -> return ([(IEThingWith noExtField (L l name') wc childnames'
childflds,
AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
[])
@@ -1047,10 +1047,10 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
-- childnames' = postrn_ies childnames
-- associated ty
Just parent
- -> return ([(IEThingWith noExt (L l name') wc childnames'
+ -> return ([(IEThingWith noExtField (L l name') wc childnames'
childflds,
AvailTC name (map unLoc childnames) (map unLoc childflds)),
- (IEThingWith noExt (L l name') wc childnames'
+ (IEThingWith noExtField (L l name') wc childnames'
childflds,
AvailTC parent [name] [])],
[])
@@ -1063,9 +1063,9 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
where
mkIEThingAbs tc l (n, av, Nothing )
- = (IEThingAbs noExt (L l (replaceWrappedName tc n)), trimAvail av n)
+ = (IEThingAbs noExtField (L l (replaceWrappedName tc n)), trimAvail av n)
mkIEThingAbs tc l (n, _, Just parent)
- = (IEThingAbs noExt (L l (replaceWrappedName tc n))
+ = (IEThingAbs noExtField (L l (replaceWrappedName tc n))
, AvailTC parent [n] [])
handle_bad_import m = catchIELookup m $ \err -> case err of
@@ -1394,7 +1394,7 @@ 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 _)) = panic "unused_decl"
+ unused_decl (L _ (XImportDecl nec)) = noExtCon nec
{- Note [The ImportMap]
@@ -1535,25 +1535,25 @@ getMinimalImports = mapM mk_minimal
-- we want to say "T(..)", but if we're importing only a subset we want
-- to say "T(A,B,C)". So we have to find out what the module exports.
to_ie _ (Avail n)
- = [IEVar noExt (to_ie_post_rn $ noLoc n)]
+ = [IEVar noExtField (to_ie_post_rn $ noLoc n)]
to_ie _ (AvailTC n [m] [])
- | n==m = [IEThingAbs noExt (to_ie_post_rn $ noLoc n)]
+ | n==m = [IEThingAbs noExtField (to_ie_post_rn $ noLoc n)]
to_ie iface (AvailTC n ns fs)
= case [(xs,gs) | AvailTC x xs gs <- mi_exports iface
, x == n
, x `elem` xs -- Note [Partial export]
] of
- [xs] | all_used xs -> [IEThingAll noExt (to_ie_post_rn $ noLoc n)]
+ [xs] | all_used xs -> [IEThingAll noExtField (to_ie_post_rn $ noLoc n)]
| otherwise ->
- [IEThingWith noExt (to_ie_post_rn $ noLoc n) NoIEWildcard
+ [IEThingWith noExtField (to_ie_post_rn $ noLoc n) NoIEWildcard
(map (to_ie_post_rn . noLoc) (filter (/= n) ns))
(map noLoc fs)]
-- Note [Overloaded field import]
_other | all_non_overloaded fs
- -> map (IEVar noExt . to_ie_post_rn_var . noLoc) $ ns
+ -> map (IEVar noExtField . to_ie_post_rn_var . noLoc) $ ns
++ map flSelector fs
| otherwise ->
- [IEThingWith noExt (to_ie_post_rn $ noLoc n) NoIEWildcard
+ [IEThingWith noExtField (to_ie_post_rn $ noLoc n) NoIEWildcard
(map (to_ie_post_rn . noLoc) (filter (/= n) ns))
(map noLoc fs)]
where
@@ -1718,7 +1718,7 @@ dodgyMsg kind tc ie
text "but it has none" ]
dodgyMsgInsert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
-dodgyMsgInsert tc = IEThingAll noExt ii
+dodgyMsgInsert tc = IEThingAll noExtField ii
where
ii :: LIEWrappedName (IdP (GhcPass p))
ii = noLoc (IEName $ noLoc tc)
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 4a08ab4761..150b1cd23f 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -384,7 +384,7 @@ rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn)
rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
-rnPatAndThen _ (WildPat _) = return (WildPat noExt)
+rnPatAndThen _ (WildPat _) = return (WildPat noExtField)
rnPatAndThen mk (ParPat x pat) = do { pat' <- rnLPatAndThen mk pat
; return (ParPat x pat') }
rnPatAndThen mk (LazyPat x pat) = do { pat' <- rnLPatAndThen mk pat
@@ -471,7 +471,7 @@ rnPatAndThen mk (ConPatIn con stuff)
-- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on.
= case unLoc con == nameRdrName (dataConName nilDataCon) of
True -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists
- ; if ol_flag then rnPatAndThen mk (ListPat noExt [])
+ ; if ol_flag then rnPatAndThen mk (ListPat noExtField [])
else rnConPatAndThen mk con stuff}
False -> rnConPatAndThen mk con stuff
@@ -548,7 +548,7 @@ rnHsRecPatsAndThen mk (dL->L _ con)
; check_unused_wildcard (implicit_binders flds' <$> dd)
; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
where
- mkVarPat l n = VarPat noExt (cL l n)
+ mkVarPat l n = VarPat noExtField (cL l n)
rn_field (dL->L l fld, n') =
do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hsRecFieldArg fld)
; return (cL l (fld { hsRecFieldArg = arg' })) }
@@ -747,7 +747,7 @@ rnHsRecUpdFields flds
then do { checkErr pun_ok (badPun (cL loc lbl))
-- Discard any module qualifier (#11662)
; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
- ; return (cL loc (HsVar noExt (cL loc arg_rdr))) }
+ ; return (cL loc (HsVar noExtField (cL loc arg_rdr))) }
else return arg
; (arg'', fvs) <- rnLExpr arg'
@@ -757,10 +757,10 @@ rnHsRecUpdFields flds
Right _ -> fvs
lbl' = case sel of
Left sel_name ->
- cL loc (Unambiguous sel_name (cL loc lbl))
+ cL loc (Unambiguous sel_name (cL loc lbl))
Right [sel_name] ->
- cL loc (Unambiguous sel_name (cL loc lbl))
- Right _ -> cL loc (Ambiguous noExt (cL loc lbl))
+ cL loc (Unambiguous sel_name (cL loc lbl))
+ Right _ -> cL loc (Ambiguous noExtField (cL loc lbl))
; return (cL l (HsRecField { hsRecFieldLbl = lbl'
, hsRecFieldArg = arg''
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index e3c9576e94..2aa5afbbd2 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -197,7 +197,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
last_tcg_env <- getGblEnv ;
-- (I) Compute the results and return
- let {rn_group = HsGroup { hs_ext = noExt,
+ let {rn_group = HsGroup { hs_ext = noExtField,
hs_valds = rn_val_decls,
hs_splcds = rn_splice_decls,
hs_tyclds = rn_tycl_decls,
@@ -229,7 +229,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
traceRn "finish Dus" (ppr src_dus ) ;
return (final_tcg_env, rn_group)
}}}}
-rnSrcDecls (XHsGroup _) = panic "rnSrcDecls"
+rnSrcDecls (XHsGroup nec) = noExtCon nec
addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
-- This function could be defined lower down in the module hierarchy,
@@ -297,7 +297,7 @@ rnSrcWarnDecls bndr_set decls'
= do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
rdr_names
; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }
- rn_deprec (XWarnDecl _) = panic "rnSrcWarnDecls"
+ rn_deprec (XWarnDecl nec) = noExtCon nec
what = text "deprecation"
@@ -331,9 +331,9 @@ rnAnnDecl ann@(HsAnnotation _ s provenance expr)
do { (provenance', provenance_fvs) <- rnAnnProvenance provenance
; (expr', expr_fvs) <- setStage (Splice Untyped) $
rnLExpr expr
- ; return (HsAnnotation noExt s provenance' expr',
+ ; return (HsAnnotation noExtField s provenance' expr',
provenance_fvs `plusFV` expr_fvs) }
-rnAnnDecl (XAnnDecl _) = panic "rnAnnDecl"
+rnAnnDecl (XAnnDecl nec) = noExtCon nec
rnAnnProvenance :: AnnProvenance RdrName
-> RnM (AnnProvenance Name, FreeVars)
@@ -352,10 +352,10 @@ rnAnnProvenance provenance = do
rnDefaultDecl :: DefaultDecl GhcPs -> RnM (DefaultDecl GhcRn, FreeVars)
rnDefaultDecl (DefaultDecl _ tys)
= do { (tys', fvs) <- rnLHsTypes doc_str tys
- ; return (DefaultDecl noExt tys', fvs) }
+ ; return (DefaultDecl noExtField tys', fvs) }
where
doc_str = DefaultDeclCtx
-rnDefaultDecl (XDefaultDecl _) = panic "rnDefaultDecl"
+rnDefaultDecl (XDefaultDecl nec) = noExtCon nec
{-
*********************************************************
@@ -375,14 +375,14 @@ rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })
; let unitId = thisPackage $ hsc_dflags topEnv
spec' = patchForeignImport unitId spec
- ; return (ForeignImport { fd_i_ext = noExt
+ ; return (ForeignImport { fd_i_ext = noExtField
, fd_name = name', fd_sig_ty = ty'
, fd_fi = spec' }, fvs) }
rnHsForeignDecl (ForeignExport { fd_name = name, fd_sig_ty = ty, fd_fe = spec })
= do { name' <- lookupLocatedOccRn name
; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) ty
- ; return (ForeignExport { fd_e_ext = noExt
+ ; return (ForeignExport { fd_e_ext = noExtField
, fd_name = name', fd_sig_ty = ty'
, fd_fe = spec }
, fvs `addOneFV` unLoc name') }
@@ -390,7 +390,7 @@ 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 _) = panic "rnHsForeignDecl"
+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
@@ -425,19 +425,19 @@ patchCCallTarget unitId callTarget =
rnSrcInstDecl :: InstDecl GhcPs -> RnM (InstDecl GhcRn, FreeVars)
rnSrcInstDecl (TyFamInstD { tfid_inst = tfi })
= do { (tfi', fvs) <- rnTyFamInstDecl NonAssocTyFamEqn tfi
- ; return (TyFamInstD { tfid_ext = noExt, tfid_inst = tfi' }, fvs) }
+ ; return (TyFamInstD { tfid_ext = noExtField, tfid_inst = tfi' }, fvs) }
rnSrcInstDecl (DataFamInstD { dfid_inst = dfi })
= do { (dfi', fvs) <- rnDataFamInstDecl NonAssocTyFamEqn dfi
- ; return (DataFamInstD { dfid_ext = noExt, dfid_inst = dfi' }, fvs) }
+ ; return (DataFamInstD { dfid_ext = noExtField, dfid_inst = dfi' }, fvs) }
rnSrcInstDecl (ClsInstD { cid_inst = cid })
= do { traceRn "rnSrcIstDecl {" (ppr cid)
; (cid', fvs) <- rnClsInstDecl cid
; traceRn "rnSrcIstDecl end }" empty
- ; return (ClsInstD { cid_d_ext = noExt, cid_inst = cid' }, fvs) }
+ ; return (ClsInstD { cid_d_ext = noExtField, cid_inst = cid' }, fvs) }
-rnSrcInstDecl (XInstDecl _) = panic "rnSrcInstDecl"
+rnSrcInstDecl (XInstDecl nec) = noExtCon nec
-- | Warn about non-canonical typeclass instance declarations
--
@@ -647,7 +647,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
; let all_fvs = meth_fvs `plusFV` more_fvs
`plusFV` inst_fvs
- ; return (ClsInstDecl { cid_ext = noExt
+ ; return (ClsInstDecl { cid_ext = noExtField
, cid_poly_ty = inst_ty', cid_binds = mbinds'
, cid_sigs = uprags', cid_tyfam_insts = ats'
, cid_overlap_mode = oflag
@@ -663,7 +663,7 @@ 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 _) = panic "rnClsInstDecl"
+rnClsInstDecl (XClsInstDecl nec) = noExtCon nec
rnFamInstEqn :: HsDocContext
-> AssocTyFamInfo
@@ -745,15 +745,15 @@ rnFamInstEqn doc atfi rhs_kvars
; return (HsIB { hsib_ext = all_imp_var_names -- Note [Wildcards in family instances]
, hsib_body
- = FamEqn { feqn_ext = noExt
+ = FamEqn { feqn_ext = noExtField
, feqn_tycon = tycon'
, feqn_bndrs = bndrs' <$ mb_bndrs
, feqn_pats = pats'
, feqn_fixity = fixity
, feqn_rhs = payload' } },
all_fvs) }
-rnFamInstEqn _ _ _ (HsIB _ (XFamEqn _)) _ = panic "rnFamInstEqn"
-rnFamInstEqn _ _ _ (XHsImplicitBndrs _) _ = panic "rnFamInstEqn"
+rnFamInstEqn _ _ _ (HsIB _ (XFamEqn nec)) _ = noExtCon nec
+rnFamInstEqn _ _ _ (XHsImplicitBndrs nec) _ = noExtCon nec
rnTyFamInstDecl :: AssocTyFamInfo
-> TyFamInstDecl GhcPs
@@ -801,8 +801,8 @@ rnTyFamInstEqn atfi ctf_info
withHsDocContext (TyFamilyCtx fam_rdr_name) $
wrongTyFamName fam_name tycon'
; pure (eqn', fvs) }
-rnTyFamInstEqn _ _ (HsIB _ (XFamEqn _)) = panic "rnTyFamInstEqn"
-rnTyFamInstEqn _ _ (XHsImplicitBndrs _) = panic "rnTyFamInstEqn"
+rnTyFamInstEqn _ _ (HsIB _ (XFamEqn nec)) = noExtCon nec
+rnTyFamInstEqn _ _ (XHsImplicitBndrs nec) = noExtCon nec
rnTyFamDefltDecl :: Name
-> TyFamDefltDecl GhcPs
@@ -819,10 +819,10 @@ 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 _)))
- = panic "rnDataFamInstDecl"
-rnDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs _))
- = panic "rnDataFamInstDecl"
+rnDataFamInstDecl _ (DataFamInstDecl (HsIB _ (XFamEqn nec)))
+ = noExtCon nec
+rnDataFamInstDecl _ (DataFamInstDecl (XHsImplicitBndrs nec))
+ = noExtCon nec
-- Renaming of the associated types in instances.
@@ -974,10 +974,10 @@ rnSrcDerivDecl (DerivDecl _ ty mds overlap)
rnAndReportFloatingViaTvs strat_tvs loc ppr_via_ty "instance" $
rnHsSigWcType BindUnlessForall DerivDeclCtx ty
; warnNoDerivStrat mds' loc
- ; return (DerivDecl noExt ty' mds' overlap, fvs) }
+ ; return (DerivDecl noExtField ty' mds' overlap, fvs) }
where
loc = getLoc $ hsib_body $ hswc_body ty
-rnSrcDerivDecl (XDerivDecl _) = panic "rnSrcDerivDecl"
+rnSrcDerivDecl (XDerivDecl nec) = noExtCon nec
standaloneDerivErr :: SDoc
standaloneDerivErr
@@ -996,10 +996,10 @@ rnHsRuleDecls :: RuleDecls GhcPs -> RnM (RuleDecls GhcRn, FreeVars)
rnHsRuleDecls (HsRules { rds_src = src
, rds_rules = rules })
= do { (rn_rules,fvs) <- rnList rnHsRuleDecl rules
- ; return (HsRules { rds_ext = noExt
+ ; return (HsRules { rds_ext = noExtField
, rds_src = src
, rds_rules = rn_rules }, fvs) }
-rnHsRuleDecls (XRuleDecls _) = panic "rnHsRuleDecls"
+rnHsRuleDecls (XRuleDecls nec) = noExtCon nec
rnHsRuleDecl :: RuleDecl GhcPs -> RnM (RuleDecl GhcRn, FreeVars)
rnHsRuleDecl (HsRule { rd_name = rule_name
@@ -1028,9 +1028,9 @@ rnHsRuleDecl (HsRule { rd_name = rule_name
where
get_var (RuleBndrSig _ v _) = v
get_var (RuleBndr _ v) = v
- get_var (XRuleBndr _) = panic "rnHsRuleDecl"
+ get_var (XRuleBndr nec) = noExtCon nec
in_rule = text "in the rule" <+> pprFullRuleName rule_name
-rnHsRuleDecl (XRuleDecl _) = panic "rnHsRuleDecl"
+rnHsRuleDecl (XRuleDecl nec) = noExtCon nec
bindRuleTmVars :: HsDocContext -> Maybe ty_bndrs
-> [LRuleBndr GhcPs] -> [Name]
@@ -1042,13 +1042,13 @@ bindRuleTmVars doc tyvs vars names thing_inside
where
go ((dL->L l (RuleBndr _ (dL->L loc _))) : vars) (n : ns) thing_inside
= go vars ns $ \ vars' ->
- thing_inside (cL l (RuleBndr noExt (cL loc n)) : vars')
+ thing_inside (cL l (RuleBndr noExtField (cL loc n)) : vars')
go ((dL->L l (RuleBndrSig _ (dL->L loc _) bsig)) : vars)
(n : ns) thing_inside
= rnHsSigWcTypeScoped bind_free_tvs doc bsig $ \ bsig' ->
go vars ns $ \ vars' ->
- thing_inside (cL l (RuleBndrSig noExt (cL loc n) bsig') : vars')
+ thing_inside (cL l (RuleBndrSig noExtField (cL loc n) bsig') : vars')
go [] [] thing_inside = thing_inside []
go vars names _ = pprPanic "bindRuleVars" (ppr vars $$ ppr names)
@@ -1305,7 +1305,7 @@ rnTyClDecls tycl_ds
first_group
| null init_inst_ds = []
- | otherwise = [TyClGroup { group_ext = noExt
+ | otherwise = [TyClGroup { group_ext = noExtField
, group_tyclds = []
, group_roles = []
, group_instds = init_inst_ds }]
@@ -1337,7 +1337,7 @@ rnTyClDecls tycl_ds
bndrs = map (tcdName . unLoc) tycl_ds
(inst_ds, inst_map') = getInsts bndrs inst_map
(roles, role_env') = getRoleAnnots bndrs role_env
- group = TyClGroup { group_ext = noExt
+ group = TyClGroup { group_ext = noExtField
, group_tyclds = tycl_ds
, group_roles = roles
, group_instds = inst_ds }
@@ -1404,8 +1404,8 @@ rnRoleAnnots tc_names role_annots
tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt tc_names)
(text "role annotation")
tycon
- ; return $ RoleAnnotDecl noExt tycon' roles }
- rn_role_annot1 (XRoleAnnotDecl _) = panic "rnRoleAnnots"
+ ; return $ RoleAnnotDecl noExtField tycon' roles }
+ rn_role_annot1 (XRoleAnnotDecl nec) = noExtCon nec
dupRoleAnnotErr :: NonEmpty (LRoleAnnotDecl GhcPs) -> RnM ()
dupRoleAnnotErr list
@@ -1523,7 +1523,7 @@ rnTyClDecl :: TyClDecl GhcPs
-- in a class decl
rnTyClDecl (FamDecl { tcdFam = decl })
= do { (decl', fvs) <- rnFamDecl Nothing decl
- ; return (FamDecl noExt decl', fvs) }
+ ; return (FamDecl noExtField decl', fvs) }
rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,
tcdFixity = fixity, tcdRhs = rhs })
@@ -1628,7 +1628,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
where
cls_doc = ClassDeclCtx lcls
-rnTyClDecl (XTyClDecl _) = panic "rnTyClDecl"
+rnTyClDecl (XTyClDecl nec) = noExtCon nec
-- Does the data type declaration include a CUSK?
dataDeclHasCUSK :: LHsQTyVars pass -> NewOrData -> Bool -> Bool -> RnM Bool
@@ -1696,7 +1696,7 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
; let all_fvs = fvs1 `plusFV` fvs3 `plusFV`
con_fvs `plusFV` sig_fvs
- ; return ( HsDataDefn { dd_ext = noExt
+ ; return ( HsDataDefn { dd_ext = noExtField
, dd_ND = new_or_data, dd_cType = cType
, dd_ctxt = context', dd_kindSig = m_sig'
, dd_cons = condecls'
@@ -1714,7 +1714,7 @@ rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
multipleDerivClausesErr
; (ds', fvs) <- mapFvRn (rnLHsDerivingClause doc) ds
; return (cL loc ds', fvs) }
-rnDataDefn _ (XHsDataDefn _) = panic "rnDataDefn"
+rnDataDefn _ (XHsDataDefn nec) = noExtCon nec
warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
-> SrcSpan
@@ -1743,14 +1743,14 @@ rnLHsDerivingClause :: HsDocContext -> LHsDerivingClause GhcPs
-> RnM (LHsDerivingClause GhcRn, FreeVars)
rnLHsDerivingClause doc
(dL->L loc (HsDerivingClause
- { deriv_clause_ext = noExt
+ { deriv_clause_ext = noExtField
, deriv_clause_strategy = dcs
, deriv_clause_tys = (dL->L loc' dct) }))
= do { (dcs', dct', fvs)
<- rnLDerivStrategy doc dcs $ \strat_tvs ppr_via_ty ->
mapFvRn (rn_deriv_ty strat_tvs ppr_via_ty) dct
; warnNoDerivStrat dcs' loc
- ; pure ( cL loc (HsDerivingClause { deriv_clause_ext = noExt
+ ; pure ( cL loc (HsDerivingClause { deriv_clause_ext = noExtField
, deriv_clause_strategy = dcs'
, deriv_clause_tys = cL loc' dct' })
, fvs ) }
@@ -1760,9 +1760,9 @@ rnLHsDerivingClause doc
rn_deriv_ty strat_tvs ppr_via_ty deriv_ty@(HsIB {hsib_body = dL->L loc _}) =
rnAndReportFloatingViaTvs strat_tvs loc ppr_via_ty "class" $
rnHsSigType doc deriv_ty
- rn_deriv_ty _ _ (XHsImplicitBndrs _) = panic "rn_deriv_ty"
-rnLHsDerivingClause _ (dL->L _ (XHsDerivingClause _))
- = panic "rnLHsDerivingClause"
+ rn_deriv_ty _ _ (XHsImplicitBndrs nec) = noExtCon nec
+rnLHsDerivingClause _ (dL->L _ (XHsDerivingClause nec))
+ = noExtCon nec
rnLHsDerivingClause _ _ = panic "rnLHsDerivingClause: Impossible Match"
-- due to #15884
@@ -1905,7 +1905,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
injectivity
; return ( (tyvars', res_sig', injectivity') , fv_kind ) }
; (info', fv2) <- rn_info tycon' info
- ; return (FamilyDecl { fdExt = noExt
+ ; return (FamilyDecl { fdExt = noExtField
, fdLName = tycon', fdTyVars = tyvars'
, fdFixity = fixity
, fdInfo = info', fdResultSig = res_sig'
@@ -1928,16 +1928,16 @@ 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 _) = panic "rnFamDecl"
+rnFamDecl _ (XFamilyDecl nec) = noExtCon nec
rnFamResultSig :: HsDocContext
-> FamilyResultSig GhcPs
-> RnM (FamilyResultSig GhcRn, FreeVars)
rnFamResultSig _ (NoSig _)
- = return (NoSig noExt, emptyFVs)
+ = return (NoSig noExtField, emptyFVs)
rnFamResultSig doc (KindSig _ kind)
= do { (rndKind, ftvs) <- rnLHsKind doc kind
- ; return (KindSig noExt rndKind, ftvs) }
+ ; return (KindSig noExtField rndKind, ftvs) }
rnFamResultSig doc (TyVarSig _ tvbndr)
= do { -- `TyVarSig` tells us that user named the result of a type family by
-- writing `= tyvar` or `= (tyvar :: kind)`. In such case we want to
@@ -1959,8 +1959,8 @@ rnFamResultSig doc (TyVarSig _ tvbndr)
; bindLHsTyVarBndr doc Nothing -- This might be a lie, but it's used for
-- scoping checks that are irrelevant here
tvbndr $ \ tvbndr' ->
- return (TyVarSig noExt tvbndr', unitFV (hsLTyVarName tvbndr')) }
-rnFamResultSig _ (XFamilyResultSig _) = panic "rnFamResultSig"
+ return (TyVarSig noExtField tvbndr', unitFV (hsLTyVarName tvbndr')) }
+rnFamResultSig _ (XFamilyResultSig nec) = noExtCon nec
-- Note [Renaming injectivity annotation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2111,7 +2111,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
[ text "ex_tvs:" <+> ppr ex_tvs
, text "new_ex_dqtvs':" <+> ppr new_ex_tvs ])
- ; return (decl { con_ext = noExt
+ ; return (decl { con_ext = noExtField
, con_name = new_name, con_ex_tvs = new_ex_tvs
, con_mb_cxt = new_context, con_args = new_args
, con_doc = mb_doc' },
@@ -2164,13 +2164,13 @@ rnConDecl decl@(ConDeclGADT { con_names = names
, hsq_explicit = explicit_tkvs }
; traceRn "rnConDecl2" (ppr names $$ ppr implicit_tkvs $$ ppr explicit_tkvs)
- ; return (decl { con_g_ext = noExt, con_names = new_names
+ ; return (decl { con_g_ext = noExtField, con_names = new_names
, con_qvars = new_qtvs, con_mb_cxt = new_cxt
, con_args = args', con_res_ty = res_ty'
, con_doc = mb_doc' },
all_fvs) } }
-rnConDecl (XConDecl _) = panic "rnConDecl"
+rnConDecl (XConDecl nec) = noExtCon nec
rnMbContext :: HsDocContext -> Maybe (LHsContext GhcPs)
@@ -2232,7 +2232,7 @@ extendPatSynEnv val_decls local_fix_env thing = do {
bnd_name <- newTopSrcBinder (cL bind_loc n)
let rnames = map recordPatSynSelectorId as
mkFieldOcc :: Located RdrName -> LFieldOcc GhcPs
- mkFieldOcc (dL->L l name) = cL l (FieldOcc noExt (cL l name))
+ mkFieldOcc (dL->L l name) = cL l (FieldOcc noExtField (cL l name))
field_occs = map mkFieldOcc rnames
flds <- mapM (newRecordSelector False [bnd_name]) field_occs
return ((bnd_name, flds): names)
@@ -2365,13 +2365,13 @@ add gp@(HsGroup {hs_ruleds = ts}) l (RuleD _ d) ds
= addl (gp { hs_ruleds = cL l d : ts }) ds
add gp l (DocD _ d) ds
= addl (gp { hs_docs = (cL l d) : (hs_docs gp) }) ds
-add (HsGroup {}) _ (SpliceD _ (XSpliceDecl _)) _ = panic "RnSource.add"
-add (HsGroup {}) _ (XHsDecl _) _ = panic "RnSource.add"
-add (XHsGroup _) _ _ _ = panic "RnSource.add"
+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)]
-add_tycld d [] = [TyClGroup { group_ext = noExt
+add_tycld d [] = [TyClGroup { group_ext = noExtField
, group_tyclds = [d]
, group_roles = []
, group_instds = []
@@ -2379,11 +2379,11 @@ add_tycld d [] = [TyClGroup { group_ext = noExt
]
add_tycld d (ds@(TyClGroup { group_tyclds = tyclds }):dss)
= ds { group_tyclds = d : tyclds } : dss
-add_tycld _ (XTyClGroup _: _) = panic "add_tycld"
+add_tycld _ (XTyClGroup nec: _) = noExtCon nec
add_instd :: LInstDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
-add_instd d [] = [TyClGroup { group_ext = noExt
+add_instd d [] = [TyClGroup { group_ext = noExtField
, group_tyclds = []
, group_roles = []
, group_instds = [d]
@@ -2391,11 +2391,11 @@ add_instd d [] = [TyClGroup { group_ext = noExt
]
add_instd d (ds@(TyClGroup { group_instds = instds }):dss)
= ds { group_instds = d : instds } : dss
-add_instd _ (XTyClGroup _: _) = panic "add_instd"
+add_instd _ (XTyClGroup nec: _) = noExtCon nec
add_role_annot :: LRoleAnnotDecl (GhcPass p) -> [TyClGroup (GhcPass p)]
-> [TyClGroup (GhcPass p)]
-add_role_annot d [] = [TyClGroup { group_ext = noExt
+add_role_annot d [] = [TyClGroup { group_ext = noExtField
, group_tyclds = []
, group_roles = [d]
, group_instds = []
@@ -2403,7 +2403,7 @@ add_role_annot d [] = [TyClGroup { group_ext = noExt
]
add_role_annot d (tycls@(TyClGroup { group_roles = roles }) : rest)
= tycls { group_roles = d : roles } : rest
-add_role_annot _ (XTyClGroup _: _) = panic "add_role_annot"
+add_role_annot _ (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/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index 5766080fef..9c3e317958 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -104,7 +104,7 @@ rnBracket e br_body
; (body', fvs_e) <-
setStage (Brack cur_stage RnPendingTyped) $
rn_bracket cur_stage br_body
- ; return (HsBracket noExt body', fvs_e) }
+ ; return (HsBracket noExtField body', fvs_e) }
False -> do { traceRn "Renaming untyped TH bracket" empty
; ps_var <- newMutVar []
@@ -112,7 +112,7 @@ rnBracket e br_body
setStage (Brack cur_stage (RnPendingUntyped ps_var)) $
rn_bracket cur_stage br_body
; pendings <- readMutVar ps_var
- ; return (HsRnBracketOut noExt body' pendings, fvs_e) }
+ ; return (HsRnBracketOut noExtField body' pendings, fvs_e) }
}
rn_bracket :: ThStage -> HsBracket GhcPs -> RnM (HsBracket GhcRn, FreeVars)
@@ -180,7 +180,7 @@ 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 {}) = panic "rn_bracket: unexpected XBracket"
+rn_bracket _ (XBracket nec) = noExtCon nec
quotationCtxtDoc :: HsBracket GhcPs -> SDoc
quotationCtxtDoc br_body
@@ -303,7 +303,7 @@ runRnSplice flavour run_meta ppr_res splice
HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice)
HsSpliced {} -> pprPanic "runRnSplice" (ppr splice)
HsSplicedT {} -> pprPanic "runRnSplice" (ppr splice)
- XSplice {} -> pprPanic "runRnSplice" (ppr splice)
+ XSplice nec -> noExtCon nec
-- Typecheck the expression
; meta_exp_ty <- tcMetaTy meta_ty_name
@@ -352,8 +352,8 @@ makePending _ splice@(HsSpliced {})
= pprPanic "makePending" (ppr splice)
makePending _ splice@(HsSplicedT {})
= pprPanic "makePending" (ppr splice)
-makePending _ splice@(XSplice {})
- = pprPanic "makePending" (ppr splice)
+makePending _ (XSplice nec)
+ = noExtCon nec
------------------
mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
@@ -361,13 +361,13 @@ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString
-- Return the expression (quoter "...quote...")
-- which is what we must run in a quasi-quote
mkQuasiQuoteExpr flavour quoter q_span quote
- = cL q_span $ HsApp noExt (cL q_span
- $ HsApp noExt (cL q_span (HsVar noExt (cL q_span quote_selector)))
- quoterExpr)
+ = cL q_span $ HsApp noExtField (cL q_span
+ $ HsApp noExtField (cL q_span (HsVar noExtField (cL q_span quote_selector)))
+ quoterExpr)
quoteExpr
where
- quoterExpr = cL q_span $! HsVar noExt $! (cL q_span quoter)
- quoteExpr = cL q_span $! HsLit noExt $! HsString NoSourceText quote
+ quoterExpr = cL q_span $! HsVar noExtField $! (cL q_span quoter)
+ quoteExpr = cL q_span $! HsLit noExtField $! HsString NoSourceText quote
quote_selector = case flavour of
UntypedExpSplice -> quoteExpName
UntypedPatSplice -> quotePatName
@@ -404,7 +404,7 @@ rnSplice (HsQuasiQuote x splice_name quoter q_loc quote)
rnSplice splice@(HsSpliced {}) = pprPanic "rnSplice" (ppr splice)
rnSplice splice@(HsSplicedT {}) = pprPanic "rnSplice" (ppr splice)
-rnSplice splice@(XSplice {}) = pprPanic "rnSplice" (ppr splice)
+rnSplice (XSplice nec) = noExtCon nec
---------------------
rnSpliceExpr :: HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
@@ -413,7 +413,7 @@ rnSpliceExpr splice
where
pend_expr_splice :: HsSplice GhcRn -> (PendingRnSplice, HsExpr GhcRn)
pend_expr_splice rn_splice
- = (makePending UntypedExpSplice rn_splice, HsSpliceE noExt rn_splice)
+ = (makePending UntypedExpSplice rn_splice, HsSpliceE noExtField rn_splice)
run_expr_splice :: HsSplice GhcRn -> RnM (HsExpr GhcRn, FreeVars)
run_expr_splice rn_splice
@@ -426,7 +426,7 @@ rnSpliceExpr splice
, isLocalGRE gre]
lcl_names = mkNameSet (localRdrEnvElts lcl_rdr)
- ; return (HsSpliceE noExt rn_splice, lcl_names `plusFV` gbl_names) }
+ ; return (HsSpliceE noExtField rn_splice, lcl_names `plusFV` gbl_names) }
| otherwise -- Run it here, see Note [Running splices in the Renamer]
= do { traceRn "rnSpliceExpr: untyped expression splice" empty
@@ -434,8 +434,8 @@ rnSpliceExpr splice
runRnSplice UntypedExpSplice runMetaE ppr rn_splice
; (lexpr3, fvs) <- checkNoErrs (rnLExpr rn_expr)
-- See Note [Delaying modFinalizers in untyped splices].
- ; return ( HsPar noExt $ HsSpliceE noExt
- . HsSpliced noExt (ThModFinalizers mod_finalizers)
+ ; return ( HsPar noExtField $ HsSpliceE noExtField
+ . HsSpliced noExtField (ThModFinalizers mod_finalizers)
. HsSplicedExpr <$>
lexpr3
, fvs)
@@ -538,7 +538,7 @@ rnSpliceType splice
where
pend_type_splice rn_splice
= ( makePending UntypedTypeSplice rn_splice
- , HsSpliceTy noExt rn_splice)
+ , HsSpliceTy noExtField rn_splice)
run_type_splice rn_splice
= do { traceRn "rnSpliceType: untyped type splice" empty
@@ -548,8 +548,9 @@ rnSpliceType splice
; checkNoErrs $ rnLHsType doc hs_ty2 }
-- checkNoErrs: see Note [Renamer errors]
-- See Note [Delaying modFinalizers in untyped splices].
- ; return ( HsParTy noExt $ HsSpliceTy noExt
- . HsSpliced noExt (ThModFinalizers mod_finalizers)
+ ; return ( HsParTy noExtField
+ $ HsSpliceTy noExtField
+ . HsSpliced noExtField (ThModFinalizers mod_finalizers)
. HsSplicedTy <$>
hs_ty3
, fvs
@@ -608,7 +609,7 @@ rnSplicePat splice
(PendingRnSplice, Either b (Pat GhcRn))
pend_pat_splice rn_splice
= (makePending UntypedPatSplice rn_splice
- , Right (SplicePat noExt rn_splice))
+ , Right (SplicePat noExtField rn_splice))
run_pat_splice :: HsSplice GhcRn ->
RnM (Either (Pat GhcPs) (Pat GhcRn), FreeVars)
@@ -617,8 +618,8 @@ rnSplicePat splice
; (pat, mod_finalizers) <-
runRnSplice UntypedPatSplice runMetaP ppr rn_splice
-- See Note [Delaying modFinalizers in untyped splices].
- ; return ( Left $ ParPat noExt $ ((SplicePat noExt)
- . HsSpliced noExt (ThModFinalizers mod_finalizers)
+ ; return ( Left $ ParPat noExtField $ ((SplicePat noExtField)
+ . HsSpliced noExtField (ThModFinalizers mod_finalizers)
. HsSplicedPat) `onHasSrcSpan`
pat
, emptyFVs
@@ -633,10 +634,10 @@ rnSpliceDecl (SpliceDecl _ (dL->L loc splice) flg)
where
pend_decl_splice rn_splice
= ( makePending UntypedDeclSplice rn_splice
- , SpliceDecl noExt (cL loc rn_splice) flg)
+ , SpliceDecl noExtField (cL loc rn_splice) flg)
- run_decl_splice rn_splice = pprPanic "rnSpliceDecl" (ppr rn_splice)
-rnSpliceDecl (XSpliceDecl _) = panic "rnSpliceDecl"
+ 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
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 4b4d519324..80b03d3f25 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -137,10 +137,10 @@ 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 _)) _
- = panic "rn_hs_sig_wc_type"
-rn_hs_sig_wc_type _ _ (XHsWildCardBndrs _) _
- = panic "rn_hs_sig_wc_type"
+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 +149,7 @@ 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 _) = panic "rnHsWcType"
+rnHsWcType _ (XHsWildCardBndrs nec) = noExtCon nec
rnWcBody :: HsDocContext -> [Located RdrName] -> LHsType GhcPs
-> RnM ([Name], LHsType GhcRn, FreeVars)
@@ -174,7 +174,7 @@ rnWcBody ctxt nwc_rdrs hs_ty
, hst_body = hs_body })
= bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc hs_ty) Nothing tvs $ \ tvs' ->
do { (hs_body', fvs) <- rn_lty env hs_body
- ; return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExt
+ ; return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField
, hst_bndrs = tvs', hst_body = hs_body' }
, fvs) }
@@ -184,16 +184,16 @@ rnWcBody ctxt nwc_rdrs hs_ty
, (dL->L lx (HsWildCardTy _)) <- ignoreParens hs_ctxt_last
= do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1
; setSrcSpan lx $ checkExtraConstraintWildCard env hs_ctxt1
- ; let hs_ctxt' = hs_ctxt1' ++ [cL lx (HsWildCardTy noExt)]
+ ; let hs_ctxt' = hs_ctxt1' ++ [cL lx (HsWildCardTy noExtField)]
; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
- ; return (HsQualTy { hst_xqual = noExt
+ ; return (HsQualTy { hst_xqual = noExtField
, hst_ctxt = cL cx hs_ctxt', hst_body = hs_ty' }
, fvs1 `plusFV` fvs2) }
| otherwise
= do { (hs_ctxt', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt
; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
- ; return (HsQualTy { hst_xqual = noExt
+ ; return (HsQualTy { hst_xqual = noExtField
, hst_ctxt = cL cx hs_ctxt'
, hst_body = hs_ty' }
, fvs1 `plusFV` fvs2) }
@@ -307,7 +307,7 @@ rnHsSigType ctx (HsIB { hsib_body = hs_ty })
; return ( HsIB { hsib_ext = vars
, hsib_body = body' }
, fvs ) } }
-rnHsSigType _ (XHsImplicitBndrs _) = panic "rnHsSigType"
+rnHsSigType _ (XHsImplicitBndrs nec) = noExtCon nec
rnImplicitBndrs :: Bool -- True <=> bring into scope any free type variables
-- E.g. f :: forall a. a->b
@@ -487,7 +487,7 @@ rnHsTyKi env ty@(HsForAllTy { hst_fvf = fvf, hst_bndrs = tyvars
; bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc ty)
Nothing tyvars $ \ tyvars' ->
do { (tau', fvs) <- rnLHsTyKi env tau
- ; return ( HsForAllTy { hst_fvf = fvf, hst_xforall = noExt
+ ; return ( HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField
, hst_bndrs = tyvars' , hst_body = tau' }
, fvs) } }
@@ -495,7 +495,7 @@ rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })
= do { checkPolyKinds env ty -- See Note [QualTy in kinds]
; (ctxt', fvs1) <- rnTyKiContext env lctxt
; (tau', fvs2) <- rnLHsTyKi env tau
- ; return (HsQualTy { hst_xqual = noExt, hst_ctxt = ctxt'
+ ; return (HsQualTy { hst_xqual = noExtField, hst_ctxt = ctxt'
, hst_body = tau' }
, fvs1 `plusFV` fvs2) }
@@ -508,7 +508,7 @@ rnHsTyKi env (HsTyVar _ ip (dL->L loc rdr_name))
-- Any type variable at the kind level is illegal without the use
-- of PolyKinds (see #14710)
; name <- rnTyVar env rdr_name
- ; return (HsTyVar noExt ip (cL loc name), unitFV name) }
+ ; return (HsTyVar noExtField ip (cL loc name), unitFV name) }
rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2)
= setSrcSpan (getLoc l_op) $
@@ -516,23 +516,23 @@ rnHsTyKi env ty@(HsOpTy _ ty1 l_op ty2)
; fix <- lookupTyFixityRn l_op'
; (ty1', fvs2) <- rnLHsTyKi env ty1
; (ty2', fvs3) <- rnLHsTyKi env ty2
- ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExt t1 l_op' t2)
+ ; res_ty <- mkHsOpTyRn (\t1 t2 -> HsOpTy noExtField t1 l_op' t2)
(unLoc l_op') fix ty1' ty2'
; return (res_ty, plusFVs [fvs1, fvs2, fvs3]) }
rnHsTyKi env (HsParTy _ ty)
= do { (ty', fvs) <- rnLHsTyKi env ty
- ; return (HsParTy noExt ty', fvs) }
+ ; return (HsParTy noExtField ty', fvs) }
rnHsTyKi env (HsBangTy _ b ty)
= do { (ty', fvs) <- rnLHsTyKi env ty
- ; return (HsBangTy noExt b ty', fvs) }
+ ; return (HsBangTy noExtField b ty', fvs) }
rnHsTyKi env ty@(HsRecTy _ flds)
= do { let ctxt = rtke_ctxt env
; fls <- get_fields ctxt
; (flds', fvs) <- rnConDeclFields ctxt fls flds
- ; return (HsRecTy noExt flds', fvs) }
+ ; return (HsRecTy noExtField flds', fvs) }
where
get_fields (ConDeclCtx names)
= concatMapM (lookupConstructorFields . unLoc) names
@@ -549,7 +549,7 @@ rnHsTyKi env (HsFunTy _ ty1 ty2)
-- when we find return :: forall m. Monad m -> forall a. a -> m a
-- Check for fixity rearrangements
- ; res_ty <- mkHsOpTyRn (HsFunTy noExt) funTyConName funTyFixity ty1' ty2'
+ ; res_ty <- mkHsOpTyRn (HsFunTy noExtField) funTyConName funTyFixity ty1' ty2'
; return (res_ty, fvs1 `plusFV` fvs2) }
rnHsTyKi env listTy@(HsListTy _ ty)
@@ -557,7 +557,7 @@ rnHsTyKi env listTy@(HsListTy _ ty)
; when (not data_kinds && isRnKindLevel env)
(addErr (dataKindsErr env listTy))
; (ty', fvs) <- rnLHsTyKi env ty
- ; return (HsListTy noExt ty', fvs) }
+ ; return (HsListTy noExtField ty', fvs) }
rnHsTyKi env t@(HsKindSig _ ty k)
= do { checkPolyKinds env t
@@ -565,7 +565,7 @@ rnHsTyKi env t@(HsKindSig _ ty k)
; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty)
; (ty', fvs1) <- rnLHsTyKi env ty
; (k', fvs2) <- rnLHsTyKi (env { rtke_level = KindLevel }) k
- ; return (HsKindSig noExt ty' k', fvs1 `plusFV` fvs2) }
+ ; return (HsKindSig noExtField ty' k', fvs1 `plusFV` fvs2) }
-- Unboxed tuples are allowed to have poly-typed arguments. These
-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
@@ -574,14 +574,14 @@ rnHsTyKi env tupleTy@(HsTupleTy _ tup_con tys)
; when (not data_kinds && isRnKindLevel env)
(addErr (dataKindsErr env tupleTy))
; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
- ; return (HsTupleTy noExt tup_con tys', fvs) }
+ ; return (HsTupleTy noExtField tup_con tys', fvs) }
rnHsTyKi env sumTy@(HsSumTy _ tys)
= do { data_kinds <- xoptM LangExt.DataKinds
; when (not data_kinds && isRnKindLevel env)
(addErr (dataKindsErr env sumTy))
; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
- ; return (HsSumTy noExt tys', fvs) }
+ ; return (HsSumTy noExtField tys', fvs) }
-- Ensure that a type-level integer is nonnegative (#8306, #8412)
rnHsTyKi env tyLit@(HsTyLit _ t)
@@ -589,7 +589,7 @@ rnHsTyKi env tyLit@(HsTyLit _ t)
; unless data_kinds (addErr (dataKindsErr env tyLit))
; when (negLit t) (addErr negLitErr)
; checkPolyKinds env tyLit
- ; return (HsTyLit noExt t, emptyFVs) }
+ ; return (HsTyLit noExtField t, emptyFVs) }
where
negLit (HsStrTy _ _) = False
negLit (HsNumTy _ i) = i < 0
@@ -598,7 +598,7 @@ rnHsTyKi env tyLit@(HsTyLit _ t)
rnHsTyKi env (HsAppTy _ ty1 ty2)
= do { (ty1', fvs1) <- rnLHsTyKi env ty1
; (ty2', fvs2) <- rnLHsTyKi env ty2
- ; return (HsAppTy noExt ty1' ty2', fvs1 `plusFV` fvs2) }
+ ; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) }
rnHsTyKi env (HsAppKindTy l ty k)
= do { kind_app <- xoptM LangExt.TypeApplications
@@ -610,10 +610,10 @@ rnHsTyKi env (HsAppKindTy l ty k)
rnHsTyKi env t@(HsIParamTy _ n ty)
= do { notInKinds env t
; (ty', fvs) <- rnLHsTyKi env ty
- ; return (HsIParamTy noExt n ty', fvs) }
+ ; return (HsIParamTy noExtField n ty', fvs) }
rnHsTyKi _ (HsStarTy _ isUni)
- = return (HsStarTy noExt isUni, emptyFVs)
+ = return (HsStarTy noExtField isUni, emptyFVs)
rnHsTyKi _ (HsSpliceTy _ sp)
= rnSpliceType sp
@@ -621,7 +621,7 @@ rnHsTyKi _ (HsSpliceTy _ sp)
rnHsTyKi env (HsDocTy _ ty haddock_doc)
= do { (ty', fvs) <- rnLHsTyKi env ty
; haddock_doc' <- rnLHsDoc haddock_doc
- ; return (HsDocTy noExt ty' haddock_doc', fvs) }
+ ; return (HsDocTy noExtField ty' haddock_doc', fvs) }
rnHsTyKi _ (XHsType (NHsCoreTy ty))
= return (XHsType (NHsCoreTy ty), emptyFVs)
@@ -633,18 +633,18 @@ rnHsTyKi env ty@(HsExplicitListTy _ ip tys)
; data_kinds <- xoptM LangExt.DataKinds
; unless data_kinds (addErr (dataKindsErr env ty))
; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
- ; return (HsExplicitListTy noExt ip tys', fvs) }
+ ; return (HsExplicitListTy noExtField ip tys', fvs) }
rnHsTyKi env ty@(HsExplicitTupleTy _ tys)
= do { checkPolyKinds env ty
; data_kinds <- xoptM LangExt.DataKinds
; unless data_kinds (addErr (dataKindsErr env ty))
; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
- ; return (HsExplicitTupleTy noExt tys', fvs) }
+ ; return (HsExplicitTupleTy noExtField tys', fvs) }
rnHsTyKi env (HsWildCardTy _)
= do { checkAnonWildCard env
- ; return (HsWildCardTy noExt, emptyFVs) }
+ ; return (HsWildCardTy noExtField, emptyFVs) }
--------------
rnTyVar :: RnTyKiEnv -> RdrName -> RnM Name
@@ -1000,7 +1000,7 @@ bindLHsTyVarBndr doc mb_assoc (dL->L loc (KindedTyVar x lrdr@(dL->L lv _) kind))
$ thing_inside (cL loc (KindedTyVar x (cL lv tv_nm) kind'))
; return (b, fvs1 `plusFV` fvs2) }
-bindLHsTyVarBndr _ _ (dL->L _ (XTyVarBndr{})) _ = panic "bindLHsTyVarBndr"
+bindLHsTyVarBndr _ _ (dL->L _ (XTyVarBndr nec)) _ = noExtCon nec
bindLHsTyVarBndr _ _ _ _ = panic "bindLHsTyVarBndr: Impossible Match"
-- due to #15884
@@ -1042,7 +1042,7 @@ rnField fl_env env (dL->L l (ConDeclField _ names ty haddock_doc))
= do { let new_names = map (fmap lookupField) names
; (new_ty, fvs) <- rnLHsTyKi env ty
; new_haddock_doc <- rnMbLHsDoc haddock_doc
- ; return (cL l (ConDeclField noExt new_names new_ty new_haddock_doc)
+ ; return (cL l (ConDeclField noExtField new_names new_ty new_haddock_doc)
, fvs) }
where
lookupField :: FieldOcc GhcPs -> FieldOcc GhcRn
@@ -1051,8 +1051,8 @@ rnField fl_env env (dL->L l (ConDeclField _ names ty haddock_doc))
where
lbl = occNameFS $ rdrNameOcc rdr
fl = expectJust "rnField" $ lookupFsEnv fl_env lbl
- lookupField (XFieldOcc{}) = panic "rnField"
-rnField _ _ (dL->L _ (XConDeclField _)) = panic "rnField"
+ lookupField (XFieldOcc nec) = noExtCon nec
+rnField _ _ (dL->L _ (XConDeclField nec)) = noExtCon nec
rnField _ _ _ = panic "rnField: Impossible Match"
-- due to #15884
@@ -1088,15 +1088,15 @@ mkHsOpTyRn :: (LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn)
-> Name -> Fixity -> LHsType GhcRn -> LHsType GhcRn
-> RnM (HsType GhcRn)
-mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsOpTy noExt ty21 op2 ty22))
+mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsOpTy noExtField ty21 op2 ty22))
= do { fix2 <- lookupTyFixityRn op2
; mk_hs_op_ty mk1 pp_op1 fix1 ty1
- (\t1 t2 -> HsOpTy noExt t1 op2 t2)
+ (\t1 t2 -> HsOpTy noExtField t1 op2 t2)
(unLoc op2) fix2 ty21 ty22 loc2 }
mkHsOpTyRn mk1 pp_op1 fix1 ty1 (dL->L loc2 (HsFunTy _ ty21 ty22))
= mk_hs_op_ty mk1 pp_op1 fix1 ty1
- (HsFunTy noExt) funTyConName funTyFixity ty21 ty22 loc2
+ (HsFunTy noExtField) funTyConName funTyFixity ty21 ty22 loc2
mkHsOpTyRn mk1 _ _ ty1 ty2 -- Default case, no rearrangment
= return (mk1 ty1 ty2)
@@ -1148,7 +1148,7 @@ mkOpAppRn e1@(dL->L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2
| associate_right
= do new_e <- mkOpAppRn neg_arg op2 fix2 e2
- return (NegApp noExt (cL loc' new_e) neg_name)
+ return (NegApp noExtField (cL loc' new_e) neg_name)
where
loc' = combineLocs neg_arg e2
(nofix_error, associate_right) = compareFixity negateFixity fix2
@@ -1210,7 +1210,7 @@ mkNegAppRn :: LHsExpr (GhcPass id) -> SyntaxExpr (GhcPass id)
-> RnM (HsExpr (GhcPass id))
mkNegAppRn neg_arg neg_name
= ASSERT( not_op_app (unLoc neg_arg) )
- return (NegApp noExt neg_arg neg_name)
+ return (NegApp noExtField neg_arg neg_name)
not_op_app :: HsExpr id -> Bool
not_op_app (OpApp {}) = False
@@ -1234,7 +1234,7 @@ mkOpFormRn a1@(dL->L loc
| associate_right
= do new_c <- mkOpFormRn a12 op2 fix2 a2
- return (HsCmdArrForm noExt op1 f (Just fix1)
+ return (HsCmdArrForm noExtField op1 f (Just fix1)
[a11, cL loc (HsCmdTop [] (cL loc new_c))])
-- TODO: locs are wrong
where
@@ -1242,7 +1242,7 @@ mkOpFormRn a1@(dL->L loc
-- Default case
mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
- = return (HsCmdArrForm noExt op Infix (Just fix) [arg1, arg2])
+ = return (HsCmdArrForm noExtField op Infix (Just fix) [arg1, arg2])
--------------------------------------
@@ -1296,7 +1296,7 @@ checkPrecMatch op (MG { mg_alts = (dL->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 {}) = panic "checkPrecMatch"
+checkPrecMatch _ (XMatchGroup nec) = noExtCon nec
checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
@@ -1677,7 +1677,7 @@ extractRdrKindSigVars (dL->L _ resultSig)
extractDataDefnKindVars :: HsDataDefn GhcPs -> FreeKiTyVarsNoDups
extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig })
= maybe [] extractHsTyRdrTyVars ksig
-extractDataDefnKindVars (XHsDataDefn _) = panic "extractDataDefnKindVars"
+extractDataDefnKindVars (XHsDataDefn nec) = noExtCon nec
extract_lctxt :: LHsContext GhcPs
-> FreeKiTyVarsWithDups -> FreeKiTyVarsWithDups
View Lorry Controller Status