diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index d30cb95515ced395ddcb3170916a72798e309a6f..4a5d978370e8cdd20d48c8f4c7d77e0a796d3aca 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -375,12 +375,12 @@ checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do
let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss)
dsMatchContext = DsMatchContext hs_ctx combinedLoc
match = cL combinedLoc $
- Match { m_ext = noExt
+ Match { m_ext = noExtField
, m_ctxt = hs_ctx
, m_pats = []
, m_grhss = guards }
checkMatches dflags dsMatchContext [] [match]
-checkGuardMatches _ (XGRHSs _) = panic "checkGuardMatches"
+checkGuardMatches _ (XGRHSs nec) = noExtCon nec
-- | Check a matchgroup (case, functions, etc.)
checkMatches :: DynFlags -> DsMatchContext
@@ -1008,7 +1008,7 @@ translatePat fam_insts pat = case pat of
case res of
True -> do
(xp,xe) <- mkPmId2Forms arg_ty
- g <- mkGuard ps (HsApp noExt lexpr xe)
+ g <- mkGuard ps (HsApp noExtField lexpr xe)
return [xp,g]
False -> mkCanFailPmPat arg_ty
@@ -1066,7 +1066,7 @@ translatePat fam_insts pat = case pat of
, isStringTy ty ->
foldr (mkListPatVec charTy) [nilPattern charTy] <$>
translatePatVec fam_insts
- (map (LitPat noExt . HsChar src) (unpackFS s))
+ (map (LitPat noExtField . HsChar src) (unpackFS s))
| otherwise -> return [PmLit { pm_lit_lit = PmOLit (isJust mb_neg) olit }]
-- See Note [Translate Overloaded Literal for Exhaustiveness Checking]
@@ -1074,7 +1074,7 @@ translatePat fam_insts pat = case pat of
| HsString src s <- lit ->
foldr (mkListPatVec charTy) [nilPattern charTy] <$>
translatePatVec fam_insts
- (map (LitPat noExt . HsChar src) (unpackFS s))
+ (map (LitPat noExtField . HsChar src) (unpackFS s))
| otherwise -> return [mkLitPattern lit]
TuplePat tys ps boxity -> do
@@ -1312,7 +1312,7 @@ translateGuard fam_insts guard = case guard of
TransStmt {} -> panic "translateGuard TransStmt"
RecStmt {} -> panic "translateGuard RecStmt"
ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt"
- XStmtLR {} -> panic "translateGuard RecStmt"
+ XStmtLR nec -> noExtCon nec
-- | Translate let-bindings
translateLet :: HsLocalBinds GhcTc -> DsM PatVec
@@ -1713,7 +1713,7 @@ mkPmId ty = getUniqueM >>= \unique ->
mkPmId2Forms :: Type -> DsM (Pattern, LHsExpr GhcTc)
mkPmId2Forms ty = do
x <- mkPmId ty
- return (PmVar x, noLoc (HsVar noExt (noLoc x)))
+ return (PmVar x, noLoc (HsVar noExtField (noLoc x)))
-- ----------------------------------------------------------------------------
-- * Converting between Value Abstractions, Patterns and PmExpr
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 59b8bcfc7884f0f90ded6aff9508fd15eb200f0a..ce902f49706e4367c871ac49826562590bf4b0eb 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -327,7 +327,7 @@ addTickLHsBind (dL->L pos (funBind@(FunBind { fun_id = (dL->L _ id) }))) = do
where
-- a binding is a simple pattern binding if it is a funbind with
-- zero patterns
- isSimplePatBind :: HsBind a -> Bool
+ isSimplePatBind :: HsBind GhcTc -> Bool
isSimplePatBind funBind = matchGroupArity (fun_matches funBind) == 0
-- TODO: Revisit this
@@ -640,7 +640,7 @@ addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
addTickTupArg (dL->L l (Present x e)) = do { e' <- addTickLHsExpr e
; return (cL l (Present x e')) }
addTickTupArg (dL->L l (Missing ty)) = return (cL l (Missing ty))
-addTickTupArg (dL->L _ (XTupArg _)) = panic "addTickTupArg"
+addTickTupArg (dL->L _ (XTupArg nec)) = noExtCon nec
addTickTupArg _ = panic "addTickTupArg: Impossible Match" -- due to #15884
@@ -650,7 +650,7 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = dL->L l matches }) = do
let isOneOfMany = matchesOneOfMany matches
matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches
return $ mg { mg_alts = cL l matches' }
-addTickMatchGroup _ (XMatchGroup _) = panic "addTickMatchGroup"
+addTickMatchGroup _ (XMatchGroup nec) = noExtCon nec
addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
-> TM (Match GhcTc (LHsExpr GhcTc))
@@ -659,7 +659,7 @@ addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats
bindLocals (collectPatsBinders pats) $ do
gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
return $ match { m_grhss = gRHSs' }
-addTickMatch _ _ (XMatch _) = panic "addTickMatch"
+addTickMatch _ _ (XMatch nec) = noExtCon nec
addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
-> TM (GRHSs GhcTc (LHsExpr GhcTc))
@@ -670,7 +670,7 @@ addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (dL->L l local_binds)) = do
return $ GRHSs x guarded' (cL l local_binds')
where
binders = collectLocalBinders local_binds
-addTickGRHSs _ _ (XGRHSs _) = panic "addTickGRHSs"
+addTickGRHSs _ _ (XGRHSs nec) = noExtCon nec
addTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
-> TM (GRHS GhcTc (LHsExpr GhcTc))
@@ -678,7 +678,7 @@ addTickGRHS isOneOfMany isLambda (GRHS x stmts expr) = do
(stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox) stmts
(addTickGRHSBody isOneOfMany isLambda expr)
return $ GRHS x stmts' expr'
-addTickGRHS _ _ (XGRHS _) = panic "addTickGRHS"
+addTickGRHS _ _ (XGRHS nec) = noExtCon nec
addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
addTickGRHSBody isOneOfMany isLambda expr@(dL->L pos e0) = do
@@ -757,7 +757,7 @@ addTickStmt isGuard stmt@(RecStmt {})
; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
, recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
-addTickStmt _ (XStmtLR _) = panic "addTickStmt"
+addTickStmt _ (XStmtLR nec) = noExtCon nec
addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
@@ -779,7 +779,7 @@ addTickApplicativeArg isGuard (op, arg) =
<$> addTickLStmts isGuard stmts
<*> (unLoc <$> addTickLHsExpr (cL hpcSrcSpan ret))
<*> addTickLPat pat
- addTickArg (XApplicativeArg _) = panic "addTickApplicativeArg"
+ addTickArg (XApplicativeArg nec) = noExtCon nec
addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
-> TM (ParStmtBlock GhcTc GhcTc)
@@ -788,7 +788,7 @@ addTickStmtAndBinders isGuard (ParStmtBlock x stmts ids returnExpr) =
(addTickLStmts isGuard stmts)
(return ids)
(addTickSyntaxExpr hpcSrcSpan returnExpr)
-addTickStmtAndBinders _ (XParStmtBlock{}) = panic "addTickStmtAndBinders"
+addTickStmtAndBinders _ (XParStmtBlock nec) = noExtCon nec
addTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
addTickHsLocalBinds (HsValBinds x binds) =
@@ -841,7 +841,7 @@ addTickHsCmdTop (HsCmdTop x cmd) =
liftM2 HsCmdTop
(return x)
(addTickLHsCmd cmd)
-addTickHsCmdTop (XCmdTop{}) = panic "addTickHsCmdTop"
+addTickHsCmdTop (XCmdTop nec) = noExtCon nec
addTickLHsCmd :: LHsCmd GhcTc -> TM (LHsCmd GhcTc)
addTickLHsCmd (dL->L pos c0) = do
@@ -897,7 +897,7 @@ addTickHsCmd (HsCmdArrForm x e f fix cmdtop) =
addTickHsCmd (HsCmdWrap x w cmd)
= liftM2 (HsCmdWrap x) (return w) (addTickHsCmd cmd)
-addTickHsCmd e@(XCmd {}) = pprPanic "addTickHsCmd" (ppr e)
+addTickHsCmd (XCmd nec) = noExtCon nec
-- Others should never happen in a command context.
--addTickHsCmd e = pprPanic "addTickHsCmd" (ppr e)
@@ -907,14 +907,14 @@ addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)
addTickCmdMatchGroup mg@(MG { mg_alts = (dL->L l matches) }) = do
matches' <- mapM (liftL addTickCmdMatch) matches
return $ mg { mg_alts = cL l matches' }
-addTickCmdMatchGroup (XMatchGroup _) = panic "addTickCmdMatchGroup"
+addTickCmdMatchGroup (XMatchGroup nec) = noExtCon nec
addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =
bindLocals (collectPatsBinders pats) $ do
gRHSs' <- addTickCmdGRHSs gRHSs
return $ match { m_grhss = gRHSs' }
-addTickCmdMatch (XMatch _) = panic "addTickCmdMatch"
+addTickCmdMatch (XMatch nec) = noExtCon nec
addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
addTickCmdGRHSs (GRHSs x guarded (dL->L l local_binds)) = do
@@ -924,7 +924,7 @@ addTickCmdGRHSs (GRHSs x guarded (dL->L l local_binds)) = do
return $ GRHSs x guarded' (cL l local_binds')
where
binders = collectLocalBinders local_binds
-addTickCmdGRHSs (XGRHSs _) = panic "addTickCmdGRHSs"
+addTickCmdGRHSs (XGRHSs nec) = noExtCon nec
addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
-- The *guards* are *not* Cmds, although the body is
@@ -933,7 +933,7 @@ addTickCmdGRHS (GRHS x stmts cmd)
= do { (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox)
stmts (addTickLHsCmd cmd)
; return $ GRHS x stmts' expr' }
-addTickCmdGRHS (XGRHS _) = panic "addTickCmdGRHS"
+addTickCmdGRHS (XGRHS nec) = noExtCon nec
addTickLCmdStmts :: [LStmt GhcTc (LHsCmd GhcTc)]
-> TM [LStmt GhcTc (LHsCmd GhcTc)]
@@ -980,8 +980,8 @@ addTickCmdStmt stmt@(RecStmt {})
, recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
addTickCmdStmt ApplicativeStmt{} =
panic "ToDo: addTickCmdStmt ApplicativeLastStmt"
-addTickCmdStmt XStmtLR{} =
- panic "addTickCmdStmt XStmtLR"
+addTickCmdStmt (XStmtLR nec) =
+ noExtCon nec
-- Others should never happen in a command context.
addTickCmdStmt stmt = pprPanic "addTickHsCmd" (ppr stmt)
@@ -1175,7 +1175,7 @@ allocTickBox boxLabel countEntries topOnly pos m =
(fvs, e) <- getFreeVars m
env <- getEnv
tickish <- mkTickish boxLabel countEntries topOnly pos fvs (declPath env)
- return (cL pos (HsTick noExt tickish (cL pos e)))
+ return (cL pos (HsTick noExtField tickish (cL pos e)))
) (do
e <- m
return (cL pos e)
@@ -1262,8 +1262,8 @@ mkBinTickBoxHpc boxLabel pos e =
c = tickBoxCount st
mes = mixEntries st
in
- ( cL pos $ HsTick noExt (HpcTick (this_mod env) c)
- $ cL pos $ HsBinTick noExt (c+1) (c+2) e
+ ( cL pos $ HsTick noExtField (HpcTick (this_mod env) c)
+ $ cL pos $ HsBinTick noExtField (c+1) (c+2) e
-- notice that F and T are reversed,
-- because we are building the list in
-- reverse...
@@ -1292,9 +1292,9 @@ matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
where
matchCount (dL->L _ (Match { m_grhss = GRHSs _ grhss _ }))
= length grhss
- matchCount (dL->L _ (Match { m_grhss = XGRHSs _ }))
- = panic "matchesOneOfMany"
- matchCount (dL->L _ (XMatch _)) = panic "matchesOneOfMany"
+ matchCount (dL->L _ (Match { m_grhss = XGRHSs nec }))
+ = noExtCon nec
+ matchCount (dL->L _ (XMatch nec)) = noExtCon nec
matchCount _ = panic "matchCount: Impossible Match" -- due to #15884
type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 128722d5b514cab87b299f7992a2b1ade4868d3b..2c0b4139a6d4a32b36b0fea68dce93a6f1663f5b 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -412,7 +412,7 @@ dsRule (dL->L loc (HsRule { rd_name = name
; return (Just rule)
} } }
-dsRule (dL->L _ (XRuleDecl _)) = panic "dsRule"
+dsRule (dL->L _ (XRuleDecl nec)) = noExtCon nec
dsRule _ = panic "dsRule: Impossible Match" -- due to #15884
warnRuleShadowing :: RuleName -> Activation -> Id -> [Id] -> DsM ()
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index f86f364cb22c4e4a59b321c29db8da01b87af663..956eb1d098f300fe1060a24bea78ea236c1f5cbe 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -592,11 +592,11 @@ dsCmd ids local_vars stack_ty res_ty
left_con <- dsLookupDataCon leftDataConName
right_con <- dsLookupDataCon rightDataConName
let
- left_id = HsConLikeOut noExt (RealDataCon left_con)
- right_id = HsConLikeOut noExt (RealDataCon right_con)
- left_expr ty1 ty2 e = noLoc $ HsApp noExt
+ left_id = HsConLikeOut noExtField (RealDataCon left_con)
+ right_id = HsConLikeOut noExtField (RealDataCon right_con)
+ left_expr ty1 ty2 e = noLoc $ HsApp noExtField
(noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) left_id ) e
- right_expr ty1 ty2 e = noLoc $ HsApp noExt
+ right_expr ty1 ty2 e = noLoc $ HsApp noExtField
(noLoc $ mkHsWrap (mkWpTyApps [ty1, ty2]) right_id) e
-- Prefix each tuple with a distinct series of Left's and Right's,
@@ -616,7 +616,7 @@ dsCmd ids local_vars stack_ty res_ty
(_, matches') = mapAccumL (replaceLeavesMatch res_ty) leaves' matches
in_ty = envStackType env_ids stack_ty
- core_body <- dsExpr (HsCase noExt exp
+ core_body <- dsExpr (HsCase noExtField exp
(MG { mg_alts = cL l matches'
, mg_ext = MatchGroupTc arg_tys sum_ty
, mg_origin = origin }))
@@ -1167,7 +1167,7 @@ replaceLeavesMatch _res_ty leaves
= let
(leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
in
- (leaves', cL loc (match { m_ext = noExt, m_grhss = GRHSs x grhss' binds }))
+ (leaves', cL loc (match { m_ext = noExtField, m_grhss = GRHSs x grhss' binds }))
replaceLeavesMatch _ _ _ = panic "replaceLeavesMatch"
replaceLeavesGRHS
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index a87a4bbcbbacd913e0b89e87b5e198d9c4920e36..96855a61b7b04f560bb87dbc5f003769e820025d 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -198,7 +198,7 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds has_sig }
dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind"
-dsHsBind _ (XHsBindsLR{}) = panic "dsHsBind: XHsBindsLR"
+dsHsBind _ (XHsBindsLR nec) = noExtCon nec
-----------------------
@@ -258,7 +258,7 @@ dsAbsBinds dflags tyvars dicts exports
; return (makeCorePair dflags global
(isDefaultMethod prags)
0 (core_wrap (Var local))) }
- mk_bind (XABExport _) = panic "dsAbsBinds"
+ mk_bind (XABExport nec) = noExtCon nec
; main_binds <- mapM mk_bind exports
; return (force_vars, flattenBinds ds_ev_binds ++ bind_prs ++ main_binds) }
@@ -303,7 +303,7 @@ dsAbsBinds dflags tyvars dicts exports
-- the user written (local) function. The global
-- Id is just the selector. Hmm.
; return ((global', rhs) : fromOL spec_binds) }
- mk_bind (XABExport _) = panic "dsAbsBinds"
+ mk_bind (XABExport nec) = noExtCon nec
; export_binds_s <- mapM mk_bind (exports ++ extra_exports)
@@ -351,7 +351,7 @@ dsAbsBinds dflags tyvars dicts exports
mk_export local =
do global <- newSysLocalDs
(exprType (mkLams tyvars (mkLams dicts (Var local))))
- return (ABE { abe_ext = noExt
+ return (ABE { abe_ext = noExtField
, abe_poly = global
, abe_mono = local
, abe_wrap = WpHole
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index 9516fbbe82ad66d1ef8c9d0ea5529d00d202c1c3..73edf8c2de93ff4317d68a1730eb70caee245866 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -98,7 +98,7 @@ dsIPBinds (IPBinds ev_binds ip_binds) body
= do e' <- dsLExpr e
return (Let (NonRec n e') body)
ds_ip_bind _ _ = panic "dsIPBinds"
-dsIPBinds (XHsIPBinds _) _ = panic "dsIPBinds"
+dsIPBinds (XHsIPBinds nec) _ = noExtCon nec
-------------------------
-- caller sets location
@@ -451,7 +451,7 @@ ds_expr _ (HsMultiIf res_ty alts)
| otherwise
= do { match_result <- liftM (foldr1 combineMatchResults)
(mapM (dsGRHS IfAlt res_ty) alts)
- ; checkGuardMatches IfAlt (GRHSs noExt alts (noLoc emptyLocalBinds))
+ ; checkGuardMatches IfAlt (GRHSs noExtField alts (noLoc emptyLocalBinds))
; error_expr <- mkErrorExpr
; extractMatchResult match_result error_expr }
where
@@ -663,7 +663,7 @@ ds_expr _ expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = fields
mk_val_arg fl pat_arg_id
= nlHsVar (lookupNameEnv upd_fld_env (flSelector fl) `orElse` pat_arg_id)
- inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExt con)
+ inst_con = noLoc $ mkHsWrap wrap (HsConLikeOut noExtField con)
-- Reconstruct with the WrapId so that unpacking happens
wrap = mkWpEvVarApps theta_vars <.>
dict_req_wrap <.>
@@ -754,7 +754,7 @@ ds_expr _ (HsTickPragma _ _ _ _ expr) = do
ds_expr _ (HsBracket {}) = panic "dsExpr:HsBracket"
ds_expr _ (HsDo {}) = panic "dsExpr:HsDo"
ds_expr _ (HsRecFld {}) = panic "dsExpr:HsRecFld"
-ds_expr _ (XExpr {}) = panic "dsExpr: XExpr"
+ds_expr _ (XExpr nec) = noExtCon nec
------------------------------
@@ -927,7 +927,7 @@ dsDo stmts
(pat, dsLExpr expr)
do_arg (ApplicativeArgMany _ stmts ret pat) =
(pat, dsDo (stmts ++ [noLoc $ mkLastStmt (noLoc ret)]))
- do_arg (XApplicativeArg _) = panic "dsDo"
+ do_arg (XApplicativeArg nec) = noExtCon nec
arg_tys = map hsLPatType pats
@@ -935,7 +935,7 @@ dsDo stmts
; let body' = noLoc $ HsDo body_ty DoExpr (noLoc stmts)
- ; let fun = cL noSrcSpan $ HsLam noExt $
+ ; let fun = cL noSrcSpan $ HsLam noExtField $
MG { mg_alts = noLoc [mkSimpleMatch LambdaExpr pats
body']
, mg_ext = MatchGroupTc arg_tys body_ty
@@ -967,13 +967,13 @@ dsDo stmts
later_pats = rec_tup_pats
rets = map noLoc rec_rets
mfix_app = nlHsSyntaxApps mfix_op [mfix_arg]
- mfix_arg = noLoc $ HsLam noExt
+ mfix_arg = noLoc $ HsLam noExtField
(MG { mg_alts = noLoc [mkSimpleMatch
LambdaExpr
[mfix_pat] body]
, mg_ext = MatchGroupTc [tup_ty] body_ty
, mg_origin = Generated })
- mfix_pat = noLoc $ LazyPat noExt $ mkBigLHsPatTupId rec_tup_pats
+ mfix_pat = noLoc $ LazyPat noExtField $ mkBigLHsPatTupId rec_tup_pats
body = noLoc $ HsDo body_ty
DoExpr (noLoc (rec_stmts ++ [ret_stmt]))
ret_app = nlHsSyntaxApps return_op [mkBigLHsTupId rets]
@@ -984,7 +984,7 @@ dsDo stmts
go _ (ParStmt {}) _ = panic "dsDo ParStmt"
go _ (TransStmt {}) _ = panic "dsDo TransStmt"
- go _ (XStmtLR {}) _ = panic "dsDo XStmtLR"
+ go _ (XStmtLR nec) _ = noExtCon nec
handle_failure :: LPat GhcTc -> MatchResult -> SyntaxExpr GhcTc -> DsM CoreExpr
-- In a do expression, pattern-match failure just calls
diff --git a/compiler/deSugar/DsForeign.hs b/compiler/deSugar/DsForeign.hs
index 3ecd9bfead4f38029994cfeb3958bf03ee369ef6..545f26c3f697734027f0dc9338ce79cf18139849 100644
--- a/compiler/deSugar/DsForeign.hs
+++ b/compiler/deSugar/DsForeign.hs
@@ -112,7 +112,7 @@ dsForeigns' fos = do
(dL->L _ (CExportStatic _ ext_nm cconv)) _ }) = do
(h, c, _, _) <- dsFExport id co ext_nm cconv False
return (h, c, [id], [])
- do_decl (XForeignDecl _) = panic "dsForeigns'"
+ do_decl (XForeignDecl nec) = noExtCon nec
{-
************************************************************************
diff --git a/compiler/deSugar/DsGRHSs.hs b/compiler/deSugar/DsGRHSs.hs
index 277ea000448d594f0d77ee1f88caf80fb43270b1..5adc661388f39c673c48a0099a7a303c438b7758 100644
--- a/compiler/deSugar/DsGRHSs.hs
+++ b/compiler/deSugar/DsGRHSs.hs
@@ -64,13 +64,13 @@ dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty
match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1
-- NB: nested dsLet inside matchResult
; return match_result2 }
-dsGRHSs _ (XGRHSs _) _ = panic "dsGRHSs"
+dsGRHSs _ (XGRHSs nec) _ = noExtCon nec
dsGRHS :: HsMatchContext Name -> Type -> LGRHS GhcTc (LHsExpr GhcTc)
-> DsM MatchResult
dsGRHS hs_ctx rhs_ty (dL->L _ (GRHS _ guards rhs))
= matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty
-dsGRHS _ _ (dL->L _ (XGRHS _)) = panic "dsGRHS"
+dsGRHS _ _ (dL->L _ (XGRHS nec)) = noExtCon nec
dsGRHS _ _ _ = panic "dsGRHS: Impossible Match" -- due to #15884
{-
@@ -138,8 +138,8 @@ matchGuards (TransStmt {} : _) _ _ _ = panic "matchGuards TransStmt"
matchGuards (RecStmt {} : _) _ _ _ = panic "matchGuards RecStmt"
matchGuards (ApplicativeStmt {} : _) _ _ _ =
panic "matchGuards ApplicativeLastStmt"
-matchGuards (XStmtLR {} : _) _ _ _ =
- panic "matchGuards XStmtLR"
+matchGuards (XStmtLR nec : _) _ _ _ =
+ noExtCon nec
{-
Should {\em fail} if @e@ returns @D@
diff --git a/compiler/deSugar/DsListComp.hs b/compiler/deSugar/DsListComp.hs
index f376ef0b4b6d0427b762a5d0f8c57fd7408f5c3f..9755bf695bd245659abf8a752def7203c40e7fb3 100644
--- a/compiler/deSugar/DsListComp.hs
+++ b/compiler/deSugar/DsListComp.hs
@@ -91,7 +91,7 @@ dsInnerListComp (ParStmtBlock _ stmts bndrs _)
; expr <- dsListComp (stmts ++ [noLoc $ mkLastStmt (mkBigLHsVarTupId bndrs)]) list_ty
; return (expr, bndrs_tuple_type) }
-dsInnerListComp (XParStmtBlock{}) = panic "dsInnerListComp"
+dsInnerListComp (XParStmtBlock nec) = noExtCon nec
-- This function factors out commonality between the desugaring strategies for GroupStmt.
-- Given such a statement it gives you back an expression representing how to compute the transformed
@@ -107,7 +107,7 @@ dsTransStmt (TransStmt { trS_form = form, trS_stmts = stmts, trS_bndrs = binderM
to_bndrs_tup_ty = mkBigCoreTupTy to_bndrs_tys
-- Desugar an inner comprehension which outputs a list of tuples of the "from" binders
- (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock noExt stmts
+ (expr', from_tup_ty) <- dsInnerListComp (ParStmtBlock noExtField stmts
from_bndrs noSyntaxExpr)
-- Work out what arguments should be supplied to that expression: i.e. is an extraction
@@ -267,8 +267,8 @@ deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt"
deListComp (ApplicativeStmt {} : _) _ =
panic "deListComp ApplicativeStmt"
-deListComp (XStmtLR {} : _) _ =
- panic "deListComp XStmtLR"
+deListComp (XStmtLR nec : _) _ =
+ noExtCon nec
deBindComp :: OutPat GhcTc
-> CoreExpr
@@ -364,8 +364,8 @@ dfListComp _ _ (ParStmt {} : _) = panic "dfListComp ParStmt"
dfListComp _ _ (RecStmt {} : _) = panic "dfListComp RecStmt"
dfListComp _ _ (ApplicativeStmt {} : _) =
panic "dfListComp ApplicativeStmt"
-dfListComp _ _ (XStmtLR {} : _) =
- panic "dfListComp XStmtLR"
+dfListComp _ _ (XStmtLR nec : _) =
+ noExtCon nec
dfBindComp :: Id -> Id -- 'c' and 'n'
-> (LPat GhcTc, CoreExpr)
@@ -596,7 +596,7 @@ dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest
ds_inner (ParStmtBlock _ stmts bndrs return_op)
= do { exp <- dsInnerMonadComp stmts bndrs return_op
; return (exp, mkBigCoreVarTupTy bndrs) }
- ds_inner (XParStmtBlock{}) = panic "dsMcStmt"
+ ds_inner (XParStmtBlock nec) = noExtCon nec
dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
@@ -655,7 +655,7 @@ dsInnerMonadComp :: [ExprLStmt GhcTc]
-> DsM CoreExpr
dsInnerMonadComp stmts bndrs ret_op
= dsMcStmts (stmts ++
- [noLoc (LastStmt noExt (mkBigLHsVarTupId bndrs) False ret_op)])
+ [noLoc (LastStmt noExtField (mkBigLHsVarTupId bndrs) False ret_op)])
-- The `unzip` function for `GroupStmt` in a monad comprehensions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 25f5ec0ab15ed288efed42a65f70c24e25fce949..a8d2b7de0f8ea5d1c020e4b0ce79b202fc575f93 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -84,7 +84,7 @@ dsBracket brack splices
do_brack (DecBrG _ gp) = do { MkC ds1 <- repTopDs gp ; return ds1 }
do_brack (DecBrL {}) = panic "dsBracket: unexpected DecBrL"
do_brack (TExpBr _ e) = do { MkC e1 <- repLE e ; return e1 }
- do_brack (XBracket {}) = panic "dsBracket: unexpected XBracket"
+ do_brack (XBracket nec) = noExtCon nec
{- -------------- Examples --------------------
@@ -178,7 +178,7 @@ repTopDs group@(HsGroup { hs_valds = valds
no_warn _ = panic "repTopDs"
no_doc (dL->L loc _)
= notHandledL loc "Haddock documentation" empty
-repTopDs (XHsGroup _) = panic "repTopDs"
+repTopDs (XHsGroup nec) = noExtCon nec
hsScopedTvBinders :: HsValBinds GhcRn -> [Name]
-- See Note [Scoped type variables in bindings]
@@ -208,8 +208,8 @@ get_scoped_tvs (dL->L _ signature)
, hsib_body = hs_ty } <- sig
, (explicit_vars, _) <- splitLHsForAllTy hs_ty
= implicit_vars ++ hsLTyVarNames explicit_vars
- get_scoped_tvs_from_sig (XHsImplicitBndrs _)
- = panic "get_scoped_tvs_from_sig"
+ get_scoped_tvs_from_sig (XHsImplicitBndrs nec)
+ = noExtCon nec
{- Notes
@@ -374,7 +374,7 @@ repDataDefn tc opts
; repData cxt1 tc opts ksig' cons1
derivs1 }
}
-repDataDefn _ _ (XHsDataDefn _) = panic "repDataDefn"
+repDataDefn _ _ (XHsDataDefn nec) = noExtCon nec
repSynDecl :: Core TH.Name -> Core [TH.TyVarBndrQ]
-> LHsType GhcRn
@@ -425,7 +425,7 @@ repFamilyResultSig (KindSig _ ki) = do { ki' <- repLTy ki
; repKindSig ki' }
repFamilyResultSig (TyVarSig _ bndr) = do { bndr' <- repTyVarBndr bndr
; repTyVarSig bndr' }
-repFamilyResultSig (XFamilyResultSig _) = panic "repFamilyResultSig"
+repFamilyResultSig (XFamilyResultSig nec) = noExtCon nec
-- | Represent result signature using a Maybe Kind. Used with data families,
-- where the result signature can be either missing or a kind but never a named
@@ -511,7 +511,7 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
; wrapGenSyms ss decls2 }
where
(tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
-repClsInstD (XClsInstDecl _) = panic "repClsInstD"
+repClsInstD (XClsInstDecl nec) = noExtCon nec
repStandaloneDerivD :: LDerivDecl GhcRn -> DsM (SrcSpan, Core TH.DecQ)
repStandaloneDerivD (dL->L loc (DerivDecl { deriv_strategy = strat
@@ -556,8 +556,8 @@ repTyFamEqn (HsIB { hsib_ext = var_names
where checkTys :: [LHsTypeArg GhcRn] -> DsM [LHsTypeArg GhcRn]
checkTys tys@(HsValArg _:HsValArg _:_) = return tys
checkTys _ = panic "repTyFamEqn:checkTys"
-repTyFamEqn (XHsImplicitBndrs _) = panic "repTyFamEqn"
-repTyFamEqn (HsIB _ (XFamEqn _)) = panic "repTyFamEqn"
+repTyFamEqn (XHsImplicitBndrs nec) = noExtCon nec
+repTyFamEqn (HsIB _ (XFamEqn nec)) = noExtCon nec
repTyArgs :: DsM (Core TH.TypeQ) -> [LHsTypeArg GhcRn] -> DsM (Core TH.TypeQ)
repTyArgs f [] = f
@@ -596,10 +596,10 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn =
checkTys tys@(HsValArg _: HsValArg _: _) = return tys
checkTys _ = panic "repDataFamInstD:checkTys"
-repDataFamInstD (DataFamInstDecl (XHsImplicitBndrs _))
- = panic "repDataFamInstD"
-repDataFamInstD (DataFamInstDecl (HsIB _ (XFamEqn _)))
- = panic "repDataFamInstD"
+repDataFamInstD (DataFamInstDecl (XHsImplicitBndrs nec))
+ = noExtCon nec
+repDataFamInstD (DataFamInstDecl (HsIB _ (XFamEqn nec)))
+ = noExtCon nec
repForD :: Located (ForeignDecl GhcRn) -> DsM (SrcSpan, Core TH.DecQ)
repForD (dL->L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
@@ -694,7 +694,7 @@ ruleBndrNames (dL->L _ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs _))))
= panic "ruleBndrNames"
ruleBndrNames (dL->L _ (RuleBndrSig _ _ (XHsWildCardBndrs _)))
= panic "ruleBndrNames"
-ruleBndrNames (dL->L _ (XRuleBndr _)) = panic "ruleBndrNames"
+ruleBndrNames (dL->L _ (XRuleBndr nec)) = noExtCon nec
ruleBndrNames _ = panic "ruleBndrNames: Impossible Match" -- due to #15884
repRuleBndr :: LRuleBndr GhcRn -> DsM (Core TH.RuleBndrQ)
@@ -887,7 +887,7 @@ rep_ty_sig mk_sig loc sig_ty nm
else repTForall th_explicit_tvs th_ctxt th_ty
; sig <- repProto mk_sig nm1 ty1
; return (loc, sig) }
-rep_ty_sig _ _ (XHsImplicitBndrs _) _ = panic "rep_ty_sig"
+rep_ty_sig _ _ (XHsImplicitBndrs nec) _ = noExtCon nec
rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name
-> DsM (SrcSpan, Core TH.DecQ)
@@ -916,7 +916,7 @@ rep_patsyn_ty_sig loc sig_ty nm
repTForall th_exis th_provs th_ty
; sig <- repProto patSynSigDName nm1 ty1
; return (loc, sig) }
-rep_patsyn_ty_sig _ (XHsImplicitBndrs _) _ = panic "rep_patsyn_ty_sig"
+rep_patsyn_ty_sig _ (XHsImplicitBndrs nec) _ = noExtCon nec
rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name
-> DsM (SrcSpan, Core TH.DecQ)
@@ -1024,7 +1024,7 @@ addTyVarBinds (HsQTvs { hsq_ext = imp_tvs
= addSimpleTyVarBinds imp_tvs $
addHsTyVarBinds exp_tvs $
thing_inside
-addTyVarBinds (XLHsQTyVars _) _ = panic "addTyVarBinds"
+addTyVarBinds (XLHsQTyVars nec) _ = noExtCon nec
addTyClTyVarBinds :: LHsQTyVars GhcRn
-> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))
@@ -1095,12 +1095,12 @@ repHsSigType (HsIB { hsib_ext = implicit_tvs
; if null explicit_tvs && null (unLoc ctxt)
then return th_ty
else repTForall th_explicit_tvs th_ctxt th_ty }
-repHsSigType (XHsImplicitBndrs _) = panic "repHsSigType"
+repHsSigType (XHsImplicitBndrs nec) = noExtCon nec
repHsSigWcType :: LHsSigWcType GhcRn -> DsM (Core TH.TypeQ)
repHsSigWcType (HsWC { hswc_body = sig1 })
= repHsSigType sig1
-repHsSigWcType (XHsWildCardBndrs _) = panic "repHsSigWcType"
+repHsSigWcType (XHsWildCardBndrs nec) = noExtCon nec
-- yield the representation of a list of types
repLTys :: [LHsType GhcRn] -> DsM [Core TH.TypeQ]
@@ -1225,7 +1225,7 @@ repSplice (HsUntypedSplice _ _ n _) = rep_splice n
repSplice (HsQuasiQuote _ n _ _ _) = rep_splice n
repSplice e@(HsSpliced {}) = pprPanic "repSplice" (ppr e)
repSplice e@(HsSplicedT {}) = pprPanic "repSpliceT" (ppr e)
-repSplice e@(XSplice {}) = pprPanic "repSplice" (ppr e)
+repSplice (XSplice nec) = noExtCon nec
rep_splice :: Name -> DsM (Core a)
rep_splice splice_name
@@ -1262,7 +1262,7 @@ repE (HsIPVar _ n) = rep_implicit_param_name n >>= repImplicitParamVar
repE (HsOverLabel _ _ s) = repOverLabel s
repE e@(HsRecFld _ f) = case f of
- Unambiguous x _ -> repE (HsVar noExt (noLoc x))
+ Unambiguous x _ -> repE (HsVar noExtField (noLoc x))
Ambiguous{} -> notHandled "Ambiguous record selectors" (ppr e)
XAmbiguousFieldOcc{} -> notHandled "XAmbiguous record selectors" (ppr e)
@@ -1421,7 +1421,7 @@ repClauseTup (dL->L _ (Match { m_pats = ps
gs <- repGuards guards
; clause <- repClause ps1 gs ds
; wrapGenSyms (ss1++ss2) clause }}}
-repClauseTup (dL->L _ (Match _ _ _ (XGRHSs _))) = panic "repClauseTup"
+repClauseTup (dL->L _ (Match _ _ _ (XGRHSs nec))) = noExtCon nec
repClauseTup _ = panic "repClauseTup"
repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> DsM (Core TH.BodyQ)
@@ -1528,7 +1528,7 @@ repSts (ParStmt _ stmt_blocks _ _ : ss) =
do { (ss1, zs) <- repSts (map unLoc stmts)
; zs1 <- coreList stmtQTyConName zs
; return (ss1, zs1) }
- rep_stmt_block (XParStmtBlock{}) = panic "repSts"
+ rep_stmt_block (XParStmtBlock nec) = noExtCon nec
repSts [LastStmt _ e _ _]
= do { e2 <- repLE e
; z <- repNoBindSt e2
@@ -1638,7 +1638,7 @@ rep_bind (dL->L loc (FunBind { fun_id = fn
; ans <- repFun fn' (nonEmptyCoreList ms1)
; return (loc, ans) }
-rep_bind (dL->L _ (FunBind { fun_matches = XMatchGroup _ })) = panic "rep_bind"
+rep_bind (dL->L _ (FunBind { fun_matches = XMatchGroup nec })) = noExtCon nec
rep_bind (dL->L loc (PatBind { pat_lhs = pat
, pat_rhs = GRHSs _ guards (dL->L _ wheres) }))
@@ -1648,7 +1648,7 @@ rep_bind (dL->L loc (PatBind { pat_lhs = pat
; ans <- repVal patcore guardcore wherecore
; ans' <- wrapGenSyms ss ans
; return (loc, ans') }
-rep_bind (dL->L _ (PatBind _ _ (XGRHSs _) _)) = panic "rep_bind"
+rep_bind (dL->L _ (PatBind _ _ (XGRHSs nec) _)) = noExtCon nec
rep_bind (dL->L _ (VarBind { var_id = v, var_rhs = e}))
= do { v' <- lookupBinder v
@@ -1698,9 +1698,9 @@ rep_bind (dL->L loc (PatSynBind _ (PSB { psb_id = syn
wrapGenArgSyms (RecCon _) _ dec = return dec
wrapGenArgSyms _ ss dec = wrapGenSyms ss dec
-rep_bind (dL->L _ (PatSynBind _ (XPatSynBind _)))
- = panic "rep_bind: XPatSynBind"
-rep_bind (dL->L _ (XHsBindsLR {})) = panic "rep_bind: XHsBindsLR"
+rep_bind (dL->L _ (PatSynBind _ (XPatSynBind nec)))
+ = noExtCon nec
+rep_bind (dL->L _ (XHsBindsLR nec)) = noExtCon nec
rep_bind _ = panic "rep_bind: Impossible match!"
-- due to #15884
@@ -1741,7 +1741,7 @@ repPatSynDir ImplicitBidirectional = rep2 implBidirPatSynName []
repPatSynDir (ExplicitBidirectional (MG { mg_alts = (dL->L _ clauses) }))
= do { clauses' <- mapM repClauseTup clauses
; repExplBidirPatSynDir (nonEmptyCoreList clauses') }
-repPatSynDir (ExplicitBidirectional (XMatchGroup _)) = panic "repPatSynDir"
+repPatSynDir (ExplicitBidirectional (XMatchGroup nec)) = noExtCon nec
repExplBidirPatSynDir :: Core [TH.ClauseQ] -> DsM (Core TH.PatSynDirQ)
repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]
@@ -2597,7 +2597,7 @@ mk_integer i = do integer_ty <- lookupType integerTyConName
mk_rational :: FractionalLit -> DsM (HsLit GhcRn)
mk_rational r = do rat_ty <- lookupType rationalTyConName
- return $ HsRat noExt r rat_ty
+ return $ HsRat noExtField r rat_ty
mk_string :: FastString -> DsM (HsLit GhcRn)
mk_string s = return $ HsString NoSourceText s
@@ -2610,7 +2610,7 @@ repOverloadedLiteral (OverLit { ol_val = val})
-- The type Rational will be in the environment, because
-- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
-- and rationalL is sucked in when any TH stuff is used
-repOverloadedLiteral XOverLit{} = panic "repOverloadedLiteral"
+repOverloadedLiteral (XOverLit nec) = noExtCon nec
mk_lit :: OverLitVal -> DsM (HsLit GhcRn)
mk_lit (HsIntegral i) = mk_integer (il_value i)
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index d4ceb523df7185bdd5a74f2c283c1f95940af412..c4abd16737b431751765bfc402b9f3f9e28ea1d0 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -955,7 +955,7 @@ decideBangHood dflags lpat
ParPat x p -> cL l (ParPat x (go p))
LazyPat _ lp' -> lp'
BangPat _ _ -> lp
- _ -> cL l (BangPat noExt lp)
+ _ -> cL l (BangPat noExtField lp)
-- | Unconditionally make a 'Pat' strict.
addBang :: LPat GhcTc -- ^ Original pattern
@@ -965,10 +965,10 @@ addBang = go
go lp@(dL->L l p)
= case p of
ParPat x p -> cL l (ParPat x (go p))
- LazyPat _ lp' -> cL l (BangPat noExt lp')
+ LazyPat _ lp' -> cL l (BangPat noExtField lp')
-- Should we bring the extension value over?
BangPat _ _ -> lp
- _ -> cL l (BangPat noExt lp)
+ _ -> cL l (BangPat noExtField lp)
isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
diff --git a/compiler/deSugar/ExtractDocs.hs b/compiler/deSugar/ExtractDocs.hs
index d2b191349d725e730acbe65e272f5661df57e32b..ce5299443bb68ff5f7bf6977aa72377d890f2b54 100644
--- a/compiler/deSugar/ExtractDocs.hs
+++ b/compiler/deSugar/ExtractDocs.hs
@@ -137,7 +137,7 @@ sigNameNoLoc _ = []
-- Extract the source location where an instance is defined. This is used
-- to correlate InstDecls with their Instance/CoAxiom Names, via the
-- instanceMap.
-getInstLoc :: InstDecl name -> SrcSpan
+getInstLoc :: InstDecl (GhcPass p) -> SrcSpan
getInstLoc = \case
ClsInstD _ (ClsInstDecl { cid_poly_ty = ty }) -> getLoc (hsSigType ty)
DataFamInstD _ (DataFamInstDecl
@@ -234,10 +234,10 @@ classDecls :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls
where
decls = docs ++ defs ++ sigs ++ ats
- docs = mkDecls tcdDocs (DocD noExt) class_
- defs = mkDecls (bagToList . tcdMeths) (ValD noExt) class_
- sigs = mkDecls tcdSigs (SigD noExt) class_
- ats = mkDecls tcdATs (TyClD noExt . FamDecl noExt) class_
+ docs = mkDecls tcdDocs (DocD noExtField) class_
+ defs = mkDecls (bagToList . tcdMeths) (ValD noExtField) class_
+ sigs = mkDecls tcdSigs (SigD noExtField) class_
+ ats = mkDecls tcdATs (TyClD noExtField . FamDecl noExtField) class_
-- | Extract function argument docs from inside top-level decls.
declTypeDocs :: HsDecl GhcRn -> Map Int (HsDocString)
@@ -280,14 +280,14 @@ topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
ungroup group_ =
- mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExt) group_ ++
- mkDecls hs_derivds (DerivD noExt) group_ ++
- mkDecls hs_defds (DefD noExt) group_ ++
- mkDecls hs_fords (ForD noExt) group_ ++
- mkDecls hs_docs (DocD noExt) group_ ++
- mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExt) group_ ++
- mkDecls (typesigs . hs_valds) (SigD noExt) group_ ++
- mkDecls (valbinds . hs_valds) (ValD noExt) group_
+ mkDecls (tyClGroupTyClDecls . hs_tyclds) (TyClD noExtField) group_ ++
+ mkDecls hs_derivds (DerivD noExtField) group_ ++
+ mkDecls hs_defds (DefD noExtField) group_ ++
+ mkDecls hs_fords (ForD noExtField) group_ ++
+ mkDecls hs_docs (DocD noExtField) group_ ++
+ mkDecls (tyClGroupInstDecls . hs_tyclds) (InstD noExtField) group_ ++
+ mkDecls (typesigs . hs_valds) (SigD noExtField) group_ ++
+ mkDecls (valbinds . hs_valds) (ValD noExtField) group_
where
typesigs (XValBindsLR (NValBinds _ sigs)) = filter (isUserSig . unLoc) sigs
typesigs ValBinds{} = error "expected XValBindsLR"
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index c057298420d7f278822c4875065f68011ce9b1aa..921b829fb9c8ef0cb26c937a89d8eed2e361309b 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -501,9 +501,9 @@ tidy_bang_pat v o _ (SigPat _ (dL->L l p) _) = tidy_bang_pat v o l p
-- Push the bang-pattern inwards, in the hope that
-- it may disappear next time
tidy_bang_pat v o l (AsPat x v' p)
- = tidy1 v o (AsPat x v' (cL l (BangPat noExt p)))
+ = tidy1 v o (AsPat x v' (cL l (BangPat noExtField p)))
tidy_bang_pat v o l (CoPat x w p t)
- = tidy1 v o (CoPat x w (BangPat noExt (cL l p)) t)
+ = tidy1 v o (CoPat x w (BangPat noExtField (cL l p)) t)
-- Discard bang around strict pattern
tidy_bang_pat v o _ p@(LitPat {}) = tidy1 v o p
@@ -538,7 +538,7 @@ tidy_bang_pat v o l p@(ConPatOut { pat_con = (dL->L _ (RealDataCon dc))
--
-- NB: SigPatIn, ConPatIn should not happen
-tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExt (cL l p))
+tidy_bang_pat _ _ l p = return (idDsWrapper, BangPat noExtField (cL l p))
-------------------
push_bang_into_newtype_arg :: SrcSpan
@@ -549,16 +549,16 @@ push_bang_into_newtype_arg :: SrcSpan
-- We are transforming !(N p) into (N !p)
push_bang_into_newtype_arg l _ty (PrefixCon (arg:args))
= ASSERT( null args)
- PrefixCon [cL l (BangPat noExt arg)]
+ PrefixCon [cL l (BangPat noExtField arg)]
push_bang_into_newtype_arg l _ty (RecCon rf)
| HsRecFields { rec_flds = (dL->L lf fld) : flds } <- rf
, HsRecField { hsRecFieldArg = arg } <- fld
= ASSERT( null flds)
RecCon (rf { rec_flds = [cL lf (fld { hsRecFieldArg
- = cL l (BangPat noExt arg) })] })
+ = cL l (BangPat noExtField arg) })] })
push_bang_into_newtype_arg l ty (RecCon rf) -- If a user writes !(T {})
| HsRecFields { rec_flds = [] } <- rf
- = PrefixCon [cL l (BangPat noExt (noLoc (WildPat ty)))]
+ = PrefixCon [cL l (BangPat noExtField (noLoc (WildPat ty)))]
push_bang_into_newtype_arg _ _ cd
= pprPanic "push_bang_into_newtype_arg" (pprConArgs cd)
@@ -752,13 +752,13 @@ matchWrapper ctxt mb_scr (MG { mg_alts = (dL->L _ matches)
; return (EqnInfo { eqn_pats = upats
, eqn_orig = FromSource
, eqn_rhs = match_result }) }
- mk_eqn_info _ (dL->L _ (XMatch _)) = panic "matchWrapper"
+ mk_eqn_info _ (dL->L _ (XMatch nec)) = noExtCon nec
mk_eqn_info _ _ = panic "mk_eqn_info: Impossible Match" -- due to #15884
handleWarnings = if isGenerated origin
then discardWarningsDs
else id
-matchWrapper _ _ (XMatchGroup _) = panic "matchWrapper"
+matchWrapper _ _ (XMatchGroup nec) = noExtCon nec
matchEquations :: HsMatchContext Name
-> [MatchId] -> [EquationInfo] -> Type
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index d99ae7e443df96cb0260b80b05b75247d2baf910..3bab8cf000aabd5b87964d91ea3ea441d25f6796 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -95,7 +95,7 @@ dsLit l = do
HsString _ str -> mkStringExprFS str
HsInteger _ i _ -> mkIntegerExpr i
HsInt _ i -> return (mkIntExpr dflags (il_value i))
- XLit x -> pprPanic "dsLit" (ppr x)
+ XLit nec -> noExtCon nec
HsRat _ (FL _ _ val) ty -> do
num <- mkIntegerExpr (numerator val)
denom <- mkIntegerExpr (denominator val)
@@ -116,7 +116,7 @@ dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
case shortCutLit dflags val ty of
Just expr | not rebindable -> dsExpr expr -- Note [Literal short cut]
_ -> dsExpr witness
-dsOverLit XOverLit{} = panic "dsOverLit"
+dsOverLit (XOverLit nec) = noExtCon nec
{-
Note [Literal short cut]
~~~~~~~~~~~~~~~~~~~~~~~~
@@ -337,7 +337,7 @@ tidyLitPat (HsString src s)
(mkNilPat charTy) (unpackFS s)
-- The stringTy is the type of the whole pattern, not
-- the type to instantiate (:) or [] with!
-tidyLitPat lit = LitPat noExt lit
+tidyLitPat lit = LitPat noExtField lit
----------------
tidyNPat :: HsOverLit GhcTc -> Maybe (SyntaxExpr GhcTc) -> SyntaxExpr GhcTc
@@ -373,7 +373,7 @@ tidyNPat (OverLit (OverLitTc False ty) val _) mb_neg _eq outer_ty
mk_con_pat :: DataCon -> HsLit GhcTc -> Pat GhcTc
mk_con_pat con lit
- = unLoc (mkPrefixConPat con [noLoc $ LitPat noExt lit] [])
+ = unLoc (mkPrefixConPat con [noLoc $ LitPat noExtField lit] [])
mb_int_lit :: Maybe Integer
mb_int_lit = case (mb_neg, val) of
diff --git a/compiler/hieFile/HieAst.hs b/compiler/hieFile/HieAst.hs
index 7c3ceb6138f598d88ae12ff361ec32dfdb0066ed..e1047692ff709b2db09a5c5801b3a82293b14426 100644
--- a/compiler/hieFile/HieAst.hs
+++ b/compiler/hieFile/HieAst.hs
@@ -283,7 +283,7 @@ type family ProtectedSig a where
ProtectedSig GhcRn = HsWildCardBndrs GhcRn (HsImplicitBndrs
GhcRn
(Shielded (LHsType GhcRn)))
- ProtectedSig GhcTc = NoExt
+ ProtectedSig GhcTc = NoExtField
class ProtectSig a where
protectSig :: Scope -> LHsSigWcType (NoGhcTc a) -> ProtectedSig a
@@ -295,7 +295,7 @@ instance (ToHie (TScoped a)) => ToHie (TScoped (Shielded a)) where
toHie (TS _ (SH sc a)) = toHie (TS (ResolvedScopes [sc]) a)
instance ProtectSig GhcTc where
- protectSig _ _ = NoExt
+ protectSig _ _ = noExtField
instance ProtectSig GhcRn where
protectSig sc (HsWC a (HsIB b sig)) =
@@ -368,10 +368,10 @@ instance (ToHie a) => ToHie (Bag a) where
instance (ToHie a) => ToHie (Maybe a) where
toHie = maybe (pure []) toHie
-instance ToHie (Context (Located NoExt)) where
+instance ToHie (Context (Located NoExtField)) where
toHie _ = pure []
-instance ToHie (TScoped NoExt) where
+instance ToHie (TScoped NoExtField) where
toHie _ = pure []
instance ToHie (IEContext (Located ModuleName)) where
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 97329aaa553e9e451556c7d28319cd825feea9d9..ee6553ce042f3ef0b3a86d2ae0c86f7821064774 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -147,16 +147,16 @@ cvtDec (TH.ValD pat body ds)
| TH.VarP s <- pat
= do { s' <- vNameL s
; cl' <- cvtClause (mkPrefixFunRhs s') (Clause [] body ds)
- ; returnJustL $ Hs.ValD noExt $ mkFunBind s' [cl'] }
+ ; returnJustL $ Hs.ValD noExtField $ mkFunBind s' [cl'] }
| otherwise
= do { pat' <- cvtPat pat
; body' <- cvtGuard body
; ds' <- cvtLocalDecs (text "a where clause") ds
- ; returnJustL $ Hs.ValD noExt $
+ ; returnJustL $ Hs.ValD noExtField $
PatBind { pat_lhs = pat'
- , pat_rhs = GRHSs noExt body' (noLoc ds')
- , pat_ext = noExt
+ , pat_rhs = GRHSs noExtField body' (noLoc ds')
+ , pat_ext = noExtField
, pat_ticks = ([],[]) } }
cvtDec (TH.FunD nm cls)
@@ -167,13 +167,13 @@ cvtDec (TH.FunD nm cls)
| otherwise
= do { nm' <- vNameL nm
; cls' <- mapM (cvtClause (mkPrefixFunRhs nm')) cls
- ; returnJustL $ Hs.ValD noExt $ mkFunBind nm' cls' }
+ ; returnJustL $ Hs.ValD noExtField $ mkFunBind nm' cls' }
cvtDec (TH.SigD nm typ)
= do { nm' <- vNameL nm
; ty' <- cvtType typ
- ; returnJustL $ Hs.SigD noExt
- (TypeSig noExt [nm'] (mkLHsSigWcType ty')) }
+ ; returnJustL $ Hs.SigD noExtField
+ (TypeSig noExtField [nm'] (mkLHsSigWcType ty')) }
cvtDec (TH.InfixD fx nm)
-- Fixity signatures are allowed for variables, constructors, and types
@@ -181,8 +181,8 @@ cvtDec (TH.InfixD fx nm)
-- the RdrName says it's a variable or a constructor. So, just assume
-- it's a variable or constructor and proceed.
= do { nm' <- vcNameL nm
- ; returnJustL (Hs.SigD noExt (FixSig noExt
- (FixitySig noExt [nm'] (cvtFixity fx)))) }
+ ; returnJustL (Hs.SigD noExtField (FixSig noExtField
+ (FixitySig noExtField [nm'] (cvtFixity fx)))) }
cvtDec (PragmaD prag)
= cvtPragmaD prag
@@ -190,8 +190,8 @@ cvtDec (PragmaD prag)
cvtDec (TySynD tc tvs rhs)
= do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
; rhs' <- cvtType rhs
- ; returnJustL $ TyClD noExt $
- SynDecl { tcdSExt = noExt, tcdLName = tc', tcdTyVars = tvs'
+ ; returnJustL $ TyClD noExtField $
+ SynDecl { tcdSExt = noExtField, tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdRhs = rhs' } }
@@ -211,33 +211,33 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs)
; ksig' <- cvtKind `traverse` ksig
; cons' <- mapM cvtConstr constrs
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = DataType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = cons', dd_derivs = derivs' }
- ; returnJustL $ TyClD noExt (DataDecl
- { tcdDExt = noExt
- , tcdLName = tc', tcdTyVars = tvs'
- , tcdFixity = Prefix
- , tcdDataDefn = defn }) }
+ ; returnJustL $ TyClD noExtField $
+ DataDecl { tcdDExt = noExtField
+ , tcdLName = tc', tcdTyVars = tvs'
+ , tcdFixity = Prefix
+ , tcdDataDefn = defn } }
cvtDec (NewtypeD ctxt tc tvs ksig constr derivs)
= do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs
; ksig' <- cvtKind `traverse` ksig
; con' <- cvtConstr constr
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = NewType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = [con']
, dd_derivs = derivs' }
- ; returnJustL $ TyClD noExt (DataDecl
- { tcdDExt = noExt
- , tcdLName = tc', tcdTyVars = tvs'
- , tcdFixity = Prefix
- , tcdDataDefn = defn }) }
+ ; returnJustL $ TyClD noExtField $
+ DataDecl { tcdDExt = noExtField
+ , tcdLName = tc', tcdTyVars = tvs'
+ , tcdFixity = Prefix
+ , tcdDataDefn = defn } }
cvtDec (ClassD ctxt cl tvs fds decs)
= do { (cxt', tc', tvs') <- cvt_tycl_hdr ctxt cl tvs
@@ -247,8 +247,8 @@ cvtDec (ClassD ctxt cl tvs fds decs)
(failWith $ (text "Default data instance declarations"
<+> text "are not allowed:")
$$ (Outputable.ppr adts'))
- ; returnJustL $ TyClD noExt $
- ClassDecl { tcdCExt = noExt
+ ; returnJustL $ TyClD noExtField $
+ ClassDecl { tcdCExt = noExtField
, tcdCtxt = cxt', tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs'
@@ -264,8 +264,8 @@ cvtDec (InstanceD o ctxt ty decs)
; ctxt' <- cvtContext funPrec ctxt
; (dL->L loc ty') <- cvtType ty
; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ cL loc ty'
- ; returnJustL $ InstD noExt $ ClsInstD noExt $
- ClsInstDecl { cid_ext = noExt, cid_poly_ty = mkLHsSigType inst_ty'
+ ; returnJustL $ InstD noExtField $ ClsInstD noExtField $
+ ClsInstDecl { cid_ext = noExtField, cid_poly_ty = mkLHsSigType inst_ty'
, cid_binds = binds'
, cid_sigs = Hs.mkClassOpSigs sigs'
, cid_tyfam_insts = ats', cid_datafam_insts = adts'
@@ -283,29 +283,29 @@ cvtDec (InstanceD o ctxt ty decs)
cvtDec (ForeignD ford)
= do { ford' <- cvtForD ford
- ; returnJustL $ ForD noExt ford' }
+ ; returnJustL $ ForD noExtField ford' }
cvtDec (DataFamilyD tc tvs kind)
= do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tvs
; result <- cvtMaybeKindToFamilyResultSig kind
- ; returnJustL $ TyClD noExt $ FamDecl noExt $
- FamilyDecl noExt DataFamily tc' tvs' Prefix result Nothing }
+ ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+ FamilyDecl noExtField DataFamily tc' tvs' Prefix result Nothing }
cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs)
= do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys
; ksig' <- cvtKind `traverse` ksig
; cons' <- mapM cvtConstr constrs
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = DataType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = cons', dd_derivs = derivs' }
- ; returnJustL $ InstD noExt $ DataFamInstD
- { dfid_ext = noExt
+ ; returnJustL $ InstD noExtField $ DataFamInstD
+ { dfid_ext = noExtField
, dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
- FamEqn { feqn_ext = noExt
+ FamEqn { feqn_ext = noExtField
, feqn_tycon = tc'
, feqn_bndrs = bndrs'
, feqn_pats = typats'
@@ -317,15 +317,15 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
; ksig' <- cvtKind `traverse` ksig
; con' <- cvtConstr constr
; derivs' <- cvtDerivs derivs
- ; let defn = HsDataDefn { dd_ext = noExt
+ ; let defn = HsDataDefn { dd_ext = noExtField
, dd_ND = NewType, dd_cType = Nothing
, dd_ctxt = ctxt'
, dd_kindSig = ksig'
, dd_cons = [con'], dd_derivs = derivs' }
- ; returnJustL $ InstD noExt $ DataFamInstD
- { dfid_ext = noExt
+ ; returnJustL $ InstD noExtField $ DataFamInstD
+ { dfid_ext = noExtField
, dfid_inst = DataFamInstDecl { dfid_eqn = mkHsImplicitBndrs $
- FamEqn { feqn_ext = noExt
+ FamEqn { feqn_ext = noExtField
, feqn_tycon = tc'
, feqn_bndrs = bndrs'
, feqn_pats = typats'
@@ -334,35 +334,35 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
cvtDec (TySynInstD eqn)
= do { (dL->L _ eqn') <- cvtTySynEqn eqn
- ; returnJustL $ InstD noExt $ TyFamInstD
- { tfid_ext = noExt
+ ; returnJustL $ InstD noExtField $ TyFamInstD
+ { tfid_ext = noExtField
, tfid_inst = TyFamInstDecl { tfid_eqn = eqn' } } }
cvtDec (OpenTypeFamilyD head)
= do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
- ; returnJustL $ TyClD noExt $ FamDecl noExt $
- FamilyDecl noExt OpenTypeFamily tc' tyvars' Prefix result' injectivity'
+ ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+ FamilyDecl noExtField OpenTypeFamily tc' tyvars' Prefix result' injectivity'
}
cvtDec (ClosedTypeFamilyD head eqns)
= do { (tc', tyvars', result', injectivity') <- cvt_tyfam_head head
; eqns' <- mapM cvtTySynEqn eqns
- ; returnJustL $ TyClD noExt $ FamDecl noExt $
- FamilyDecl noExt (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix
+ ; returnJustL $ TyClD noExtField $ FamDecl noExtField $
+ FamilyDecl noExtField (ClosedTypeFamily (Just eqns')) tc' tyvars' Prefix
result' injectivity' }
cvtDec (TH.RoleAnnotD tc roles)
= do { tc' <- tconNameL tc
; let roles' = map (noLoc . cvtRole) roles
- ; returnJustL $ Hs.RoleAnnotD noExt (RoleAnnotDecl noExt tc' roles') }
+ ; returnJustL $ Hs.RoleAnnotD noExtField (RoleAnnotDecl noExtField tc' roles') }
cvtDec (TH.StandaloneDerivD ds cxt ty)
= do { cxt' <- cvtContext funPrec cxt
; ds' <- traverse cvtDerivStrategy ds
; (dL->L loc ty') <- cvtType ty
; let inst_ty' = mkHsQualTy cxt loc cxt' $ cL loc ty'
- ; returnJustL $ DerivD noExt $
- DerivDecl { deriv_ext =noExt
+ ; returnJustL $ DerivD noExtField $
+ DerivDecl { deriv_ext =noExtField
, deriv_strategy = ds'
, deriv_type = mkLHsSigWcType inst_ty'
, deriv_overlap_mode = Nothing } }
@@ -370,16 +370,16 @@ cvtDec (TH.StandaloneDerivD ds cxt ty)
cvtDec (TH.DefaultSigD nm typ)
= do { nm' <- vNameL nm
; ty' <- cvtType typ
- ; returnJustL $ Hs.SigD noExt
- $ ClassOpSig noExt True [nm'] (mkLHsSigType ty')}
+ ; returnJustL $ Hs.SigD noExtField
+ $ ClassOpSig noExtField True [nm'] (mkLHsSigType ty')}
cvtDec (TH.PatSynD nm args dir pat)
= do { nm' <- cNameL nm
; args' <- cvtArgs args
; dir' <- cvtDir nm' dir
; pat' <- cvtPat pat
- ; returnJustL $ Hs.ValD noExt $ PatSynBind noExt $
- PSB noExt nm' args' pat' dir' }
+ ; returnJustL $ Hs.ValD noExtField $ PatSynBind noExtField $
+ PSB noExtField nm' args' pat' dir' }
where
cvtArgs (TH.PrefixPatSyn args) = Hs.PrefixCon <$> mapM vNameL args
cvtArgs (TH.InfixPatSyn a1 a2) = Hs.InfixCon <$> vNameL a1 <*> vNameL a2
@@ -397,7 +397,7 @@ cvtDec (TH.PatSynD nm args dir pat)
cvtDec (TH.PatSynSigD nm ty)
= do { nm' <- cNameL nm
; ty' <- cvtPatSynSigTy ty
- ; returnJustL $ Hs.SigD noExt $ PatSynSig noExt [nm'] (mkLHsSigType ty')}
+ ; returnJustL $ Hs.SigD noExtField $ PatSynSig noExtField [nm'] (mkLHsSigType ty')}
-- Implicit parameter bindings are handled in cvtLocalDecs and
-- cvtImplicitParamBind. They are not allowed in any other scope, so
@@ -415,7 +415,7 @@ cvtTySynEqn (TySynEqn mb_bndrs lhs rhs)
; rhs' <- cvtType rhs
; let args' = map wrap_tyarg args
; returnL $ mkHsImplicitBndrs
- $ FamEqn { feqn_ext = noExt
+ $ FamEqn { feqn_ext = noExtField
, feqn_tycon = nm'
, feqn_bndrs = mb_bndrs'
, feqn_pats = args'
@@ -425,7 +425,7 @@ cvtTySynEqn (TySynEqn mb_bndrs lhs rhs)
; args' <- mapM cvtType [t1,t2]
; rhs' <- cvtType rhs
; returnL $ mkHsImplicitBndrs
- $ FamEqn { feqn_ext = noExt
+ $ FamEqn { feqn_ext = noExtField
, feqn_tycon = nm'
, feqn_bndrs = mb_bndrs'
, feqn_pats =
@@ -587,7 +587,7 @@ cvtConstr (ForallC tvs ctxt con)
where
all_tvs = hsQTvExplicit tvs' ++ ex_tvs
- add_forall _ _ (XConDecl _) = panic "cvtConstr"
+ add_forall _ _ (XConDecl nec) = noExtCon nec
cvtConstr (GadtC c strtys ty)
= do { c' <- mapM cNameL c
@@ -600,8 +600,8 @@ cvtConstr (RecGadtC c varstrtys ty)
= do { c' <- mapM cNameL c
; ty' <- cvtType ty
; rec_flds <- mapM cvt_id_arg varstrtys
- ; let rec_ty = noLoc (HsFunTy noExt
- (noLoc $ HsRecTy noExt rec_flds) ty')
+ ; let rec_ty = noLoc (HsFunTy noExtField
+ (noLoc $ HsRecTy noExtField rec_flds) ty')
; returnL $ fst $ mkGadtDecl c' rec_ty }
cvtSrcUnpackedness :: TH.SourceUnpackedness -> SrcUnpackedness
@@ -620,16 +620,16 @@ cvt_arg (Bang su ss, ty)
; let ty' = parenthesizeHsType appPrec ty''
su' = cvtSrcUnpackedness su
ss' = cvtSrcStrictness ss
- ; returnL $ HsBangTy noExt (HsSrcBang NoSourceText su' ss') ty' }
+ ; returnL $ HsBangTy noExtField (HsSrcBang NoSourceText su' ss') ty' }
cvt_id_arg :: (TH.Name, TH.Bang, TH.Type) -> CvtM (LConDeclField GhcPs)
cvt_id_arg (i, str, ty)
= do { (dL->L li i') <- vNameL i
; ty' <- cvt_arg (str,ty)
; return $ noLoc (ConDeclField
- { cd_fld_ext = noExt
+ { cd_fld_ext = noExtField
, cd_fld_names
- = [cL li $ FieldOcc noExt (cL li i')]
+ = [cL li $ FieldOcc noExtField (cL li i')]
, cd_fld_type = ty'
, cd_fld_doc = Nothing}) }
@@ -667,7 +667,7 @@ cvtForD (ImportF callconv safety from nm ty)
mk_imp impspec
= do { nm' <- vNameL nm
; ty' <- cvtType ty
- ; return (ForeignImport { fd_i_ext = noExt
+ ; return (ForeignImport { fd_i_ext = noExtField
, fd_name = nm'
, fd_sig_ty = mkLHsSigType ty'
, fd_fi = impspec })
@@ -684,7 +684,7 @@ cvtForD (ExportF callconv as nm ty)
(mkFastString as)
(cvt_conv callconv)))
(noLoc (SourceText as))
- ; return $ ForeignExport { fd_e_ext = noExt
+ ; return $ ForeignExport { fd_e_ext = noExtField
, fd_name = nm'
, fd_sig_ty = mkLHsSigType ty'
, fd_fe = e } }
@@ -712,7 +712,7 @@ cvtPragmaD (InlineP nm inline rm phases)
, inl_rule = cvtRuleMatch rm
, inl_act = cvtPhases phases dflt
, inl_sat = Nothing }
- ; returnJustL $ Hs.SigD noExt $ InlineSig noExt nm' ip }
+ ; returnJustL $ Hs.SigD noExtField $ InlineSig noExtField nm' ip }
cvtPragmaD (SpecialiseP nm ty inline phases)
= do { nm' <- vNameL nm
@@ -730,12 +730,12 @@ cvtPragmaD (SpecialiseP nm ty inline phases)
, inl_rule = Hs.FunLike
, inl_act = cvtPhases phases dflt
, inl_sat = Nothing }
- ; returnJustL $ Hs.SigD noExt $ SpecSig noExt nm' [mkLHsSigType ty'] ip }
+ ; returnJustL $ Hs.SigD noExtField $ SpecSig noExtField nm' [mkLHsSigType ty'] ip }
cvtPragmaD (SpecialiseInstP ty)
= do { ty' <- cvtType ty
- ; returnJustL $ Hs.SigD noExt $
- SpecInstSig noExt (SourceText "{-# SPECIALISE") (mkLHsSigType ty') }
+ ; returnJustL $ Hs.SigD noExtField $
+ SpecInstSig noExtField (SourceText "{-# SPECIALISE") (mkLHsSigType ty') }
cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
= do { let nm' = mkFastString nm
@@ -744,11 +744,11 @@ cvtPragmaD (RuleP nm ty_bndrs tm_bndrs lhs rhs phases)
; tm_bndrs' <- mapM cvtRuleBndr tm_bndrs
; lhs' <- cvtl lhs
; rhs' <- cvtl rhs
- ; returnJustL $ Hs.RuleD noExt
- $ HsRules { rds_ext = noExt
+ ; returnJustL $ Hs.RuleD noExtField
+ $ HsRules { rds_ext = noExtField
, rds_src = SourceText "{-# RULES"
, rds_rules = [noLoc $
- HsRule { rd_ext = noExt
+ HsRule { rd_ext = noExtField
, rd_name = (noLoc (quotedSourceText nm,nm'))
, rd_act = act
, rd_tyvs = ty_bndrs'
@@ -768,8 +768,8 @@ cvtPragmaD (AnnP target exp)
ValueAnnotation n -> do
n' <- vcName n
return (ValueAnnProvenance (noLoc n'))
- ; returnJustL $ Hs.AnnD noExt
- $ HsAnnotation noExt (SourceText "{-# ANN") target' exp'
+ ; returnJustL $ Hs.AnnD noExtField
+ $ HsAnnotation noExtField (SourceText "{-# ANN") target' exp'
}
cvtPragmaD (LineP line file)
@@ -779,8 +779,8 @@ cvtPragmaD (LineP line file)
cvtPragmaD (CompleteP cls mty)
= do { cls' <- noLoc <$> mapM cNameL cls
; mty' <- traverse tconNameL mty
- ; returnJustL $ Hs.SigD noExt
- $ CompleteMatchSig noExt NoSourceText cls' mty' }
+ ; returnJustL $ Hs.SigD noExtField
+ $ CompleteMatchSig noExtField NoSourceText cls' mty' }
dfltActivation :: TH.Inline -> Activation
dfltActivation TH.NoInline = NeverActive
@@ -803,11 +803,11 @@ cvtPhases (BeforePhase i) _ = ActiveBefore NoSourceText i
cvtRuleBndr :: TH.RuleBndr -> CvtM (Hs.LRuleBndr GhcPs)
cvtRuleBndr (RuleVar n)
= do { n' <- vNameL n
- ; return $ noLoc $ Hs.RuleBndr noExt n' }
+ ; return $ noLoc $ Hs.RuleBndr noExtField n' }
cvtRuleBndr (TypedRuleVar n ty)
= do { n' <- vNameL n
; ty' <- cvtType ty
- ; return $ noLoc $ Hs.RuleBndrSig noExt n' $ mkLHsSigWcType ty' }
+ ; return $ noLoc $ Hs.RuleBndrSig noExtField n' $ mkLHsSigWcType ty' }
---------------------------------------------------
-- Declarations
@@ -816,16 +816,16 @@ cvtRuleBndr (TypedRuleVar n ty)
cvtLocalDecs :: MsgDoc -> [TH.Dec] -> CvtM (HsLocalBinds GhcPs)
cvtLocalDecs doc ds
= case partitionWith is_ip_bind ds of
- ([], []) -> return (EmptyLocalBinds noExt)
+ ([], []) -> return (EmptyLocalBinds noExtField)
([], _) -> do
ds' <- cvtDecs ds
let (binds, prob_sigs) = partitionWith is_bind ds'
let (sigs, bads) = partitionWith is_sig prob_sigs
unless (null bads) (failWith (mkBadDecMsg doc bads))
- return (HsValBinds noExt (ValBinds noExt (listToBag binds) sigs))
+ return (HsValBinds noExtField (ValBinds noExtField (listToBag binds) sigs))
(ip_binds, []) -> do
binds <- mapM (uncurry cvtImplicitParamBind) ip_binds
- return (HsIPBinds noExt (IPBinds noExt binds))
+ return (HsIPBinds noExtField (IPBinds noExtField binds))
((_:_), (_:_)) ->
failWith (text "Implicit parameters mixed with other bindings")
@@ -836,13 +836,13 @@ cvtClause ctxt (Clause ps body wheres)
; let pps = map (parenthesizePat appPrec) ps'
; g' <- cvtGuard body
; ds' <- cvtLocalDecs (text "a where clause") wheres
- ; returnL $ Hs.Match noExt ctxt pps (GRHSs noExt g' (noLoc ds')) }
+ ; returnL $ Hs.Match noExtField ctxt pps (GRHSs noExtField g' (noLoc ds')) }
cvtImplicitParamBind :: String -> TH.Exp -> CvtM (LIPBind GhcPs)
cvtImplicitParamBind n e = do
n' <- wrapL (ipName n)
e' <- cvtl e
- returnL (IPBind noExt (Left n') e')
+ returnL (IPBind noExtField (Left n') e')
-------------------------------------------------------------------
-- Expressions
@@ -851,12 +851,12 @@ cvtImplicitParamBind n e = do
cvtl :: TH.Exp -> CvtM (LHsExpr GhcPs)
cvtl e = wrapL (cvt e)
where
- cvt (VarE s) = do { s' <- vName s; return $ HsVar noExt (noLoc s') }
- cvt (ConE s) = do { s' <- cName s; return $ HsVar noExt (noLoc s') }
+ cvt (VarE s) = do { s' <- vName s; return $ HsVar noExtField (noLoc s') }
+ cvt (ConE s) = do { s' <- cName s; return $ HsVar noExtField (noLoc s') }
cvt (LitE l)
- | overloadedLit l = go cvtOverLit (HsOverLit noExt)
+ | overloadedLit l = go cvtOverLit (HsOverLit noExtField)
(hsOverLitNeedsParens appPrec)
- | otherwise = go cvtLit (HsLit noExt)
+ | otherwise = go cvtLit (HsLit noExtField)
(hsLitNeedsParens appPrec)
where
go :: (Lit -> CvtM (l GhcPs))
@@ -866,17 +866,17 @@ cvtl e = wrapL (cvt e)
go cvt_lit mk_expr is_compound_lit = do
l' <- cvt_lit l
let e' = mk_expr l'
- return $ if is_compound_lit l' then HsPar noExt (noLoc e') else e'
+ return $ if is_compound_lit l' then HsPar noExtField (noLoc e') else e'
cvt (AppE x@(LamE _ _) y) = do { x' <- cvtl x; y' <- cvtl y
- ; return $ HsApp noExt (mkLHsPar x')
+ ; return $ HsApp noExtField (mkLHsPar x')
(mkLHsPar y')}
cvt (AppE x y) = do { x' <- cvtl x; y' <- cvtl y
- ; return $ HsApp noExt (mkLHsPar x')
+ ; return $ HsApp noExtField (mkLHsPar x')
(mkLHsPar y')}
cvt (AppTypeE e t) = do { e' <- cvtl e
; t' <- cvtType t
; let tp = parenthesizeHsType appPrec t'
- ; return $ HsAppType noExt e'
+ ; return $ HsAppType noExtField e'
$ mkHsWildCardBndrs tp }
cvt (LamE [] e) = cvt e -- Degenerate case. We convert the body as its
-- own expression to avoid pretty-printing
@@ -884,44 +884,44 @@ cvtl e = wrapL (cvt e)
-- lambda expressions. See #13856.
cvt (LamE ps e) = do { ps' <- cvtPats ps; e' <- cvtl e
; let pats = map (parenthesizePat appPrec) ps'
- ; return $ HsLam noExt (mkMatchGroup FromSource
+ ; return $ HsLam noExtField (mkMatchGroup FromSource
[mkSimpleMatch LambdaExpr
pats e'])}
cvt (LamCaseE ms) = do { ms' <- mapM (cvtMatch CaseAlt) ms
- ; return $ HsLamCase noExt
+ ; return $ HsLamCase noExtField
(mkMatchGroup FromSource ms')
}
- cvt (TupE [Just e]) = do { e' <- cvtl e; return $ HsPar noExt e' }
+ cvt (TupE [Just e]) = do { e' <- cvtl e; return $ HsPar noExtField e' }
-- Note [Dropping constructors]
-- Singleton tuples treated like nothing (just parens)
cvt (TupE es) = cvt_tup es Boxed
cvt (UnboxedTupE es) = cvt_tup es Unboxed
cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e
; unboxedSumChecks alt arity
- ; return $ ExplicitSum noExt
+ ; return $ ExplicitSum noExtField
alt arity e'}
cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
- ; return $ HsIf noExt (Just noSyntaxExpr) x' y' z' }
+ ; return $ HsIf noExtField (Just noSyntaxExpr) x' y' z' }
cvt (MultiIfE alts)
| null alts = failWith (text "Multi-way if-expression with no alternatives")
| otherwise = do { alts' <- mapM cvtpair alts
- ; return $ HsMultiIf noExt alts' }
+ ; return $ HsMultiIf noExtField alts' }
cvt (LetE ds e) = do { ds' <- cvtLocalDecs (text "a let expression") ds
- ; e' <- cvtl e; return $ HsLet noExt (noLoc ds') e'}
+ ; e' <- cvtl e; return $ HsLet noExtField (noLoc ds') e'}
cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM (cvtMatch CaseAlt) ms
- ; return $ HsCase noExt e'
+ ; return $ HsCase noExtField e'
(mkMatchGroup FromSource ms') }
cvt (DoE ss) = cvtHsDo DoExpr ss
cvt (MDoE ss) = cvtHsDo MDoExpr ss
cvt (CompE ss) = cvtHsDo ListComp ss
cvt (ArithSeqE dd) = do { dd' <- cvtDD dd
- ; return $ ArithSeq noExt Nothing dd' }
+ ; return $ ArithSeq noExtField Nothing dd' }
cvt (ListE xs)
| Just s <- allCharLs xs = do { l' <- cvtLit (StringL s)
- ; return (HsLit noExt l') }
+ ; return (HsLit noExtField l') }
-- Note [Converting strings]
| otherwise = do { xs' <- mapM cvtl xs
- ; return $ ExplicitList noExt Nothing xs'
+ ; return $ ExplicitList noExtField Nothing xs'
}
-- Infix expressions
@@ -931,25 +931,25 @@ cvtl e = wrapL (cvt e)
; y' <- cvtl y
; let px = parenthesizeHsExpr opPrec x'
py = parenthesizeHsExpr opPrec y'
- ; wrapParL (HsPar noExt)
- $ OpApp noExt px s' py }
+ ; wrapParL (HsPar noExtField)
+ $ OpApp noExtField px s' py }
-- Parenthesise both arguments and result,
-- to ensure this operator application does
-- does not get re-associated
-- See Note [Operator association]
cvt (InfixE Nothing s (Just y)) = ensureValidOpExp s $
do { s' <- cvtl s; y' <- cvtl y
- ; wrapParL (HsPar noExt) $
- SectionR noExt s' y' }
+ ; wrapParL (HsPar noExtField) $
+ SectionR noExtField s' y' }
-- See Note [Sections in HsSyn] in HsExpr
cvt (InfixE (Just x) s Nothing ) = ensureValidOpExp s $
do { x' <- cvtl x; s' <- cvtl s
- ; wrapParL (HsPar noExt) $
- SectionL noExt x' s' }
+ ; wrapParL (HsPar noExtField) $
+ SectionL noExtField x' s' }
cvt (InfixE Nothing s Nothing ) = ensureValidOpExp s $
do { s' <- cvtl s
- ; return $ HsPar noExt s' }
+ ; return $ HsPar noExtField s' }
-- Can I indicate this is an infix thing?
-- Note [Dropping constructors]
@@ -960,10 +960,10 @@ cvtl e = wrapL (cvt e)
_ -> mkLHsPar x'
; cvtOpApp x'' s y } -- Note [Converting UInfix]
- cvt (ParensE e) = do { e' <- cvtl e; return $ HsPar noExt e' }
+ cvt (ParensE e) = do { e' <- cvtl e; return $ HsPar noExtField e' }
cvt (SigE e t) = do { e' <- cvtl e; t' <- cvtType t
; let pe = parenthesizeHsExpr sigPrec e'
- ; return $ ExprWithTySig noExt pe (mkLHsSigWcType t') }
+ ; return $ ExprWithTySig noExtField pe (mkLHsSigWcType t') }
cvt (RecConE c flds) = do { c' <- cNameL c
; flds' <- mapM (cvtFld (mkFieldOcc . noLoc)) flds
; return $ mkRdrRecordCon c' (HsRecFields flds' Nothing) }
@@ -972,14 +972,14 @@ cvtl e = wrapL (cvt e)
<- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc))
flds
; return $ mkRdrRecordUpd e' flds' }
- cvt (StaticE e) = fmap (HsStatic noExt) $ cvtl e
+ cvt (StaticE e) = fmap (HsStatic noExtField) $ cvtl e
cvt (UnboundVarE s) = do -- Use of 'vcName' here instead of 'vName' is
-- important, because UnboundVarE may contain
-- constructor names - see #14627.
{ s' <- vcName s
- ; return $ HsVar noExt (noLoc s') }
- cvt (LabelE s) = do { return $ HsOverLabel noExt Nothing (fsLit s) }
- cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExt n' }
+ ; return $ HsVar noExtField (noLoc s') }
+ cvt (LabelE s) = do { return $ HsOverLabel noExtField Nothing (fsLit s) }
+ cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExtField n' }
{- | #16895 Ensure an infix expression's operator is a variable/constructor.
Consider this example:
@@ -1031,10 +1031,10 @@ cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; retur
cvt_tup :: [Maybe Exp] -> Boxity -> CvtM (HsExpr GhcPs)
cvt_tup es boxity = do { let cvtl_maybe Nothing = return missingTupArg
- cvtl_maybe (Just e) = fmap (Present noExt) (cvtl e)
+ cvtl_maybe (Just e) = fmap (Present noExtField) (cvtl e)
; es' <- mapM cvtl_maybe es
; return $ ExplicitTuple
- noExt
+ noExtField
(map noLoc es')
boxity }
@@ -1097,7 +1097,7 @@ cvtOpApp x op1 (UInfixE y op2 z)
cvtOpApp x op y
= do { op' <- cvtl op
; y' <- cvtl y
- ; return (OpApp noExt x op' y') }
+ ; return (OpApp noExtField x op' y') }
-------------------------------------
-- Do notation and statements
@@ -1115,7 +1115,7 @@ cvtHsDo do_or_lc stmts
-> return (cL loc (mkLastStmt body))
_ -> failWith (bad_last last')
- ; return $ HsDo noExt do_or_lc (noLoc (stmts'' ++ [last''])) }
+ ; return $ HsDo noExtField do_or_lc (noLoc (stmts'' ++ [last''])) }
where
bad_last stmt = vcat [ text "Illegal last statement of" <+> pprAStmtContext do_or_lc <> colon
, nest 2 $ Outputable.ppr stmt
@@ -1128,12 +1128,12 @@ cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt GhcPs (LHsExpr GhcPs))
cvtStmt (NoBindS e) = do { e' <- cvtl e; returnL $ mkBodyStmt e' }
cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
cvtStmt (TH.LetS ds) = do { ds' <- cvtLocalDecs (text "a let binding") ds
- ; returnL $ LetStmt noExt (noLoc ds') }
+ ; returnL $ LetStmt noExtField (noLoc ds') }
cvtStmt (TH.ParS dss) = do { dss' <- mapM cvt_one dss
- ; returnL $ ParStmt noExt dss' noExpr noSyntaxExpr }
+ ; returnL $ ParStmt noExtField dss' noExpr noSyntaxExpr }
where
cvt_one ds = do { ds' <- cvtStmts ds
- ; return (ParStmtBlock noExt ds' undefined noSyntaxExpr) }
+ ; return (ParStmtBlock noExtField ds' undefined noSyntaxExpr) }
cvtStmt (TH.RecS ss) = do { ss' <- mapM cvtStmt ss; returnL (mkRecStmt ss') }
cvtMatch :: HsMatchContext RdrName
@@ -1141,23 +1141,23 @@ cvtMatch :: HsMatchContext RdrName
cvtMatch ctxt (TH.Match p body decs)
= do { p' <- cvtPat p
; let lp = case p' of
- (dL->L loc SigPat{}) -> cL loc (ParPat NoExt p') -- #14875
+ (dL->L loc SigPat{}) -> cL loc (ParPat noExtField p') -- #14875
_ -> p'
; g' <- cvtGuard body
; decs' <- cvtLocalDecs (text "a where clause") decs
- ; returnL $ Hs.Match noExt ctxt [lp] (GRHSs noExt g' (noLoc decs')) }
+ ; returnL $ Hs.Match noExtField ctxt [lp] (GRHSs noExtField g' (noLoc decs')) }
cvtGuard :: TH.Body -> CvtM [LGRHS GhcPs (LHsExpr GhcPs)]
cvtGuard (GuardedB pairs) = mapM cvtpair pairs
cvtGuard (NormalB e) = do { e' <- cvtl e
- ; g' <- returnL $ GRHS noExt [] e'; return [g'] }
+ ; g' <- returnL $ GRHS noExtField [] e'; return [g'] }
cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS GhcPs (LHsExpr GhcPs))
cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs
; g' <- returnL $ mkBodyStmt ge'
- ; returnL $ GRHS noExt [g'] rhs' }
+ ; returnL $ GRHS noExtField [g'] rhs' }
cvtpair (PatG gs,rhs) = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
- ; returnL $ GRHS noExt gs' rhs' }
+ ; returnL $ GRHS noExtField gs' rhs' }
cvtOverLit :: Lit -> CvtM (HsOverLit GhcPs)
cvtOverLit (IntegerL i)
@@ -1198,9 +1198,9 @@ cvtLit :: Lit -> CvtM (HsLit GhcPs)
cvtLit (IntPrimL i) = do { force i; return $ HsIntPrim NoSourceText i }
cvtLit (WordPrimL w) = do { force w; return $ HsWordPrim NoSourceText w }
cvtLit (FloatPrimL f)
- = do { force f; return $ HsFloatPrim noExt (mkFractionalLit f) }
+ = do { force f; return $ HsFloatPrim noExtField (mkFractionalLit f) }
cvtLit (DoublePrimL f)
- = do { force f; return $ HsDoublePrim noExt (mkFractionalLit f) }
+ = do { force f; return $ HsDoublePrim noExtField (mkFractionalLit f) }
cvtLit (CharL c) = do { force c; return $ HsChar NoSourceText c }
cvtLit (CharPrimL c) = do { force c; return $ HsCharPrim NoSourceText c }
cvtLit (StringL s) = do { let { s' = mkFastString s }
@@ -1234,24 +1234,24 @@ cvtp (TH.LitP l)
; return (mkNPat (noLoc l') Nothing) }
-- Not right for negative patterns;
-- need to think about that!
- | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat noExt l' }
+ | otherwise = do { l' <- cvtLit l; return $ Hs.LitPat noExtField l' }
cvtp (TH.VarP s) = do { s' <- vName s
- ; return $ Hs.VarPat noExt (noLoc s') }
-cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat noExt p' }
+ ; return $ Hs.VarPat noExtField (noLoc s') }
+cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat noExtField p' }
-- Note [Dropping constructors]
cvtp (TupP ps) = do { ps' <- cvtPats ps
- ; return $ TuplePat noExt ps' Boxed }
+ ; return $ TuplePat noExtField ps' Boxed }
cvtp (UnboxedTupP ps) = do { ps' <- cvtPats ps
- ; return $ TuplePat noExt ps' Unboxed }
+ ; return $ TuplePat noExtField ps' Unboxed }
cvtp (UnboxedSumP p alt arity)
= do { p' <- cvtPat p
; unboxedSumChecks alt arity
- ; return $ SumPat noExt p' alt arity }
+ ; return $ SumPat noExtField p' alt arity }
cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps
; let pps = map (parenthesizePat appPrec) ps'
; return $ ConPatIn s' (PrefixCon pps) }
cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
- ; wrapParL (ParPat noExt) $
+ ; wrapParL (ParPat noExtField) $
ConPatIn s' $
InfixCon (parenthesizePat opPrec p1')
(parenthesizePat opPrec p2') }
@@ -1260,22 +1260,22 @@ cvtp (UInfixP p1 s p2) = do { p1' <- cvtPat p1; cvtOpAppP p1' s p2 } -- Note [Co
cvtp (ParensP p) = do { p' <- cvtPat p;
; case unLoc p' of -- may be wrapped ConPatIn
ParPat {} -> return $ unLoc p'
- _ -> return $ ParPat noExt p' }
-cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat noExt p' }
-cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat noExt p' }
+ _ -> return $ ParPat noExtField p' }
+cvtp (TildeP p) = do { p' <- cvtPat p; return $ LazyPat noExtField p' }
+cvtp (BangP p) = do { p' <- cvtPat p; return $ BangPat noExtField p' }
cvtp (TH.AsP s p) = do { s' <- vNameL s; p' <- cvtPat p
- ; return $ AsPat noExt s' p' }
-cvtp TH.WildP = return $ WildPat noExt
+ ; return $ AsPat noExtField s' p' }
+cvtp TH.WildP = return $ WildPat noExtField
cvtp (RecP c fs) = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs
; return $ ConPatIn c'
$ Hs.RecCon (HsRecFields fs' Nothing) }
cvtp (ListP ps) = do { ps' <- cvtPats ps
; return
- $ ListPat noExt ps'}
+ $ ListPat noExtField ps'}
cvtp (SigP p t) = do { p' <- cvtPat p; t' <- cvtType t
- ; return $ SigPat noExt p' (mkLHsSigWcType t') }
+ ; return $ SigPat noExtField p' (mkLHsSigWcType t') }
cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
- ; return $ ViewPat noExt e' p'}
+ ; return $ ViewPat noExtField e' p'}
cvtPatFld :: (TH.Name, TH.Pat) -> CvtM (LHsRecField GhcPs (LPat GhcPs))
cvtPatFld (s,p)
@@ -1309,11 +1309,11 @@ cvtTvs tvs = do { tvs' <- mapM cvt_tv tvs; return (mkHsQTvs tvs') }
cvt_tv :: TH.TyVarBndr -> CvtM (LHsTyVarBndr GhcPs)
cvt_tv (TH.PlainTV nm)
= do { nm' <- tNameL nm
- ; returnL $ UserTyVar noExt nm' }
+ ; returnL $ UserTyVar noExtField nm' }
cvt_tv (TH.KindedTV nm ki)
= do { nm' <- tNameL nm
; ki' <- cvtKind ki
- ; returnL $ KindedTyVar noExt nm' ki' }
+ ; returnL $ KindedTyVar noExtField nm' ki' }
cvtRole :: TH.Role -> Maybe Coercion.Role
cvtRole TH.NominalR = Just Coercion.Nominal
@@ -1333,7 +1333,7 @@ cvtDerivClause :: TH.DerivClause
cvtDerivClause (TH.DerivClause ds ctxt)
= do { ctxt' <- fmap (map mkLHsSigType) <$> cvtContext appPrec ctxt
; ds' <- traverse cvtDerivStrategy ds
- ; returnL $ HsDerivingClause noExt ds' ctxt' }
+ ; returnL $ HsDerivingClause noExtField ds' ctxt' }
cvtDerivStrategy :: TH.DerivStrategy -> CvtM (Hs.LDerivStrategy GhcPs)
cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy
@@ -1359,21 +1359,21 @@ cvtTypeKind ty_str ty
, normals `lengthIs` n -- Saturated
-> if n==1 then return (head normals) -- Singleton tuples treated
-- like nothing (ie just parens)
- else returnL (HsTupleTy noExt
+ else returnL (HsTupleTy noExtField
HsBoxedOrConstraintTuple normals)
| n == 1
-> failWith (ptext (sLit ("Illegal 1-tuple " ++ ty_str ++ " constructor")))
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n))))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Boxed n))))
tys'
UnboxedTupleT n
| Just normals <- m_normals
, normals `lengthIs` n -- Saturated
- -> returnL (HsTupleTy noExt HsUnboxedTuple normals)
+ -> returnL (HsTupleTy noExtField HsUnboxedTuple normals)
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n))))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName (tupleTyCon Unboxed n))))
tys'
UnboxedSumT n
| n < 2
@@ -1383,37 +1383,37 @@ cvtTypeKind ty_str ty
text "Sums must have an arity of at least 2" ]
| Just normals <- m_normals
, normals `lengthIs` n -- Saturated
- -> returnL (HsSumTy noExt normals)
+ -> returnL (HsSumTy noExtField normals)
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName (sumTyCon n))))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName (sumTyCon n))))
tys'
ArrowT
| Just normals <- m_normals
, [x',y'] <- normals -> do
x'' <- case unLoc x' of
- HsFunTy{} -> returnL (HsParTy noExt x')
- HsForAllTy{} -> returnL (HsParTy noExt x') -- #14646
- HsQualTy{} -> returnL (HsParTy noExt x') -- #15324
+ HsFunTy{} -> returnL (HsParTy noExtField x')
+ HsForAllTy{} -> returnL (HsParTy noExtField x') -- #14646
+ HsQualTy{} -> returnL (HsParTy noExtField x') -- #15324
_ -> return $
parenthesizeHsType sigPrec x'
let y'' = parenthesizeHsType sigPrec y'
- returnL (HsFunTy noExt x'' y'')
+ returnL (HsFunTy noExtField x'' y'')
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName funTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName funTyCon)))
tys'
ListT
| Just normals <- m_normals
, [x'] <- normals -> do
- returnL (HsListTy noExt x')
+ returnL (HsListTy noExtField x')
| otherwise
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName listTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName listTyCon)))
tys'
VarT nm -> do { nm' <- tNameL nm
- ; mk_apps (HsTyVar noExt NotPromoted nm') tys' }
+ ; mk_apps (HsTyVar noExtField NotPromoted nm') tys' }
ConT nm -> do { nm' <- tconName nm
; -- ConT can contain both data constructor (i.e.,
-- promoted) names and other (i.e, unpromoted)
@@ -1422,7 +1422,7 @@ cvtTypeKind ty_str ty
let prom = if isRdrDataCon nm'
then IsPromoted
else NotPromoted
- ; mk_apps (HsTyVar noExt prom (noLoc nm')) tys'}
+ ; mk_apps (HsTyVar noExtField prom (noLoc nm')) tys'}
ForallT tvs cxt ty
| null tys'
@@ -1445,11 +1445,11 @@ cvtTypeKind ty_str ty
SigT ty ki
-> do { ty' <- cvtType ty
; ki' <- cvtKind ki
- ; mk_apps (HsKindSig noExt ty' ki') tys'
+ ; mk_apps (HsKindSig noExtField ty' ki') tys'
}
LitT lit
- -> mk_apps (HsTyLit noExt (cvtTyLit lit)) tys'
+ -> mk_apps (HsTyLit noExtField (cvtTyLit lit)) tys'
WildCardT
-> mk_apps mkAnonWildCardTy tys'
@@ -1459,7 +1459,7 @@ cvtTypeKind ty_str ty
; t1' <- cvtType t1
; t2' <- cvtType t2
; mk_apps
- (HsTyVar noExt NotPromoted (noLoc s'))
+ (HsTyVar noExtField NotPromoted (noLoc s'))
([HsValArg t1', HsValArg t2'] ++ tys')
}
@@ -1471,11 +1471,11 @@ cvtTypeKind ty_str ty
ParensT t
-> do { t' <- cvtType t
- ; mk_apps (HsParTy noExt t') tys'
+ ; mk_apps (HsParTy noExtField t') tys'
}
PromotedT nm -> do { nm' <- cName nm
- ; mk_apps (HsTyVar noExt IsPromoted (noLoc nm'))
+ ; mk_apps (HsTyVar noExtField IsPromoted (noLoc nm'))
tys' }
-- Promoted data constructor; hence cName
@@ -1484,34 +1484,34 @@ cvtTypeKind ty_str ty
-> failWith (ptext (sLit ("Illegal promoted 1-tuple " ++ ty_str)))
| Just normals <- m_normals
, normals `lengthIs` n -- Saturated
- -> returnL (HsExplicitTupleTy noExt normals)
+ -> returnL (HsExplicitTupleTy noExtField normals)
| otherwise
-> mk_apps
- (HsTyVar noExt IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n))))
+ (HsTyVar noExtField IsPromoted (noLoc (getRdrName (tupleDataCon Boxed n))))
tys'
PromotedNilT
- -> mk_apps (HsExplicitListTy noExt IsPromoted []) tys'
+ -> mk_apps (HsExplicitListTy noExtField IsPromoted []) tys'
PromotedConsT -- See Note [Representing concrete syntax in types]
-- in Language.Haskell.TH.Syntax
| Just normals <- m_normals
, [ty1, dL->L _ (HsExplicitListTy _ ip tys2)] <- normals
-> do
- returnL (HsExplicitListTy noExt ip (ty1:tys2))
+ returnL (HsExplicitListTy noExtField ip (ty1:tys2))
| otherwise
-> mk_apps
- (HsTyVar noExt IsPromoted (noLoc (getRdrName consDataCon)))
+ (HsTyVar noExtField IsPromoted (noLoc (getRdrName consDataCon)))
tys'
StarT
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName liftedTypeKindTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName liftedTypeKindTyCon)))
tys'
ConstraintT
-> mk_apps
- (HsTyVar noExt NotPromoted (noLoc (getRdrName constraintKindTyCon)))
+ (HsTyVar noExtField NotPromoted (noLoc (getRdrName constraintKindTyCon)))
tys'
EqualityT
@@ -1519,18 +1519,18 @@ cvtTypeKind ty_str ty
, [x',y'] <- normals ->
let px = parenthesizeHsType opPrec x'
py = parenthesizeHsType opPrec y'
- in returnL (HsOpTy noExt px (noLoc eqTyCon_RDR) py)
+ in returnL (HsOpTy noExtField px (noLoc eqTyCon_RDR) py)
-- The long-term goal is to remove the above case entirely and
-- subsume it under the case for InfixT. See #15815, comment:6,
-- for more details.
| otherwise ->
- mk_apps (HsTyVar noExt NotPromoted
+ mk_apps (HsTyVar noExtField NotPromoted
(noLoc eqTyCon_RDR)) tys'
ImplicitParamT n t
-> do { n' <- wrapL $ ipName n
; t' <- cvtType t
- ; returnL (HsIParamTy noExt n' t')
+ ; returnL (HsIParamTy noExtField n' t')
}
_ -> failWith (ptext (sLit ("Malformed " ++ ty_str)) <+> text (show ty))
@@ -1551,16 +1551,16 @@ mk_apps head_ty type_args = do
go (arg:args) =
case arg of
HsValArg ty -> do p_ty <- add_parens ty
- mk_apps (HsAppTy noExt phead_ty p_ty) args
+ mk_apps (HsAppTy noExtField phead_ty p_ty) args
HsTypeArg l ki -> do p_ki <- add_parens ki
mk_apps (HsAppKindTy l phead_ty p_ki) args
- HsArgPar _ -> mk_apps (HsParTy noExt phead_ty) args
+ HsArgPar _ -> mk_apps (HsParTy noExtField phead_ty) args
go type_args
where
-- See Note [Adding parens for splices]
add_parens lt@(dL->L _ t)
- | hsTypeNeedsParens appPrec t = returnL (HsParTy noExt lt)
+ | hsTypeNeedsParens appPrec t = returnL (HsParTy noExtField lt)
| otherwise = return lt
wrap_tyarg :: LHsTypeArg GhcPs -> LHsTypeArg GhcPs
@@ -1596,7 +1596,7 @@ mk_arr_apps :: [LHsType GhcPs] -> HsType GhcPs -> CvtM (LHsType GhcPs)
mk_arr_apps tys return_ty = foldrM go return_ty tys >>= returnL
where go :: LHsType GhcPs -> HsType GhcPs -> CvtM (HsType GhcPs)
go arg ret_ty = do { ret_ty_l <- returnL ret_ty
- ; return (HsFunTy noExt arg ret_ty_l) }
+ ; return (HsFunTy noExtField arg ret_ty_l) }
split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsTypeArg GhcPs])
split_ty_app ty = go ty []
@@ -1634,18 +1634,18 @@ cvtKind = cvtTypeKind "kind"
-- signature is possible).
cvtMaybeKindToFamilyResultSig :: Maybe TH.Kind
-> CvtM (LFamilyResultSig GhcPs)
-cvtMaybeKindToFamilyResultSig Nothing = returnL (Hs.NoSig noExt)
+cvtMaybeKindToFamilyResultSig Nothing = returnL (Hs.NoSig noExtField)
cvtMaybeKindToFamilyResultSig (Just ki) = do { ki' <- cvtKind ki
- ; returnL (Hs.KindSig noExt ki') }
+ ; returnL (Hs.KindSig noExtField ki') }
-- | Convert type family result signature. Used with both open and closed type
-- families.
cvtFamilyResultSig :: TH.FamilyResultSig -> CvtM (Hs.LFamilyResultSig GhcPs)
-cvtFamilyResultSig TH.NoSig = returnL (Hs.NoSig noExt)
+cvtFamilyResultSig TH.NoSig = returnL (Hs.NoSig noExtField)
cvtFamilyResultSig (TH.KindSig ki) = do { ki' <- cvtKind ki
- ; returnL (Hs.KindSig noExt ki') }
+ ; returnL (Hs.KindSig noExtField ki') }
cvtFamilyResultSig (TH.TyVarSig bndr) = do { tv <- cvt_tv bndr
- ; returnL (Hs.TyVarSig noExt tv) }
+ ; returnL (Hs.TyVarSig noExtField tv) }
-- | Convert injectivity annotation of a type family.
cvtInjectivityAnnotation :: TH.InjectivityAnn
@@ -1664,7 +1664,7 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
| null univs, null reqs = do { l <- getL
; ty' <- cvtType (ForallT exis provs ty)
; return $ cL l (HsQualTy { hst_ctxt = cL l []
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = ty' }) }
| null reqs = do { l <- getL
; univs' <- hsQTvExplicit <$> cvtTvs univs
@@ -1672,10 +1672,10 @@ cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty))
; let forTy = HsForAllTy
{ hst_fvf = ForallInvis
, hst_bndrs = univs'
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = cL l cxtTy }
cxtTy = HsQualTy { hst_ctxt = cL l []
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = ty' }
; return $ cL l forTy }
| otherwise = cvtType (ForallT univs reqs (ForallT exis provs ty))
@@ -1738,7 +1738,7 @@ mkHsForAllTy tvs loc fvf tvs' rho_ty
| null tvs = rho_ty
| otherwise = cL loc $ HsForAllTy { hst_fvf = fvf
, hst_bndrs = hsQTvExplicit tvs'
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = rho_ty }
-- | If passed an empty 'TH.Cxt', this simply returns the third argument
@@ -1761,7 +1761,7 @@ mkHsQualTy :: TH.Cxt
-- ^ The complete type, qualified with a context if necessary
mkHsQualTy ctxt loc ctxt' ty
| null ctxt = ty
- | otherwise = cL loc $ HsQualTy { hst_xqual = noExt
+ | otherwise = cL loc $ HsQualTy { hst_xqual = noExtField
, hst_ctxt = ctxt'
, hst_body = ty }
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index 1763c3f2de39fa391727410a676cb9ada2543003..c5fadc0b4a1c81e717f3c6c188ecea8fe5bcb14f 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -94,10 +94,10 @@ data HsLocalBindsLR idL idR
| XHsLocalBindsLR
(XXHsLocalBindsLR idL idR)
-type instance XHsValBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt
+type instance XHsValBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)
@@ -135,7 +135,7 @@ data NHsValBindsLR idL
[(RecFlag, LHsBinds idL)]
[LSig GhcRn]
-type instance XValBinds (GhcPass pL) (GhcPass pR) = NoExt
+type instance XValBinds (GhcPass pL) (GhcPass pR) = NoExtField
type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
= NHsValBindsLR (GhcPass pL)
@@ -319,18 +319,18 @@ data NPatBindTc = NPatBindTc {
pat_rhs_ty :: Type -- ^ Type of the GRHSs
} deriving Data
-type instance XFunBind (GhcPass pL) GhcPs = NoExt
+type instance XFunBind (GhcPass pL) GhcPs = NoExtField
type instance XFunBind (GhcPass pL) GhcRn = NameSet -- Free variables
type instance XFunBind (GhcPass pL) GhcTc = NameSet -- Free variables
-type instance XPatBind GhcPs (GhcPass pR) = NoExt
+type instance XPatBind GhcPs (GhcPass pR) = NoExtField
type instance XPatBind GhcRn (GhcPass pR) = NameSet -- Free variables
type instance XPatBind GhcTc (GhcPass pR) = NPatBindTc
-type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExt
-type instance XAbsBinds (GhcPass pL) (GhcPass pR) = NoExt
-type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt
-type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt
+type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XAbsBinds (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon
-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
@@ -356,8 +356,8 @@ data ABExport p
}
| XABExport (XXABExport p)
-type instance XABE (GhcPass p) = NoExt
-type instance XXABExport (GhcPass p) = NoExt
+type instance XABE (GhcPass p) = NoExtField
+type instance XXABExport (GhcPass p) = NoExtCon
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
@@ -379,11 +379,11 @@ data PatSynBind idL idR
}
| XPatSynBind (XXPatSynBind idL idR)
-type instance XPSB (GhcPass idL) GhcPs = NoExt
+type instance XPSB (GhcPass idL) GhcPs = NoExtField
type instance XPSB (GhcPass idL) GhcRn = NameSet
type instance XPSB (GhcPass idL) GhcTc = NameSet
-type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt
+type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon
{-
Note [AbsBinds]
@@ -682,7 +682,7 @@ pprDeclList ds = pprDeeperList vcat ds
------------
emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
-emptyLocalBinds = EmptyLocalBinds noExt
+emptyLocalBinds = EmptyLocalBinds noExtField
-- AZ:These functions do not seem to be used at all?
isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
@@ -706,7 +706,7 @@ isEmptyValBinds (ValBinds _ ds sigs) = isEmptyLHsBinds ds && null sigs
isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs
emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
-emptyValBindsIn = ValBinds noExt emptyBag []
+emptyValBindsIn = ValBinds noExtField emptyBag []
emptyValBindsOut = XValBindsLR (NValBinds [] [])
emptyLHsBinds :: LHsBindsLR idL idR
@@ -719,7 +719,7 @@ isEmptyLHsBinds = isEmptyBag
plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
-> HsValBinds(GhcPass a)
plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)
- = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
+ = ValBinds noExtField (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
(XValBindsLR (NValBinds ds2 sigs2))
= XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))
@@ -824,13 +824,13 @@ data HsIPBinds id
-- -- uses of the implicit parameters
| XHsIPBinds (XXHsIPBinds id)
-type instance XIPBinds GhcPs = NoExt
-type instance XIPBinds GhcRn = NoExt
+type instance XIPBinds GhcPs = NoExtField
+type instance XIPBinds GhcRn = NoExtField
type instance XIPBinds GhcTc = TcEvBinds -- binds uses of the
-- implicit parameters
-type instance XXHsIPBinds (GhcPass p) = NoExt
+type instance XXHsIPBinds (GhcPass p) = NoExtCon
isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
isEmptyIPBindsPR (IPBinds _ is) = null is
@@ -864,8 +864,8 @@ data IPBind id
(LHsExpr id)
| XIPBind (XXIPBind id)
-type instance XCIPBind (GhcPass p) = NoExt
-type instance XXIPBind (GhcPass p) = NoExt
+type instance XCIPBind (GhcPass p) = NoExtField
+type instance XXIPBind (GhcPass p) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsIPBinds p) where
@@ -1047,18 +1047,18 @@ data Sig pass
(Maybe (Located (IdP pass)))
| XSig (XXSig pass)
-type instance XTypeSig (GhcPass p) = NoExt
-type instance XPatSynSig (GhcPass p) = NoExt
-type instance XClassOpSig (GhcPass p) = NoExt
-type instance XIdSig (GhcPass p) = NoExt
-type instance XFixSig (GhcPass p) = NoExt
-type instance XInlineSig (GhcPass p) = NoExt
-type instance XSpecSig (GhcPass p) = NoExt
-type instance XSpecInstSig (GhcPass p) = NoExt
-type instance XMinimalSig (GhcPass p) = NoExt
-type instance XSCCFunSig (GhcPass p) = NoExt
-type instance XCompleteMatchSig (GhcPass p) = NoExt
-type instance XXSig (GhcPass p) = NoExt
+type instance XTypeSig (GhcPass p) = NoExtField
+type instance XPatSynSig (GhcPass p) = NoExtField
+type instance XClassOpSig (GhcPass p) = NoExtField
+type instance XIdSig (GhcPass p) = NoExtField
+type instance XFixSig (GhcPass p) = NoExtField
+type instance XInlineSig (GhcPass p) = NoExtField
+type instance XSpecSig (GhcPass p) = NoExtField
+type instance XSpecInstSig (GhcPass p) = NoExtField
+type instance XMinimalSig (GhcPass p) = NoExtField
+type instance XSCCFunSig (GhcPass p) = NoExtField
+type instance XCompleteMatchSig (GhcPass p) = NoExtField
+type instance XXSig (GhcPass p) = NoExtCon
-- | Located Fixity Signature
type LFixitySig pass = Located (FixitySig pass)
@@ -1067,8 +1067,8 @@ type LFixitySig pass = Located (FixitySig pass)
data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity
| XFixitySig (XXFixitySig pass)
-type instance XFixitySig (GhcPass p) = NoExt
-type instance XXFixitySig (GhcPass p) = NoExt
+type instance XFixitySig (GhcPass p) = NoExtField
+type instance XXFixitySig (GhcPass p) = NoExtCon
-- | Type checker Specialisation Pragmas
--
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 7adfb01b2d998634d5de97eb6045af25a54b66b9..5a6d927ab99be9b3d3d6edd614172816208b7e4e 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -146,20 +146,20 @@ data HsDecl p
| RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration
| XHsDecl (XXHsDecl p)
-type instance XTyClD (GhcPass _) = NoExt
-type instance XInstD (GhcPass _) = NoExt
-type instance XDerivD (GhcPass _) = NoExt
-type instance XValD (GhcPass _) = NoExt
-type instance XSigD (GhcPass _) = NoExt
-type instance XDefD (GhcPass _) = NoExt
-type instance XForD (GhcPass _) = NoExt
-type instance XWarningD (GhcPass _) = NoExt
-type instance XAnnD (GhcPass _) = NoExt
-type instance XRuleD (GhcPass _) = NoExt
-type instance XSpliceD (GhcPass _) = NoExt
-type instance XDocD (GhcPass _) = NoExt
-type instance XRoleAnnotD (GhcPass _) = NoExt
-type instance XXHsDecl (GhcPass _) = NoExt
+type instance XTyClD (GhcPass _) = NoExtField
+type instance XInstD (GhcPass _) = NoExtField
+type instance XDerivD (GhcPass _) = NoExtField
+type instance XValD (GhcPass _) = NoExtField
+type instance XSigD (GhcPass _) = NoExtField
+type instance XDefD (GhcPass _) = NoExtField
+type instance XForD (GhcPass _) = NoExtField
+type instance XWarningD (GhcPass _) = NoExtField
+type instance XAnnD (GhcPass _) = NoExtField
+type instance XRuleD (GhcPass _) = NoExtField
+type instance XSpliceD (GhcPass _) = NoExtField
+type instance XDocD (GhcPass _) = NoExtField
+type instance XRoleAnnotD (GhcPass _) = NoExtField
+type instance XXHsDecl (GhcPass _) = NoExtCon
-- NB: all top-level fixity decls are contained EITHER
-- EITHER SigDs
@@ -206,8 +206,8 @@ data HsGroup p
}
| XHsGroup (XXHsGroup p)
-type instance XCHsGroup (GhcPass _) = NoExt
-type instance XXHsGroup (GhcPass _) = NoExt
+type instance XCHsGroup (GhcPass _) = NoExtField
+type instance XXHsGroup (GhcPass _) = NoExtCon
emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)
@@ -217,7 +217,7 @@ emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
hsGroupInstDecls :: HsGroup id -> [LInstDecl id]
hsGroupInstDecls = (=<<) group_instds . hs_tyclds
-emptyGroup = HsGroup { hs_ext = noExt,
+emptyGroup = HsGroup { hs_ext = noExtField,
hs_tyclds = [],
hs_derivds = [],
hs_fixds = [], hs_defds = [], hs_annds = [],
@@ -255,7 +255,7 @@ appendGroups
hs_docs = docs2 }
=
HsGroup {
- hs_ext = noExt,
+ hs_ext = noExtField,
hs_valds = val_groups1 `plusHsValBinds` val_groups2,
hs_splcds = spliceds1 ++ spliceds2,
hs_tyclds = tyclds1 ++ tyclds2,
@@ -330,8 +330,8 @@ data SpliceDecl p
SpliceExplicitFlag
| XSpliceDecl (XXSpliceDecl p)
-type instance XSpliceDecl (GhcPass _) = NoExt
-type instance XXSpliceDecl (GhcPass _) = NoExt
+type instance XSpliceDecl (GhcPass _) = NoExtField
+type instance XXSpliceDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (SpliceDecl p) where
@@ -576,21 +576,21 @@ c.f. Note [Associated type tyvar names] in Class.hs
Note [Family instance declaration binders]
-}
-type instance XFamDecl (GhcPass _) = NoExt
+type instance XFamDecl (GhcPass _) = NoExtField
-type instance XSynDecl GhcPs = NoExt
+type instance XSynDecl GhcPs = NoExtField
type instance XSynDecl GhcRn = NameSet -- FVs
type instance XSynDecl GhcTc = NameSet -- FVs
-type instance XDataDecl GhcPs = NoExt
+type instance XDataDecl GhcPs = NoExtField
type instance XDataDecl GhcRn = DataDeclRn
type instance XDataDecl GhcTc = DataDeclRn
-type instance XClassDecl GhcPs = NoExt
+type instance XClassDecl GhcPs = NoExtField
type instance XClassDecl GhcRn = NameSet -- FVs
type instance XClassDecl GhcTc = NameSet -- FVs
-type instance XXTyClDecl (GhcPass _) = NoExt
+type instance XXTyClDecl (GhcPass _) = NoExtCon
-- Simple classifiers for TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -641,17 +641,17 @@ isDataFamilyDecl _other = False
-- Dealing with names
-tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)
+tyFamInstDeclName :: TyFamInstDecl (GhcPass p) -> IdP (GhcPass p)
tyFamInstDeclName = unLoc . tyFamInstDeclLName
-tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)
+tyFamInstDeclLName :: TyFamInstDecl (GhcPass p) -> Located (IdP (GhcPass p))
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
(HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })
= ln
-tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))
- = panic "tyFamInstDeclLName"
-tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))
- = panic "tyFamInstDeclLName"
+tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec)))
+ = noExtCon nec
+tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec))
+ = noExtCon nec
tyClDeclLName :: TyClDecl pass -> Located (IdP pass)
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
@@ -699,7 +699,7 @@ hsDeclHasCusk _cusks_enabled@True (SynDecl { tcdTyVars = tyvars, tcdRhs = rhs })
_ -> False
hsDeclHasCusk _cusks_enabled@True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk
hsDeclHasCusk _cusks_enabled@True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars
-hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk"
+hsDeclHasCusk _ (XTyClDecl nec) = noExtCon nec
-- Pretty-printing TyClDecl
-- ~~~~~~~~~~~~~~~~~~~~~~~~
@@ -912,12 +912,12 @@ data TyClGroup pass -- See Note [TyClGroups and dependency analysis]
, group_instds :: [LInstDecl pass] }
| XTyClGroup (XXTyClGroup pass)
-type instance XCTyClGroup (GhcPass _) = NoExt
-type instance XXTyClGroup (GhcPass _) = NoExt
+type instance XCTyClGroup (GhcPass _) = NoExtField
+type instance XXTyClGroup (GhcPass _) = NoExtCon
emptyTyClGroup :: TyClGroup (GhcPass p)
-emptyTyClGroup = TyClGroup noExt [] [] []
+emptyTyClGroup = TyClGroup noExtField [] [] []
tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass]
tyClGroupTyClDecls = concatMap group_tyclds
@@ -931,7 +931,7 @@ tyClGroupRoleDecls = concatMap group_roles
mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]
-> TyClGroup (GhcPass p)
mkTyClGroup decls instds = TyClGroup
- { group_ext = noExt
+ { group_ext = noExtField
, group_tyclds = decls
, group_roles = []
, group_instds = instds
@@ -1033,10 +1033,10 @@ data FamilyResultSig pass = -- see Note [FamilyResultSig]
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XNoSig (GhcPass _) = NoExt
-type instance XCKindSig (GhcPass _) = NoExt
-type instance XTyVarSig (GhcPass _) = NoExt
-type instance XXFamilyResultSig (GhcPass _) = NoExt
+type instance XNoSig (GhcPass _) = NoExtField
+type instance XCKindSig (GhcPass _) = NoExtField
+type instance XTyVarSig (GhcPass _) = NoExtField
+type instance XXFamilyResultSig (GhcPass _) = NoExtCon
-- | Located type Family Declaration
@@ -1063,8 +1063,8 @@ data FamilyDecl pass = FamilyDecl
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCFamilyDecl (GhcPass _) = NoExt
-type instance XXFamilyDecl (GhcPass _) = NoExt
+type instance XCFamilyDecl (GhcPass _) = NoExtField
+type instance XXFamilyDecl (GhcPass _) = NoExtCon
-- | Located Injectivity Annotation
@@ -1097,7 +1097,7 @@ data FamilyInfo pass
famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled
-> Bool -- ^ True <=> this is an associated type family,
-- and the parent class has /no/ CUSK
- -> FamilyDecl pass
+ -> FamilyDecl (GhcPass pass)
-> Bool
famDeclHasCusk _cusks_enabled@False _ _ = False
famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk
@@ -1111,7 +1111,7 @@ famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk
-- Un-associated open type/data families have CUSKs
-- Associated type families have CUSKs iff the parent class does
-famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk"
+famDeclHasCusk _ _ (XFamilyDecl nec) = noExtCon nec
-- | Does this family declaration have user-supplied return kind signature?
hasReturnKindSignature :: FamilyResultSig a -> Bool
@@ -1120,7 +1120,7 @@ hasReturnKindSignature (TyVarSig _ (L _ (UserTyVar{}))) = False
hasReturnKindSignature _ = True
-- | Maybe return name of the result type variable
-resultVariableName :: FamilyResultSig a -> Maybe (IdP a)
+resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a))
resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig
resultVariableName _ = Nothing
@@ -1213,8 +1213,8 @@ data HsDataDefn pass -- The payload of a data type defn
}
| XHsDataDefn (XXHsDataDefn pass)
-type instance XCHsDataDefn (GhcPass _) = NoExt
-type instance XXHsDataDefn (GhcPass _) = NoExt
+type instance XCHsDataDefn (GhcPass _) = NoExtField
+type instance XXHsDataDefn (GhcPass _) = NoExtCon
-- | Haskell Deriving clause
type HsDeriving pass = Located [LHsDerivingClause pass]
@@ -1253,8 +1253,8 @@ data HsDerivingClause pass
}
| XHsDerivingClause (XXHsDerivingClause pass)
-type instance XCHsDerivingClause (GhcPass _) = NoExt
-type instance XXHsDerivingClause (GhcPass _) = NoExt
+type instance XCHsDerivingClause (GhcPass _) = NoExtField
+type instance XXHsDerivingClause (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsDerivingClause p) where
@@ -1363,9 +1363,9 @@ data ConDecl pass
}
| XConDecl (XXConDecl pass)
-type instance XConDeclGADT (GhcPass _) = NoExt
-type instance XConDeclH98 (GhcPass _) = NoExt
-type instance XXConDecl (GhcPass _) = NoExt
+type instance XConDeclGADT (GhcPass _) = NoExtField
+type instance XConDeclH98 (GhcPass _) = NoExtField
+type instance XXConDecl (GhcPass _) = NoExtCon
{- Note [GADT abstract syntax]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1408,10 +1408,10 @@ There's a wrinkle in ConDeclGADT
type HsConDeclDetails pass
= HsConDetails (LBangType pass) (Located [LConDeclField pass])
-getConNames :: ConDecl pass -> [Located (IdP pass)]
+getConNames :: ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDeclH98 {con_name = name} = [name]
getConNames ConDeclGADT {con_names = names} = names
-getConNames XConDecl {} = panic "getConNames"
+getConNames (XConDecl nec) = noExtCon nec
getConArgs :: ConDecl pass -> HsConDeclDetails pass
getConArgs d = con_args d
@@ -1648,8 +1648,8 @@ data FamEqn pass rhs
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCFamEqn (GhcPass _) r = NoExt
-type instance XXFamEqn (GhcPass _) r = NoExt
+type instance XCFamEqn (GhcPass _) r = NoExtField
+type instance XXFamEqn (GhcPass _) r = NoExtCon
----------------- Class instances -------------
@@ -1681,8 +1681,8 @@ data ClsInstDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
| XClsInstDecl (XXClsInstDecl pass)
-type instance XCClsInstDecl (GhcPass _) = NoExt
-type instance XXClsInstDecl (GhcPass _) = NoExt
+type instance XCClsInstDecl (GhcPass _) = NoExtField
+type instance XXClsInstDecl (GhcPass _) = NoExtCon
----------------- Instances of all kinds -------------
@@ -1702,10 +1702,10 @@ data InstDecl pass -- Both class and family instances
, tfid_inst :: TyFamInstDecl pass }
| XInstDecl (XXInstDecl pass)
-type instance XClsInstD (GhcPass _) = NoExt
-type instance XDataFamInstD (GhcPass _) = NoExt
-type instance XTyFamInstD (GhcPass _) = NoExt
-type instance XXInstDecl (GhcPass _) = NoExt
+type instance XClsInstD (GhcPass _) = NoExtField
+type instance XDataFamInstD (GhcPass _) = NoExtField
+type instance XTyFamInstD (GhcPass _) = NoExtField
+type instance XXInstDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (TyFamInstDecl p) where
@@ -1841,7 +1841,7 @@ instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (InstDecl p) where
-- Extract the declarations of associated data types from an instance
-instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]
+instDeclDataFamInsts :: [LInstDecl (GhcPass p)] -> [DataFamInstDecl (GhcPass p)]
instDeclDataFamInsts inst_decls
= concatMap do_one inst_decls
where
@@ -1849,8 +1849,8 @@ instDeclDataFamInsts inst_decls
= map unLoc fam_insts
do_one (L _ (DataFamInstD { dfid_inst = fam_inst })) = [fam_inst]
do_one (L _ (TyFamInstD {})) = []
- do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts"
- do_one (L _ (XInstDecl _)) = panic "instDeclDataFamInsts"
+ do_one (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec
+ do_one (L _ (XInstDecl nec)) = noExtCon nec
{-
************************************************************************
@@ -1889,8 +1889,8 @@ data DerivDecl pass = DerivDecl
}
| XDerivDecl (XXDerivDecl pass)
-type instance XCDerivDecl (GhcPass _) = NoExt
-type instance XXDerivDecl (GhcPass _) = NoExt
+type instance XCDerivDecl (GhcPass _) = NoExtField
+type instance XXDerivDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (DerivDecl p) where
@@ -1972,8 +1972,8 @@ data DefaultDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
| XDefaultDecl (XXDefaultDecl pass)
-type instance XCDefaultDecl (GhcPass _) = NoExt
-type instance XXDefaultDecl (GhcPass _) = NoExt
+type instance XCDefaultDecl (GhcPass _) = NoExtField
+type instance XXDefaultDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (DefaultDecl p) where
@@ -2028,15 +2028,15 @@ data ForeignDecl pass
such as Int and IO that we know how to make foreign calls with.
-}
-type instance XForeignImport GhcPs = NoExt
-type instance XForeignImport GhcRn = NoExt
+type instance XForeignImport GhcPs = NoExtField
+type instance XForeignImport GhcRn = NoExtField
type instance XForeignImport GhcTc = Coercion
-type instance XForeignExport GhcPs = NoExt
-type instance XForeignExport GhcRn = NoExt
+type instance XForeignExport GhcPs = NoExtField
+type instance XForeignExport GhcRn = NoExtField
type instance XForeignExport GhcTc = Coercion
-type instance XXForeignDecl (GhcPass _) = NoExt
+type instance XXForeignDecl (GhcPass _) = NoExtCon
-- Specification Of an imported external entity in dependence on the calling
-- convention
@@ -2143,8 +2143,8 @@ data RuleDecls pass = HsRules { rds_ext :: XCRuleDecls pass
, rds_rules :: [LRuleDecl pass] }
| XRuleDecls (XXRuleDecls pass)
-type instance XCRuleDecls (GhcPass _) = NoExt
-type instance XXRuleDecls (GhcPass _) = NoExt
+type instance XCRuleDecls (GhcPass _) = NoExtField
+type instance XXRuleDecls (GhcPass _) = NoExtCon
-- | Located Rule Declaration
type LRuleDecl pass = Located (RuleDecl pass)
@@ -2177,11 +2177,11 @@ data RuleDecl pass
data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS
deriving Data
-type instance XHsRule GhcPs = NoExt
+type instance XHsRule GhcPs = NoExtField
type instance XHsRule GhcRn = HsRuleRn
type instance XHsRule GhcTc = HsRuleRn
-type instance XXRuleDecl (GhcPass _) = NoExt
+type instance XXRuleDecl (GhcPass _) = NoExtCon
flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass]
flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls
@@ -2200,9 +2200,9 @@ data RuleBndr pass
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCRuleBndr (GhcPass _) = NoExt
-type instance XRuleBndrSig (GhcPass _) = NoExt
-type instance XXRuleBndr (GhcPass _) = NoExt
+type instance XCRuleBndr (GhcPass _) = NoExtField
+type instance XRuleBndrSig (GhcPass _) = NoExtField
+type instance XXRuleBndr (GhcPass _) = NoExtCon
collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass]
collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]
@@ -2290,8 +2290,8 @@ data WarnDecls pass = Warnings { wd_ext :: XWarnings pass
}
| XWarnDecls (XXWarnDecls pass)
-type instance XWarnings (GhcPass _) = NoExt
-type instance XXWarnDecls (GhcPass _) = NoExt
+type instance XWarnings (GhcPass _) = NoExtField
+type instance XXWarnDecls (GhcPass _) = NoExtCon
-- | Located Warning pragma Declaration
type LWarnDecl pass = Located (WarnDecl pass)
@@ -2300,8 +2300,8 @@ type LWarnDecl pass = Located (WarnDecl pass)
data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt
| XWarnDecl (XXWarnDecl pass)
-type instance XWarning (GhcPass _) = NoExt
-type instance XXWarnDecl (GhcPass _) = NoExt
+type instance XWarning (GhcPass _) = NoExtField
+type instance XXWarnDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass,OutputableBndr (IdP p))
@@ -2342,8 +2342,8 @@ data AnnDecl pass = HsAnnotation
-- For details on above see note [Api annotations] in ApiAnnotation
| XAnnDecl (XXAnnDecl pass)
-type instance XHsAnnotation (GhcPass _) = NoExt
-type instance XXAnnDecl (GhcPass _) = NoExt
+type instance XHsAnnotation (GhcPass _) = NoExtField
+type instance XXAnnDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where
ppr (HsAnnotation _ _ provenance expr)
@@ -2395,8 +2395,8 @@ data RoleAnnotDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
| XRoleAnnotDecl (XXRoleAnnotDecl pass)
-type instance XCRoleAnnotDecl (GhcPass _) = NoExt
-type instance XXRoleAnnotDecl (GhcPass _) = NoExt
+type instance XCRoleAnnotDecl (GhcPass _) = NoExtField
+type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndr (IdP p))
=> Outputable (RoleAnnotDecl p) where
@@ -2408,6 +2408,6 @@ instance (p ~ GhcPass pass, OutputableBndr (IdP p))
pp_role (Just r) = ppr r
ppr (XRoleAnnotDecl x) = ppr x
-roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)
+roleAnnotDeclName :: RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p)
roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name
-roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName"
+roleAnnotDeclName (XRoleAnnotDecl nec) = noExtCon nec
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 9052855c6936ce81da74a2bf7b24b8cc4e5c1805..6bfdad16003b7a8a10c278a45588cc5f1e8b1079 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -110,13 +110,14 @@ data SyntaxExpr p = SyntaxExpr { syn_expr :: HsExpr p
-- | This is used for rebindable-syntax pieces that are too polymorphic
-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
noExpr :: HsExpr (GhcPass p)
-noExpr = HsLit noExt (HsString (SourceText "noExpr") (fsLit "noExpr"))
+noExpr = HsLit noExtField (HsString (SourceText "noExpr") (fsLit "noExpr"))
noSyntaxExpr :: SyntaxExpr (GhcPass p)
-- Before renaming, and sometimes after,
-- (if the syntax slot makes no sense)
-noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExt (HsString NoSourceText
- (fsLit "noSyntaxExpr"))
+noSyntaxExpr = SyntaxExpr { syn_expr = HsLit noExtField
+ (HsString NoSourceText
+ (fsLit "noSyntaxExpr"))
, syn_arg_wraps = []
, syn_res_wrap = WpHole }
@@ -129,7 +130,7 @@ mkSyntaxExpr expr = SyntaxExpr { syn_expr = expr
-- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
-- renamer), missing its HsWrappers.
mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn
-mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExt $ noLoc name
+mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExtField $ noLoc name
-- don't care about filling in syn_arg_wraps because we're clearly
-- not past the typechecker
@@ -659,84 +660,84 @@ data RecordUpdTc = RecordUpdTc
-- ---------------------------------------------------------------------
-type instance XVar (GhcPass _) = NoExt
-type instance XUnboundVar (GhcPass _) = NoExt
-type instance XConLikeOut (GhcPass _) = NoExt
-type instance XRecFld (GhcPass _) = NoExt
-type instance XOverLabel (GhcPass _) = NoExt
-type instance XIPVar (GhcPass _) = NoExt
-type instance XOverLitE (GhcPass _) = NoExt
-type instance XLitE (GhcPass _) = NoExt
-type instance XLam (GhcPass _) = NoExt
-type instance XLamCase (GhcPass _) = NoExt
-type instance XApp (GhcPass _) = NoExt
-
-type instance XAppTypeE (GhcPass _) = NoExt
-
-type instance XOpApp GhcPs = NoExt
+type instance XVar (GhcPass _) = NoExtField
+type instance XUnboundVar (GhcPass _) = NoExtField
+type instance XConLikeOut (GhcPass _) = NoExtField
+type instance XRecFld (GhcPass _) = NoExtField
+type instance XOverLabel (GhcPass _) = NoExtField
+type instance XIPVar (GhcPass _) = NoExtField
+type instance XOverLitE (GhcPass _) = NoExtField
+type instance XLitE (GhcPass _) = NoExtField
+type instance XLam (GhcPass _) = NoExtField
+type instance XLamCase (GhcPass _) = NoExtField
+type instance XApp (GhcPass _) = NoExtField
+
+type instance XAppTypeE (GhcPass _) = NoExtField
+
+type instance XOpApp GhcPs = NoExtField
type instance XOpApp GhcRn = Fixity
type instance XOpApp GhcTc = Fixity
-type instance XNegApp (GhcPass _) = NoExt
-type instance XPar (GhcPass _) = NoExt
-type instance XSectionL (GhcPass _) = NoExt
-type instance XSectionR (GhcPass _) = NoExt
-type instance XExplicitTuple (GhcPass _) = NoExt
+type instance XNegApp (GhcPass _) = NoExtField
+type instance XPar (GhcPass _) = NoExtField
+type instance XSectionL (GhcPass _) = NoExtField
+type instance XSectionR (GhcPass _) = NoExtField
+type instance XExplicitTuple (GhcPass _) = NoExtField
-type instance XExplicitSum GhcPs = NoExt
-type instance XExplicitSum GhcRn = NoExt
+type instance XExplicitSum GhcPs = NoExtField
+type instance XExplicitSum GhcRn = NoExtField
type instance XExplicitSum GhcTc = [Type]
-type instance XCase (GhcPass _) = NoExt
-type instance XIf (GhcPass _) = NoExt
+type instance XCase (GhcPass _) = NoExtField
+type instance XIf (GhcPass _) = NoExtField
-type instance XMultiIf GhcPs = NoExt
-type instance XMultiIf GhcRn = NoExt
+type instance XMultiIf GhcPs = NoExtField
+type instance XMultiIf GhcRn = NoExtField
type instance XMultiIf GhcTc = Type
-type instance XLet (GhcPass _) = NoExt
+type instance XLet (GhcPass _) = NoExtField
-type instance XDo GhcPs = NoExt
-type instance XDo GhcRn = NoExt
+type instance XDo GhcPs = NoExtField
+type instance XDo GhcRn = NoExtField
type instance XDo GhcTc = Type
-type instance XExplicitList GhcPs = NoExt
-type instance XExplicitList GhcRn = NoExt
+type instance XExplicitList GhcPs = NoExtField
+type instance XExplicitList GhcRn = NoExtField
type instance XExplicitList GhcTc = Type
-type instance XRecordCon GhcPs = NoExt
-type instance XRecordCon GhcRn = NoExt
+type instance XRecordCon GhcPs = NoExtField
+type instance XRecordCon GhcRn = NoExtField
type instance XRecordCon GhcTc = RecordConTc
-type instance XRecordUpd GhcPs = NoExt
-type instance XRecordUpd GhcRn = NoExt
+type instance XRecordUpd GhcPs = NoExtField
+type instance XRecordUpd GhcRn = NoExtField
type instance XRecordUpd GhcTc = RecordUpdTc
-type instance XExprWithTySig (GhcPass _) = NoExt
+type instance XExprWithTySig (GhcPass _) = NoExtField
-type instance XArithSeq GhcPs = NoExt
-type instance XArithSeq GhcRn = NoExt
+type instance XArithSeq GhcPs = NoExtField
+type instance XArithSeq GhcRn = NoExtField
type instance XArithSeq GhcTc = PostTcExpr
-type instance XSCC (GhcPass _) = NoExt
-type instance XCoreAnn (GhcPass _) = NoExt
-type instance XBracket (GhcPass _) = NoExt
+type instance XSCC (GhcPass _) = NoExtField
+type instance XCoreAnn (GhcPass _) = NoExtField
+type instance XBracket (GhcPass _) = NoExtField
-type instance XRnBracketOut (GhcPass _) = NoExt
-type instance XTcBracketOut (GhcPass _) = NoExt
+type instance XRnBracketOut (GhcPass _) = NoExtField
+type instance XTcBracketOut (GhcPass _) = NoExtField
-type instance XSpliceE (GhcPass _) = NoExt
-type instance XProc (GhcPass _) = NoExt
+type instance XSpliceE (GhcPass _) = NoExtField
+type instance XProc (GhcPass _) = NoExtField
-type instance XStatic GhcPs = NoExt
+type instance XStatic GhcPs = NoExtField
type instance XStatic GhcRn = NameSet
type instance XStatic GhcTc = NameSet
-type instance XTick (GhcPass _) = NoExt
-type instance XBinTick (GhcPass _) = NoExt
-type instance XTickPragma (GhcPass _) = NoExt
-type instance XWrap (GhcPass _) = NoExt
-type instance XXExpr (GhcPass _) = NoExt
+type instance XTick (GhcPass _) = NoExtField
+type instance XBinTick (GhcPass _) = NoExtField
+type instance XTickPragma (GhcPass _) = NoExtField
+type instance XWrap (GhcPass _) = NoExtField
+type instance XXExpr (GhcPass _) = NoExtCon
-- ---------------------------------------------------------------------
@@ -757,13 +758,13 @@ data HsTupArg id
| Missing (XMissing id) -- ^ The argument is missing, but this is its type
| XTupArg (XXTupArg id) -- ^ Note [Trees that Grow] extension point
-type instance XPresent (GhcPass _) = NoExt
+type instance XPresent (GhcPass _) = NoExtField
-type instance XMissing GhcPs = NoExt
-type instance XMissing GhcRn = NoExt
+type instance XMissing GhcPs = NoExtField
+type instance XMissing GhcRn = NoExtField
type instance XMissing GhcTc = Type
-type instance XXTupArg (GhcPass _) = NoExt
+type instance XXTupArg (GhcPass _) = NoExtCon
tupArgPresent :: LHsTupArg id -> Bool
tupArgPresent (L _ (Present {})) = True
@@ -1173,7 +1174,7 @@ hsExprNeedsParens p = go
-- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@.
parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parenthesizeHsExpr p le@(L loc e)
- | hsExprNeedsParens p e = L loc (HsPar NoExt le)
+ | hsExprNeedsParens p e = L loc (HsPar noExtField le)
| otherwise = le
isAtomicHsExpr :: HsExpr id -> Bool
@@ -1298,24 +1299,24 @@ data HsCmd id
-- Then (HsCmdWrap wrap cmd) :: arg2 --> res
| XCmd (XXCmd id) -- Note [Trees that Grow] extension point
-type instance XCmdArrApp GhcPs = NoExt
-type instance XCmdArrApp GhcRn = NoExt
+type instance XCmdArrApp GhcPs = NoExtField
+type instance XCmdArrApp GhcRn = NoExtField
type instance XCmdArrApp GhcTc = Type
-type instance XCmdArrForm (GhcPass _) = NoExt
-type instance XCmdApp (GhcPass _) = NoExt
-type instance XCmdLam (GhcPass _) = NoExt
-type instance XCmdPar (GhcPass _) = NoExt
-type instance XCmdCase (GhcPass _) = NoExt
-type instance XCmdIf (GhcPass _) = NoExt
-type instance XCmdLet (GhcPass _) = NoExt
+type instance XCmdArrForm (GhcPass _) = NoExtField
+type instance XCmdApp (GhcPass _) = NoExtField
+type instance XCmdLam (GhcPass _) = NoExtField
+type instance XCmdPar (GhcPass _) = NoExtField
+type instance XCmdCase (GhcPass _) = NoExtField
+type instance XCmdIf (GhcPass _) = NoExtField
+type instance XCmdLet (GhcPass _) = NoExtField
-type instance XCmdDo GhcPs = NoExt
-type instance XCmdDo GhcRn = NoExt
+type instance XCmdDo GhcPs = NoExtField
+type instance XCmdDo GhcRn = NoExtField
type instance XCmdDo GhcTc = Type
-type instance XCmdWrap (GhcPass _) = NoExt
-type instance XXCmd (GhcPass _) = NoExt
+type instance XCmdWrap (GhcPass _) = NoExtField
+type instance XXCmd (GhcPass _) = NoExtCon
-- | Haskell Array Application Type
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
@@ -1341,11 +1342,11 @@ data CmdTopTc
Type -- return type of the command
(CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable]
-type instance XCmdTop GhcPs = NoExt
+type instance XCmdTop GhcPs = NoExtField
type instance XCmdTop GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable]
type instance XCmdTop GhcTc = CmdTopTc
-type instance XXCmdTop (GhcPass _) = NoExt
+type instance XXCmdTop (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where
ppr cmd = pprCmd cmd
@@ -1491,11 +1492,11 @@ data MatchGroupTc
, mg_res_ty :: Type -- Type of the result, tr
} deriving Data
-type instance XMG GhcPs b = NoExt
-type instance XMG GhcRn b = NoExt
+type instance XMG GhcPs b = NoExtField
+type instance XMG GhcRn b = NoExtField
type instance XMG GhcTc b = MatchGroupTc
-type instance XXMatchGroup (GhcPass _) b = NoExt
+type instance XXMatchGroup (GhcPass _) b = NoExtCon
-- | Located Match
type LMatch id body = Located (Match id body)
@@ -1513,8 +1514,8 @@ data Match p body
}
| XMatch (XXMatch p body)
-type instance XCMatch (GhcPass _) b = NoExt
-type instance XXMatch (GhcPass _) b = NoExt
+type instance XCMatch (GhcPass _) b = NoExtField
+type instance XXMatch (GhcPass _) b = NoExtCon
instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)
=> Outputable (Match idR body) where
@@ -1564,7 +1565,7 @@ isInfixMatch match = case m_ctxt match of
isEmptyMatchGroup :: MatchGroup id body -> Bool
isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms
-isEmptyMatchGroup (XMatchGroup{}) = panic "isEmptyMatchGroup"
+isEmptyMatchGroup (XMatchGroup {}) = False
-- | Is there only one RHS in this list of matches?
isSingletonMatchGroup :: [LMatch id body] -> Bool
@@ -1575,17 +1576,17 @@ isSingletonMatchGroup matches
| otherwise
= False
-matchGroupArity :: MatchGroup id body -> Arity
+matchGroupArity :: MatchGroup (GhcPass id) body -> Arity
-- Precondition: MatchGroup is non-empty
-- This is called before type checking, when mg_arg_tys is not set
matchGroupArity (MG { mg_alts = alts })
| L _ (alt1:_) <- alts = length (hsLMatchPats alt1)
| otherwise = panic "matchGroupArity"
-matchGroupArity (XMatchGroup{}) = panic "matchGroupArity"
+matchGroupArity (XMatchGroup nec) = noExtCon nec
-hsLMatchPats :: LMatch id body -> [LPat id]
+hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)]
hsLMatchPats (L _ (Match { m_pats = pats })) = pats
-hsLMatchPats (L _ (XMatch _)) = panic "hsLMatchPats"
+hsLMatchPats (L _ (XMatch nec)) = noExtCon nec
-- | Guarded Right-Hand Sides
--
@@ -1605,8 +1606,8 @@ data GRHSs p body
}
| XGRHSs (XXGRHSs p body)
-type instance XCGRHSs (GhcPass _) b = NoExt
-type instance XXGRHSs (GhcPass _) b = NoExt
+type instance XCGRHSs (GhcPass _) b = NoExtField
+type instance XXGRHSs (GhcPass _) b = NoExtCon
-- | Located Guarded Right-Hand Side
type LGRHS id body = Located (GRHS id body)
@@ -1617,8 +1618,8 @@ data GRHS p body = GRHS (XCGRHS p body)
body -- Right hand side
| XGRHS (XXGRHS p body)
-type instance XCGRHS (GhcPass _) b = NoExt
-type instance XXGRHS (GhcPass _) b = NoExt
+type instance XCGRHS (GhcPass _) b = NoExtField
+type instance XXGRHS (GhcPass _) b = NoExtCon
-- We know the list must have at least one @Match@ in it.
@@ -1887,35 +1888,35 @@ data RecStmtTc =
}
-type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExt
+type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExtField
-type instance XBindStmt (GhcPass _) GhcPs b = NoExt
-type instance XBindStmt (GhcPass _) GhcRn b = NoExt
+type instance XBindStmt (GhcPass _) GhcPs b = NoExtField
+type instance XBindStmt (GhcPass _) GhcRn b = NoExtField
type instance XBindStmt (GhcPass _) GhcTc b = Type
-type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt
-type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt
+type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExtField
+type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExtField
type instance XApplicativeStmt (GhcPass _) GhcTc b = Type
-type instance XBodyStmt (GhcPass _) GhcPs b = NoExt
-type instance XBodyStmt (GhcPass _) GhcRn b = NoExt
+type instance XBodyStmt (GhcPass _) GhcPs b = NoExtField
+type instance XBodyStmt (GhcPass _) GhcRn b = NoExtField
type instance XBodyStmt (GhcPass _) GhcTc b = Type
-type instance XLetStmt (GhcPass _) (GhcPass _) b = NoExt
+type instance XLetStmt (GhcPass _) (GhcPass _) b = NoExtField
-type instance XParStmt (GhcPass _) GhcPs b = NoExt
-type instance XParStmt (GhcPass _) GhcRn b = NoExt
+type instance XParStmt (GhcPass _) GhcPs b = NoExtField
+type instance XParStmt (GhcPass _) GhcRn b = NoExtField
type instance XParStmt (GhcPass _) GhcTc b = Type
-type instance XTransStmt (GhcPass _) GhcPs b = NoExt
-type instance XTransStmt (GhcPass _) GhcRn b = NoExt
+type instance XTransStmt (GhcPass _) GhcPs b = NoExtField
+type instance XTransStmt (GhcPass _) GhcRn b = NoExtField
type instance XTransStmt (GhcPass _) GhcTc b = Type
-type instance XRecStmt (GhcPass _) GhcPs b = NoExt
-type instance XRecStmt (GhcPass _) GhcRn b = NoExt
+type instance XRecStmt (GhcPass _) GhcPs b = NoExtField
+type instance XRecStmt (GhcPass _) GhcRn b = NoExtField
type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc
-type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExt
+type instance XXStmtLR (GhcPass _) (GhcPass _) b = NoExtCon
data TransForm -- The 'f' below is the 'using' function, 'e' is the by function
= ThenForm -- then f or then f by e (depending on trS_by)
@@ -1931,8 +1932,8 @@ data ParStmtBlock idL idR
(SyntaxExpr idR) -- The return operator
| XParStmtBlock (XXParStmtBlock idL idR)
-type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
-type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt
+type instance XParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtField
+type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtCon
-- | Applicative Argument
data ApplicativeArg idL
@@ -1951,9 +1952,9 @@ data ApplicativeArg idL
(LPat idL) -- (v1,...,vn)
| XApplicativeArg (XXApplicativeArg idL)
-type instance XApplicativeArgOne (GhcPass _) = NoExt
-type instance XApplicativeArgMany (GhcPass _) = NoExt
-type instance XXApplicativeArg (GhcPass _) = NoExt
+type instance XApplicativeArgOne (GhcPass _) = NoExtField
+type instance XApplicativeArgMany (GhcPass _) = NoExtField
+type instance XXApplicativeArg (GhcPass _) = NoExtCon
{-
Note [The type of bind in Stmts]
@@ -2184,7 +2185,7 @@ pprStmt (ApplicativeStmt _ args mb_join)
:: ExprStmt (GhcPass idL))]
flattenArg (_, ApplicativeArgMany _ stmts _ _) =
concatMap flattenStmt stmts
- flattenArg (_, XApplicativeArg _) = panic "flattenArg"
+ flattenArg (_, XApplicativeArg nec) = noExtCon nec
pp_debug =
let
@@ -2207,7 +2208,7 @@ pprStmt (ApplicativeStmt _ args mb_join)
text "<-" <+>
ppr (HsDo (panic "pprStmt") DoExpr (noLoc
(stmts ++
- [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)])))
+ [noLoc (LastStmt noExtField (noLoc return) False noSyntaxExpr)])))
pp_arg (_, XApplicativeArg x) = ppr x
pprStmt (XStmtLR x) = ppr x
@@ -2308,11 +2309,11 @@ data HsSplice id
DelayedSplice
| XSplice (XXSplice id) -- Note [Trees that Grow] extension point
-type instance XTypedSplice (GhcPass _) = NoExt
-type instance XUntypedSplice (GhcPass _) = NoExt
-type instance XQuasiQuote (GhcPass _) = NoExt
-type instance XSpliced (GhcPass _) = NoExt
-type instance XXSplice (GhcPass _) = NoExt
+type instance XTypedSplice (GhcPass _) = NoExtField
+type instance XUntypedSplice (GhcPass _) = NoExtField
+type instance XQuasiQuote (GhcPass _) = NoExtField
+type instance XSpliced (GhcPass _) = NoExtField
+type instance XXSplice (GhcPass _) = NoExtCon
-- | A splice can appear with various decorations wrapped around it. This data
-- type captures explicitly how it was originally written, for use in the pretty
@@ -2515,14 +2516,14 @@ data HsBracket p
| TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||]
| XBracket (XXBracket p) -- Note [Trees that Grow] extension point
-type instance XExpBr (GhcPass _) = NoExt
-type instance XPatBr (GhcPass _) = NoExt
-type instance XDecBrL (GhcPass _) = NoExt
-type instance XDecBrG (GhcPass _) = NoExt
-type instance XTypBr (GhcPass _) = NoExt
-type instance XVarBr (GhcPass _) = NoExt
-type instance XTExpBr (GhcPass _) = NoExt
-type instance XXBracket (GhcPass _) = NoExt
+type instance XExpBr (GhcPass _) = NoExtField
+type instance XPatBr (GhcPass _) = NoExtField
+type instance XDecBrL (GhcPass _) = NoExtField
+type instance XDecBrG (GhcPass _) = NoExtField
+type instance XTypBr (GhcPass _) = NoExtField
+type instance XVarBr (GhcPass _) = NoExtField
+type instance XTExpBr (GhcPass _) = NoExtField
+type instance XXBracket (GhcPass _) = NoExtCon
isTypedBracket :: HsBracket id -> Bool
isTypedBracket (TExpBr {}) = True
diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs
index 0ae0dd01e330bac8c90e9e364e32559233cf056a..c486ad8a11c1013e33e08ffda202597f6e58f0f9 100644
--- a/compiler/hsSyn/HsExtension.hs
+++ b/compiler/hsSyn/HsExtension.hs
@@ -1,5 +1,7 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
@@ -53,16 +55,79 @@ haskell-src-exts ASTs as well.
-}
--- | used as place holder in TTG values
-data NoExt = NoExt
+-- | A placeholder type for TTG extension points that are not currently
+-- unused to represent any particular value.
+--
+-- This should not be confused with 'NoExtCon', which are found in unused
+-- extension /constructors/ and therefore should never be inhabited. In
+-- contrast, 'NoExtField' is used in extension /points/ (e.g., as the field of
+-- some constructor), so it must have an inhabitant to construct AST passes
+-- that manipulate fields with that extension point as their type.
+data NoExtField = NoExtField
deriving (Data,Eq,Ord)
-instance Outputable NoExt where
- ppr _ = text "NoExt"
+instance Outputable NoExtField where
+ ppr _ = text "NoExtField"
-- | Used when constructing a term with an unused extension point.
-noExt :: NoExt
-noExt = NoExt
+noExtField :: NoExtField
+noExtField = NoExtField
+
+-- | Used in TTG extension constructors that have yet to be extended with
+-- anything. If an extension constructor has 'NoExtCon' as its field, it is
+-- not intended to ever be constructed anywhere, and any function that consumes
+-- the extension constructor can eliminate it by way of 'noExtCon'.
+--
+-- This should not be confused with 'NoExtField', which are found in unused
+-- extension /points/ (not /constructors/) and therefore can be inhabited.
+
+-- See also [NoExtCon and strict fields].
+data NoExtCon
+ deriving (Data,Eq,Ord)
+
+instance Outputable NoExtCon where
+ ppr = noExtCon
+
+-- | Eliminate a 'NoExtCon'. Much like 'Data.Void.absurd'.
+noExtCon :: NoExtCon -> a
+noExtCon x = case x of {}
+
+{-
+Note [NoExtCon and strict fields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Currently, any unused TTG extension constructor will generally look like the
+following:
+
+ type instance XXHsDecl (GhcPass _) = NoExtCon
+ data HsDecl p
+ = ...
+ | XHsDecl (XXHsDecl p)
+
+This means that any function that wishes to consume an HsDecl will need to
+have a case for XHsDecl. This might look like this:
+
+ ex :: HsDecl GhcPs -> HsDecl GhcRn
+ ...
+ ex (XHsDecl nec) = noExtCon nec
+
+Ideally, we wouldn't need a case for XHsDecl at all (it /is/ supposed to be
+an unused extension constructor, after all). There is a way to achieve this
+on GHC 8.8 or later: make the field of XHsDecl strict:
+
+ data HsDecl p
+ = ...
+ | XHsDecl !(XXHsDecl p)
+
+If this is done, GHC's pattern-match coverage checker is clever enough to
+figure out that the XHsDecl case of `ex` is unreachable, so it can simply be
+omitted. (See Note [Extensions to GADTs Meet Their Match] in Check for more on
+how this works.)
+
+When GHC drops support for bootstrapping with GHC 8.6 and earlier, we can make
+the strict field changes described above and delete gobs of code involving
+`noExtCon`. Until then, it is necessary to use, so be aware of it when writing
+code that consumes unused extension constructors.
+-}
-- | Used as a data type index for the hsSyn AST
data GhcPass (c :: Pass)
@@ -1068,7 +1133,7 @@ type ConvertIdX a b =
--
-- So
--
--- type instance XXHsIPBinds (GhcPass p) = NoExt
+-- type instance XXHsIPBinds (GhcPass p) = NoExtCon
--
-- will correctly deduce Outputable for (GhcPass p), but
--
diff --git a/compiler/hsSyn/HsImpExp.hs b/compiler/hsSyn/HsImpExp.hs
index 1d487565e2f52a1303d667948d45dc0069996c65..bedb74e05dfe04d8f363f0abbff67891f33defca 100644
--- a/compiler/hsSyn/HsImpExp.hs
+++ b/compiler/hsSyn/HsImpExp.hs
@@ -108,12 +108,12 @@ data ImportDecl pass
-- For details on above see note [Api annotations] in ApiAnnotation
-type instance XCImportDecl (GhcPass _) = NoExt
-type instance XXImportDecl (GhcPass _) = NoExt
+type instance XCImportDecl (GhcPass _) = NoExtField
+type instance XXImportDecl (GhcPass _) = NoExtCon
simpleImportDecl :: ModuleName -> ImportDecl (GhcPass p)
simpleImportDecl mn = ImportDecl {
- ideclExt = noExt,
+ ideclExt = noExtField,
ideclSourceSrc = NoSourceText,
ideclName = noLoc mn,
ideclPkgQual = Nothing,
@@ -254,15 +254,15 @@ data IE pass
| IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc
| XIE (XXIE pass)
-type instance XIEVar (GhcPass _) = NoExt
-type instance XIEThingAbs (GhcPass _) = NoExt
-type instance XIEThingAll (GhcPass _) = NoExt
-type instance XIEThingWith (GhcPass _) = NoExt
-type instance XIEModuleContents (GhcPass _) = NoExt
-type instance XIEGroup (GhcPass _) = NoExt
-type instance XIEDoc (GhcPass _) = NoExt
-type instance XIEDocNamed (GhcPass _) = NoExt
-type instance XXIE (GhcPass _) = NoExt
+type instance XIEVar (GhcPass _) = NoExtField
+type instance XIEThingAbs (GhcPass _) = NoExtField
+type instance XIEThingAll (GhcPass _) = NoExtField
+type instance XIEThingWith (GhcPass _) = NoExtField
+type instance XIEModuleContents (GhcPass _) = NoExtField
+type instance XIEGroup (GhcPass _) = NoExtField
+type instance XIEDoc (GhcPass _) = NoExtField
+type instance XIEDocNamed (GhcPass _) = NoExtField
+type instance XXIE (GhcPass _) = NoExtCon
-- | Imported or Exported Wildcard
data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)
@@ -284,14 +284,14 @@ gives rise to
See Note [Representing fields in AvailInfo] in Avail for more details.
-}
-ieName :: IE pass -> IdP pass
+ieName :: IE (GhcPass p) -> IdP (GhcPass p)
ieName (IEVar _ (L _ n)) = ieWrappedName n
ieName (IEThingAbs _ (L _ n)) = ieWrappedName n
ieName (IEThingWith _ (L _ n) _ _ _) = ieWrappedName n
ieName (IEThingAll _ (L _ n)) = ieWrappedName n
ieName _ = panic "ieName failed pattern match!"
-ieNames :: IE pass -> [IdP pass]
+ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)]
ieNames (IEVar _ (L _ n) ) = [ieWrappedName n]
ieNames (IEThingAbs _ (L _ n) ) = [ieWrappedName n]
ieNames (IEThingAll _ (L _ n) ) = [ieWrappedName n]
@@ -301,7 +301,7 @@ ieNames (IEModuleContents {}) = []
ieNames (IEGroup {}) = []
ieNames (IEDoc {}) = []
ieNames (IEDocNamed {}) = []
-ieNames (XIE {}) = panic "ieNames"
+ieNames (XIE nec) = noExtCon nec
ieWrappedName :: IEWrappedName name -> name
ieWrappedName (IEName (L _ n)) = n
diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs
index d1411bd7501654e4396cb828740677d6f1cec5b0..074c7295af066a14cd4b8c2e20bc73625688be55 100644
--- a/compiler/hsSyn/HsLit.hs
+++ b/compiler/hsSyn/HsLit.hs
@@ -82,16 +82,16 @@ type instance XHsChar (GhcPass _) = SourceText
type instance XHsCharPrim (GhcPass _) = SourceText
type instance XHsString (GhcPass _) = SourceText
type instance XHsStringPrim (GhcPass _) = SourceText
-type instance XHsInt (GhcPass _) = NoExt
+type instance XHsInt (GhcPass _) = NoExtField
type instance XHsIntPrim (GhcPass _) = SourceText
type instance XHsWordPrim (GhcPass _) = SourceText
type instance XHsInt64Prim (GhcPass _) = SourceText
type instance XHsWord64Prim (GhcPass _) = SourceText
type instance XHsInteger (GhcPass _) = SourceText
-type instance XHsRat (GhcPass _) = NoExt
-type instance XHsFloatPrim (GhcPass _) = NoExt
-type instance XHsDoublePrim (GhcPass _) = NoExt
-type instance XXLit (GhcPass _) = NoExt
+type instance XHsRat (GhcPass _) = NoExtField
+type instance XHsFloatPrim (GhcPass _) = NoExtField
+type instance XHsDoublePrim (GhcPass _) = NoExtField
+type instance XXLit (GhcPass _) = NoExtCon
instance Eq (HsLit x) where
(HsChar _ x1) == (HsChar _ x2) = x1==x2
@@ -125,11 +125,11 @@ data OverLitTc
ol_type :: Type }
deriving Data
-type instance XOverLit GhcPs = NoExt
+type instance XOverLit GhcPs = NoExtField
type instance XOverLit GhcRn = Bool -- Note [ol_rebindable]
type instance XOverLit GhcTc = OverLitTc
-type instance XXOverLit (GhcPass _) = NoExt
+type instance XXOverLit (GhcPass _) = NoExtCon
-- Note [Literal source text] in BasicTypes for SourceText fields in
-- the following
@@ -147,7 +147,7 @@ negateOverLitVal _ = panic "negateOverLitVal: argument is not a number"
overLitType :: HsOverLit GhcTc -> Type
overLitType (OverLit (OverLitTc _ ty) _ _) = ty
-overLitType XOverLit{} = panic "overLitType"
+overLitType (XOverLit nec) = noExtCon nec
-- | Convert a literal from one index type to another, updating the annotations
-- according to the relevant 'Convertable' instance
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index bce65ba25a6b7accb943e0078f1dc9e0209825c8..9f8d2a5ed48ca9793a93b219612acde0e662e1d8 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -281,51 +281,51 @@ data ListPatTc
Type -- The type of the elements
(Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax
-type instance XWildPat GhcPs = NoExt
-type instance XWildPat GhcRn = NoExt
+type instance XWildPat GhcPs = NoExtField
+type instance XWildPat GhcRn = NoExtField
type instance XWildPat GhcTc = Type
-type instance XVarPat (GhcPass _) = NoExt
-type instance XLazyPat (GhcPass _) = NoExt
-type instance XAsPat (GhcPass _) = NoExt
-type instance XParPat (GhcPass _) = NoExt
-type instance XBangPat (GhcPass _) = NoExt
+type instance XVarPat (GhcPass _) = NoExtField
+type instance XLazyPat (GhcPass _) = NoExtField
+type instance XAsPat (GhcPass _) = NoExtField
+type instance XParPat (GhcPass _) = NoExtField
+type instance XBangPat (GhcPass _) = NoExtField
-- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap
-- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for
-- `SyntaxExpr`
-type instance XListPat GhcPs = NoExt
+type instance XListPat GhcPs = NoExtField
type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn)
type instance XListPat GhcTc = ListPatTc
-type instance XTuplePat GhcPs = NoExt
-type instance XTuplePat GhcRn = NoExt
+type instance XTuplePat GhcPs = NoExtField
+type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]
-type instance XSumPat GhcPs = NoExt
-type instance XSumPat GhcRn = NoExt
+type instance XSumPat GhcPs = NoExtField
+type instance XSumPat GhcRn = NoExtField
type instance XSumPat GhcTc = [Type]
-type instance XViewPat GhcPs = NoExt
-type instance XViewPat GhcRn = NoExt
+type instance XViewPat GhcPs = NoExtField
+type instance XViewPat GhcRn = NoExtField
type instance XViewPat GhcTc = Type
-type instance XSplicePat (GhcPass _) = NoExt
-type instance XLitPat (GhcPass _) = NoExt
+type instance XSplicePat (GhcPass _) = NoExtField
+type instance XLitPat (GhcPass _) = NoExtField
-type instance XNPat GhcPs = NoExt
-type instance XNPat GhcRn = NoExt
+type instance XNPat GhcPs = NoExtField
+type instance XNPat GhcRn = NoExtField
type instance XNPat GhcTc = Type
-type instance XNPlusKPat GhcPs = NoExt
-type instance XNPlusKPat GhcRn = NoExt
+type instance XNPlusKPat GhcPs = NoExtField
+type instance XNPlusKPat GhcRn = NoExtField
type instance XNPlusKPat GhcTc = Type
-type instance XSigPat GhcPs = NoExt
-type instance XSigPat GhcRn = NoExt
+type instance XSigPat GhcPs = NoExtField
+type instance XSigPat GhcRn = NoExtField
type instance XSigPat GhcTc = Type
-type instance XCoPat (GhcPass _) = NoExt
+type instance XCoPat (GhcPass _) = NoExtField
type instance XXPat (GhcPass p) = Located (Pat (GhcPass p))
@@ -460,11 +460,11 @@ data HsRecField' id arg = HsRecField {
--
-- The parsed HsRecUpdField corresponding to the record update will have:
--
--- hsRecFieldLbl = Unambiguous "x" NoExt :: AmbiguousFieldOcc RdrName
+-- hsRecFieldLbl = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName
--
-- After the renamer, this will become:
--
--- hsRecFieldLbl = Ambiguous "x" NoExt :: AmbiguousFieldOcc Name
+-- hsRecFieldLbl = Ambiguous "x" noExtField :: AmbiguousFieldOcc Name
--
-- (note that the Unambiguous constructor is not type-correct here).
-- The typechecker will determine the particular selector:
@@ -630,7 +630,7 @@ mkNilPat ty = mkPrefixConPat nilDataCon [] [ty]
mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p)
mkCharLitPat src c = mkPrefixConPat charDataCon
- [noLoc $ LitPat NoExt (HsCharPrim src c)] []
+ [noLoc $ LitPat noExtField (HsCharPrim src c)] []
{-
************************************************************************
@@ -811,7 +811,7 @@ conPatNeedsParens p = go
-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p)
parenthesizePat p lpat@(dL->L loc pat)
- | patNeedsParens p pat = cL loc (ParPat NoExt lpat)
+ | patNeedsParens p pat = cL loc (ParPat noExtField lpat)
| otherwise = lpat
{-
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 130e39efabef1b0e126d3125858ce3b64b2943f1..b9b140bf458e927c8911131f5438196fb40fc6c4 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -334,14 +334,14 @@ type HsQTvsRn = [Name] -- Implicit variables
-- For example, in data T (a :: k1 -> k2) = ...
-- the 'a' is explicit while 'k1', 'k2' are implicit
-type instance XHsQTvs GhcPs = NoExt
+type instance XHsQTvs GhcPs = NoExtField
type instance XHsQTvs GhcRn = HsQTvsRn
type instance XHsQTvs GhcTc = HsQTvsRn
-type instance XXLHsQTyVars (GhcPass _) = NoExt
+type instance XXLHsQTyVars (GhcPass _) = NoExtCon
mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs
-mkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs }
+mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs }
hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit = hsq_explicit
@@ -372,11 +372,11 @@ data HsImplicitBndrs pass thing -- See Note [HsType binders]
}
| XHsImplicitBndrs (XXHsImplicitBndrs pass thing)
-type instance XHsIB GhcPs _ = NoExt
+type instance XHsIB GhcPs _ = NoExtField
type instance XHsIB GhcRn _ = [Name]
type instance XHsIB GhcTc _ = [Name]
-type instance XXHsImplicitBndrs (GhcPass _) _ = NoExt
+type instance XXHsImplicitBndrs (GhcPass _) _ = NoExtCon
-- | Haskell Wildcard Binders
data HsWildCardBndrs pass thing
@@ -394,11 +394,11 @@ data HsWildCardBndrs pass thing
}
| XHsWildCardBndrs (XXHsWildCardBndrs pass thing)
-type instance XHsWC GhcPs b = NoExt
+type instance XHsWC GhcPs b = NoExtField
type instance XHsWC GhcRn b = [Name]
type instance XHsWC GhcTc b = [Name]
-type instance XXHsWildCardBndrs (GhcPass _) b = NoExt
+type instance XXHsWildCardBndrs (GhcPass _) b = NoExtCon
-- | Located Haskell Signature Type
type LHsSigType pass = HsImplicitBndrs pass (LHsType pass) -- Implicit only
@@ -411,11 +411,11 @@ type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both
-- See Note [Representing type signatures]
-hsImplicitBody :: HsImplicitBndrs pass thing -> thing
+hsImplicitBody :: HsImplicitBndrs (GhcPass p) thing -> thing
hsImplicitBody (HsIB { hsib_body = body }) = body
-hsImplicitBody (XHsImplicitBndrs _) = panic "hsImplicitBody"
+hsImplicitBody (XHsImplicitBndrs nec) = noExtCon nec
-hsSigType :: LHsSigType pass -> LHsType pass
+hsSigType :: LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType = hsImplicitBody
hsSigWcType :: LHsSigWcType pass -> LHsType pass
@@ -446,12 +446,12 @@ the explicitly forall'd tyvar 'a' is bound by the HsForAllTy
-}
mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing
-mkHsImplicitBndrs x = HsIB { hsib_ext = noExt
+mkHsImplicitBndrs x = HsIB { hsib_ext = noExtField
, hsib_body = x }
mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing
mkHsWildCardBndrs x = HsWC { hswc_body = x
- , hswc_ext = noExt }
+ , hswc_ext = noExtField }
-- Add empty binders. This is a bit suspicious; what if
-- the wrapped thing had free type variables?
@@ -502,15 +502,15 @@ data HsTyVarBndr pass
| XTyVarBndr
(XXTyVarBndr pass)
-type instance XUserTyVar (GhcPass _) = NoExt
-type instance XKindedTyVar (GhcPass _) = NoExt
-type instance XXTyVarBndr (GhcPass _) = NoExt
+type instance XUserTyVar (GhcPass _) = NoExtField
+type instance XKindedTyVar (GhcPass _) = NoExtField
+type instance XXTyVarBndr (GhcPass _) = NoExtCon
-- | Does this 'HsTyVarBndr' come with an explicit kind annotation?
isHsKindedTyVar :: HsTyVarBndr pass -> Bool
isHsKindedTyVar (UserTyVar {}) = False
isHsKindedTyVar (KindedTyVar {}) = True
-isHsKindedTyVar (XTyVarBndr{}) = panic "isHsKindedTyVar"
+isHsKindedTyVar (XTyVarBndr {}) = False
-- | Do all type variables in this 'LHsQTyVars' come with kind annotations?
hsTvbAllKinded :: LHsQTyVars pass -> Bool
@@ -704,41 +704,41 @@ data NewHsTypeX
instance Outputable NewHsTypeX where
ppr (NHsCoreTy ty) = ppr ty
-type instance XForAllTy (GhcPass _) = NoExt
-type instance XQualTy (GhcPass _) = NoExt
-type instance XTyVar (GhcPass _) = NoExt
-type instance XAppTy (GhcPass _) = NoExt
-type instance XFunTy (GhcPass _) = NoExt
-type instance XListTy (GhcPass _) = NoExt
-type instance XTupleTy (GhcPass _) = NoExt
-type instance XSumTy (GhcPass _) = NoExt
-type instance XOpTy (GhcPass _) = NoExt
-type instance XParTy (GhcPass _) = NoExt
-type instance XIParamTy (GhcPass _) = NoExt
-type instance XStarTy (GhcPass _) = NoExt
-type instance XKindSig (GhcPass _) = NoExt
+type instance XForAllTy (GhcPass _) = NoExtField
+type instance XQualTy (GhcPass _) = NoExtField
+type instance XTyVar (GhcPass _) = NoExtField
+type instance XAppTy (GhcPass _) = NoExtField
+type instance XFunTy (GhcPass _) = NoExtField
+type instance XListTy (GhcPass _) = NoExtField
+type instance XTupleTy (GhcPass _) = NoExtField
+type instance XSumTy (GhcPass _) = NoExtField
+type instance XOpTy (GhcPass _) = NoExtField
+type instance XParTy (GhcPass _) = NoExtField
+type instance XIParamTy (GhcPass _) = NoExtField
+type instance XStarTy (GhcPass _) = NoExtField
+type instance XKindSig (GhcPass _) = NoExtField
type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives
-type instance XSpliceTy GhcPs = NoExt
-type instance XSpliceTy GhcRn = NoExt
+type instance XSpliceTy GhcPs = NoExtField
+type instance XSpliceTy GhcRn = NoExtField
type instance XSpliceTy GhcTc = Kind
-type instance XDocTy (GhcPass _) = NoExt
-type instance XBangTy (GhcPass _) = NoExt
-type instance XRecTy (GhcPass _) = NoExt
+type instance XDocTy (GhcPass _) = NoExtField
+type instance XBangTy (GhcPass _) = NoExtField
+type instance XRecTy (GhcPass _) = NoExtField
-type instance XExplicitListTy GhcPs = NoExt
-type instance XExplicitListTy GhcRn = NoExt
+type instance XExplicitListTy GhcPs = NoExtField
+type instance XExplicitListTy GhcRn = NoExtField
type instance XExplicitListTy GhcTc = Kind
-type instance XExplicitTupleTy GhcPs = NoExt
-type instance XExplicitTupleTy GhcRn = NoExt
+type instance XExplicitTupleTy GhcPs = NoExtField
+type instance XExplicitTupleTy GhcRn = NoExtField
type instance XExplicitTupleTy GhcTc = [Kind]
-type instance XTyLit (GhcPass _) = NoExt
+type instance XTyLit (GhcPass _) = NoExtField
-type instance XWildCardTy (GhcPass _) = NoExt
+type instance XWildCardTy (GhcPass _) = NoExtField
type instance XXType (GhcPass _) = NewHsTypeX
@@ -890,8 +890,8 @@ data ConDeclField pass -- Record fields have Haddoc docs on them
-- For details on above see note [Api annotations] in ApiAnnotation
| XConDeclField (XXConDeclField pass)
-type instance XConDeclField (GhcPass _) = NoExt
-type instance XXConDeclField (GhcPass _) = NoExt
+type instance XConDeclField (GhcPass _) = NoExtField
+type instance XXConDeclField (GhcPass _) = NoExtCon
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (ConDeclField p) where
@@ -962,8 +962,8 @@ hsWcScopedTvs sig_ty
-- include kind variables only if the type is headed by forall
-- (this is consistent with GHC 7 behaviour)
_ -> nwcs
-hsWcScopedTvs (HsWC _ (XHsImplicitBndrs _)) = panic "hsWcScopedTvs"
-hsWcScopedTvs (XHsWildCardBndrs _) = panic "hsWcScopedTvs"
+hsWcScopedTvs (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
+hsWcScopedTvs (XHsWildCardBndrs nec) = noExtCon nec
hsScopedTvs :: LHsSigType GhcRn -> [Name]
-- Same as hsWcScopedTvs, but for a LHsSigType
@@ -989,18 +989,18 @@ I don't know if this is a good idea, but there it is.
-}
---------------------
-hsTyVarName :: HsTyVarBndr pass -> IdP pass
+hsTyVarName :: HsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
hsTyVarName (UserTyVar _ (L _ n)) = n
hsTyVarName (KindedTyVar _ (L _ n) _) = n
-hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName"
+hsTyVarName (XTyVarBndr nec) = noExtCon nec
-hsLTyVarName :: LHsTyVarBndr pass -> IdP pass
+hsLTyVarName :: LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p)
hsLTyVarName = hsTyVarName . unLoc
-hsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass]
+hsLTyVarNames :: [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)]
hsLTyVarNames = map hsLTyVarName
-hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass]
+hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)]
-- Explicit variables only
hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs)
@@ -1009,28 +1009,28 @@ hsAllLTyVarNames :: LHsQTyVars GhcRn -> [Name]
hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
, hsq_explicit = tvs })
= kvs ++ hsLTyVarNames tvs
-hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames"
+hsAllLTyVarNames (XLHsQTyVars nec) = noExtCon nec
-hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)
+hsLTyVarLocName :: LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p))
hsLTyVarLocName = onHasSrcSpan hsTyVarName
-hsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)]
+hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [Located (IdP (GhcPass p))]
hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)
-- | Convert a LHsTyVarBndr to an equivalent LHsType.
hsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p)
hsLTyVarBndrToType = onHasSrcSpan cvt
- where cvt (UserTyVar _ n) = HsTyVar noExt NotPromoted n
+ where cvt (UserTyVar _ n) = HsTyVar noExtField NotPromoted n
cvt (KindedTyVar _ (L name_loc n) kind)
- = HsKindSig noExt
- (L name_loc (HsTyVar noExt NotPromoted (L name_loc n))) kind
- cvt (XTyVarBndr{}) = panic "hsLTyVarBndrToType"
+ = HsKindSig noExtField
+ (L name_loc (HsTyVar noExtField NotPromoted (L name_loc n))) kind
+ cvt (XTyVarBndr nec) = noExtCon nec
-- | Convert a LHsTyVarBndrs to a list of types.
-- Works on *type* variable only, no kind vars.
hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)]
hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs
-hsLTyVarBndrsToTypes (XLHsQTyVars _) = panic "hsLTyVarBndrsToTypes"
+hsLTyVarBndrsToTypes (XLHsQTyVars nec) = noExtCon nec
---------------------
ignoreParens :: LHsType pass -> LHsType pass
@@ -1050,15 +1050,15 @@ isLHsForAllTy _ = False
-}
mkAnonWildCardTy :: HsType GhcPs
-mkAnonWildCardTy = HsWildCardTy noExt
+mkAnonWildCardTy = HsWildCardTy noExtField
mkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p))
-> LHsType (GhcPass p) -> HsType (GhcPass p)
-mkHsOpTy ty1 op ty2 = HsOpTy noExt ty1 op ty2
+mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2
mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
mkHsAppTy t1 t2
- = addCLoc t1 t2 (HsAppTy noExt t1 (parenthesizeHsType appPrec t2))
+ = addCLoc t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))
mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
-> LHsType (GhcPass p)
@@ -1270,9 +1270,9 @@ splitLHsInstDeclTy (HsIB { hsib_ext = itkvs
= (itkvs ++ hsLTyVarNames tvs, cxt, body_ty)
-- Return implicitly bound type and kind vars
-- For an instance decl, all of them are in scope
-splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy"
+splitLHsInstDeclTy (XHsImplicitBndrs nec) = noExtCon nec
-getLHsInstDeclHead :: LHsSigType pass -> LHsType pass
+getLHsInstDeclHead :: LHsSigType (GhcPass p) -> LHsType (GhcPass p)
getLHsInstDeclHead inst_ty
| (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty)
= body_ty
@@ -1311,17 +1311,17 @@ data FieldOcc pass = FieldOcc { extFieldOcc :: XCFieldOcc pass
deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq (FieldOcc p)
deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p)
-type instance XCFieldOcc GhcPs = NoExt
+type instance XCFieldOcc GhcPs = NoExtField
type instance XCFieldOcc GhcRn = Name
type instance XCFieldOcc GhcTc = Id
-type instance XXFieldOcc (GhcPass _) = NoExt
+type instance XXFieldOcc (GhcPass _) = NoExtCon
instance Outputable (FieldOcc pass) where
ppr = ppr . rdrNameFieldOcc
mkFieldOcc :: Located RdrName -> FieldOcc GhcPs
-mkFieldOcc rdr = FieldOcc noExt rdr
+mkFieldOcc rdr = FieldOcc noExtField rdr
-- | Ambiguous Field Occurrence
@@ -1341,15 +1341,15 @@ data AmbiguousFieldOcc pass
| Ambiguous (XAmbiguous pass) (Located RdrName)
| XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass)
-type instance XUnambiguous GhcPs = NoExt
+type instance XUnambiguous GhcPs = NoExtField
type instance XUnambiguous GhcRn = Name
type instance XUnambiguous GhcTc = Id
-type instance XAmbiguous GhcPs = NoExt
-type instance XAmbiguous GhcRn = NoExt
+type instance XAmbiguous GhcPs = NoExtField
+type instance XAmbiguous GhcRn = NoExtField
type instance XAmbiguous GhcTc = Id
-type instance XXAmbiguousFieldOcc (GhcPass _) = NoExt
+type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon
instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where
ppr = ppr . rdrNameAmbiguousFieldOcc
@@ -1359,28 +1359,28 @@ instance p ~ GhcPass pass => OutputableBndr (AmbiguousFieldOcc p) where
pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc
mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs
-mkAmbiguousFieldOcc rdr = Unambiguous noExt rdr
+mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr
rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr
rdrNameAmbiguousFieldOcc (Ambiguous _ (L _ rdr)) = rdr
-rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc _)
- = panic "rdrNameAmbiguousFieldOcc"
+rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc nec)
+ = noExtCon nec
selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id
selectorAmbiguousFieldOcc (Unambiguous sel _) = sel
selectorAmbiguousFieldOcc (Ambiguous sel _) = sel
-selectorAmbiguousFieldOcc (XAmbiguousFieldOcc _)
- = panic "selectorAmbiguousFieldOcc"
+selectorAmbiguousFieldOcc (XAmbiguousFieldOcc nec)
+ = noExtCon nec
unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc
unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel
unambiguousFieldOcc (Ambiguous rdr sel) = FieldOcc rdr sel
-unambiguousFieldOcc (XAmbiguousFieldOcc _) = panic "unambiguousFieldOcc"
+unambiguousFieldOcc (XAmbiguousFieldOcc nec) = noExtCon nec
ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc
ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr
-ambiguousFieldOcc (XFieldOcc _) = panic "ambiguousFieldOcc"
+ambiguousFieldOcc (XFieldOcc nec) = noExtCon nec
{-
************************************************************************
@@ -1664,7 +1664,7 @@ lhsTypeHasLeadingPromotionQuote ty
-- returns @ty@.
parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
parenthesizeHsType p lty@(L loc ty)
- | hsTypeNeedsParens p ty = L loc (HsParTy NoExt lty)
+ | hsTypeNeedsParens p ty = L loc (HsParTy noExtField lty)
| otherwise = lty
-- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 531ff46ee40a7e88c0bbed3b8141b3c47920fa6f..93e7cf5f816332c78807b4f108db7736db6bf480 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -140,14 +140,14 @@ just attach noSrcSpan to everything.
-}
mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsPar e = cL (getLoc e) (HsPar noExt e)
+mkHsPar e = cL (getLoc e) (HsPar noExtField e)
mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> [LPat (GhcPass p)] -> Located (body (GhcPass p))
-> LMatch (GhcPass p) (Located (body (GhcPass p)))
mkSimpleMatch ctxt pats rhs
= cL loc $
- Match { m_ext = noExt, m_ctxt = ctxt, m_pats = pats
+ Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = pats
, m_grhss = unguardedGRHSs rhs }
where
loc = case pats of
@@ -157,16 +157,16 @@ mkSimpleMatch ctxt pats rhs
unguardedGRHSs :: Located (body (GhcPass p))
-> GRHSs (GhcPass p) (Located (body (GhcPass p)))
unguardedGRHSs rhs@(dL->L loc _)
- = GRHSs noExt (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
+ = GRHSs noExtField (unguardedRHS loc rhs) (noLoc emptyLocalBinds)
unguardedRHS :: SrcSpan -> Located (body (GhcPass p))
-> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]
-unguardedRHS loc rhs = [cL loc (GRHS noExt [] rhs)]
+unguardedRHS loc rhs = [cL loc (GRHS noExtField [] rhs)]
-mkMatchGroup :: (XMG name (Located (body name)) ~ NoExt)
+mkMatchGroup :: (XMG name (Located (body name)) ~ NoExtField)
=> Origin -> [LMatch name (Located (body name))]
-> MatchGroup name (Located (body name))
-mkMatchGroup origin matches = MG { mg_ext = noExt
+mkMatchGroup origin matches = MG { mg_ext = noExtField
, mg_alts = mkLocatedList matches
, mg_origin = origin }
@@ -175,11 +175,11 @@ mkLocatedList [] = noLoc []
mkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms
mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)
+mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExtField e1 e2)
mkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn)
=> LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)
-mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct)
+mkHsAppType e t = addCLoc e t_body (HsAppType noExtField e paren_wct)
where
t_body = hswc_body t
paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }
@@ -187,9 +187,9 @@ mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct)
mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn
mkHsAppTypes = foldl' mkHsAppType
-mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExt) =>
+mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
-mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExt matches))
+mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExtField matches))
where
matches = mkMatchGroup Generated
[mkSimpleMatch LambdaExpr pats' body]
@@ -208,7 +208,7 @@ mkHsCaseAlt pat expr
nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id)
nlHsTyApp fun_id tys
- = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id)))
+ = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLoc fun_id)))
nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
@@ -219,16 +219,16 @@ mkLHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them
-- So 'f x' becomes '(f x)', but '3' stays as '3'
mkLHsPar le@(dL->L loc e)
- | hsExprNeedsParens appPrec e = cL loc (HsPar noExt le)
+ | hsExprNeedsParens appPrec e = cL loc (HsPar noExtField le)
| otherwise = le
mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
mkParPat lp@(dL->L loc p)
- | patNeedsParens appPrec p = cL loc (ParPat noExt lp)
+ | patNeedsParens appPrec p = cL loc (ParPat noExtField lp)
| otherwise = lp
nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)
-nlParPat p = noLoc (ParPat noExt p)
+nlParPat p = noLoc (ParPat noExtField p)
-------------------------------
-- These are the bits of syntax that contain rebindable names
@@ -250,7 +250,7 @@ mkLastStmt :: Located (bodyR (GhcPass idR))
mkBodyStmt :: Located (bodyR GhcPs)
-> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs))
mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)
- (Located (bodyR (GhcPass idR))) ~ NoExt)
+ (Located (bodyR (GhcPass idR))) ~ NoExtField)
=> LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))
-> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)
@@ -263,26 +263,26 @@ mkRecStmt :: [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
-mkHsIntegral i = OverLit noExt (HsIntegral i) noExpr
-mkHsFractional f = OverLit noExt (HsFractional f) noExpr
-mkHsIsString src s = OverLit noExt (HsIsString src s) noExpr
+mkHsIntegral i = OverLit noExtField (HsIntegral i) noExpr
+mkHsFractional f = OverLit noExtField (HsFractional f) noExpr
+mkHsIsString src s = OverLit noExtField (HsIsString src s) noExpr
-mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts)
+mkHsDo ctxt stmts = HsDo noExtField ctxt (mkLocatedList stmts)
mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])
where
last_stmt = cL (getLoc expr) $ mkLastStmt expr
mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
-> HsExpr (GhcPass p)
-mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b
+mkHsIf c a b = HsIf noExtField (Just noSyntaxExpr) c a b
mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
-> HsCmd (GhcPass p)
-mkHsCmdIf c a b = HsCmdIf noExt (Just noSyntaxExpr) c a b
+mkHsCmdIf c a b = HsCmdIf noExtField (Just noSyntaxExpr) c a b
-mkNPat lit neg = NPat noExt lit neg noSyntaxExpr
+mkNPat lit neg = NPat noExtField lit neg noSyntaxExpr
mkNPlusKPat id lit
- = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
+ = NPlusKPat noExtField id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
mkTransformStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
@@ -295,7 +295,7 @@ mkGroupByUsingStmt :: [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-emptyTransStmt = TransStmt { trS_ext = noExt
+emptyTransStmt = TransStmt { trS_ext = noExtField
, trS_form = panic "emptyTransStmt: form"
, trS_stmts = [], trS_bndrs = []
, trS_by = Nothing, trS_using = noLoc noExpr
@@ -306,11 +306,11 @@ mkTransformByStmt ss u b = emptyTransStmt { trS_form = ThenForm, trS_stmts = s
mkGroupUsingStmt ss u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u }
mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b }
-mkLastStmt body = LastStmt noExt body False noSyntaxExpr
+mkLastStmt body = LastStmt noExtField body False noSyntaxExpr
mkBodyStmt body
- = BodyStmt noExt body noSyntaxExpr noSyntaxExpr
+ = BodyStmt noExtField body noSyntaxExpr noSyntaxExpr
mkBindStmt pat body
- = BindStmt noExt pat body noSyntaxExpr noSyntaxExpr
+ = BindStmt noExtField pat body noSyntaxExpr noSyntaxExpr
mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr
-- don't use placeHolderTypeTc above, because that panics during zonking
@@ -332,8 +332,8 @@ unitRecStmtTc = RecStmtTc { recS_bind_ty = unitTy
, recS_rec_rets = []
, recS_ret_ty = unitTy }
-emptyRecStmt = emptyRecStmt' noExt
-emptyRecStmtName = emptyRecStmt' noExt
+emptyRecStmt = emptyRecStmt' noExtField
+emptyRecStmtName = emptyRecStmt' noExtField
emptyRecStmtId = emptyRecStmt' unitRecStmtTc
-- a panic might trigger during zonking
mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
@@ -342,20 +342,20 @@ mkRecStmt stmts = emptyRecStmt { recS_stmts = stmts }
--- A useful function for building @OpApps@. The operator is always a
-- variable, and we don't know the fixity yet.
mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
-mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2
+mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLoc (HsVar noExtField (noLoc op))) e2
unqualSplice :: RdrName
unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))
mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
-mkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e
+mkUntypedSplice hasParen e = HsUntypedSplice noExtField hasParen unqualSplice e
mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs
-mkTypedSplice hasParen e = HsTypedSplice noExt hasParen unqualSplice e
+mkTypedSplice hasParen e = HsTypedSplice noExtField hasParen unqualSplice e
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote quoter span quote
- = HsQuasiQuote noExt unqualSplice quoter span quote
+ = HsQuasiQuote noExtField unqualSplice quoter span quote
unqualQuasiQuote :: RdrName
unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))
@@ -372,11 +372,11 @@ mkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs)
userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))]
-> [LHsTyVarBndr (GhcPass p)]
-- Caller sets location
-userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt v) | v <- bndrs ]
+userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField v) | v <- bndrs ]
userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)]
-- Caller sets location
-userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v))
+userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField (cL loc v))
| v <- bndrs ]
@@ -389,26 +389,26 @@ userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v))
-}
nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)
-nlHsVar n = noLoc (HsVar noExt (noLoc n))
+nlHsVar n = noLoc (HsVar noExtField (noLoc n))
-- NB: Only for LHsExpr **Id**
nlHsDataCon :: DataCon -> LHsExpr GhcTc
-nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con))
+nlHsDataCon con = noLoc (HsConLikeOut noExtField (RealDataCon con))
nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)
-nlHsLit n = noLoc (HsLit noExt n)
+nlHsLit n = noLoc (HsLit noExtField n)
nlHsIntLit :: Integer -> LHsExpr (GhcPass p)
-nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n)))
+nlHsIntLit n = noLoc (HsLit noExtField (HsInt noExtField (mkIntegralLit n)))
nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)
-nlVarPat n = noLoc (VarPat noExt (noLoc n))
+nlVarPat n = noLoc (VarPat noExtField (noLoc n))
nlLitPat :: HsLit GhcPs -> LPat GhcPs
-nlLitPat l = noLoc (LitPat noExt l)
+nlLitPat l = noLoc (LitPat noExtField l)
nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
-nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x))
+nlHsApp f x = noLoc (HsApp noExtField f (mkLHsPar x))
nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
@@ -427,10 +427,10 @@ nlHsApps :: IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs
nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
-nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExt (noLoc f))
- (map ((HsVar noExt) . noLoc) xs))
+nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExtField (noLoc f))
+ (map ((HsVar noExtField) . noLoc) xs))
where
- mk f a = HsApp noExt (noLoc f) (noLoc a)
+ mk f a = HsApp noExtField (noLoc f) (noLoc a)
nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs
nlConVarPat con vars = nlConPat con (map nlVarPat vars)
@@ -460,10 +460,10 @@ nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
nlWildPat)))
nlWildPat :: LPat GhcPs
-nlWildPat = noLoc (WildPat noExt ) -- Pre-typechecking
+nlWildPat = noLoc (WildPat noExtField ) -- Pre-typechecking
nlWildPatName :: LPat GhcRn
-nlWildPatName = noLoc (WildPat noExt ) -- Pre-typechecking
+nlWildPatName = noLoc (WildPat noExtField ) -- Pre-typechecking
nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]
-> LHsExpr GhcPs
@@ -480,27 +480,27 @@ nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsExpr GhcPs
nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
-nlHsLam match = noLoc (HsLam noExt (mkMatchGroup Generated [match]))
-nlHsPar e = noLoc (HsPar noExt e)
+nlHsLam match = noLoc (HsLam noExtField (mkMatchGroup Generated [match]))
+nlHsPar e = noLoc (HsPar noExtField e)
-- Note [Rebindable nlHsIf]
-- nlHsIf should generate if-expressions which are NOT subject to
-- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)
-nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false)
+nlHsIf cond true false = noLoc (HsIf noExtField Nothing cond true false)
nlHsCase expr matches
- = noLoc (HsCase noExt expr (mkMatchGroup Generated matches))
-nlList exprs = noLoc (ExplicitList noExt Nothing exprs)
+ = noLoc (HsCase noExtField expr (mkMatchGroup Generated matches))
+nlList exprs = noLoc (ExplicitList noExtField Nothing exprs)
nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsTyVar :: IdP (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsParTy :: LHsType (GhcPass p) -> LHsType (GhcPass p)
-nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t))
-nlHsTyVar x = noLoc (HsTyVar noExt NotPromoted (noLoc x))
-nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) b)
-nlHsParTy t = noLoc (HsParTy noExt t)
+nlHsAppTy f t = noLoc (HsAppTy noExtField f (parenthesizeHsType appPrec t))
+nlHsTyVar x = noLoc (HsTyVar noExtField NotPromoted (noLoc x))
+nlHsFunTy a b = noLoc (HsFunTy noExtField (parenthesizeHsType funPrec a) b)
+nlHsParTy t = noLoc (HsParTy noExtField t)
nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
nlHsTyConApp tycon tys = foldl' nlHsAppTy (nlHsTyVar tycon) tys
@@ -519,21 +519,21 @@ mkLHsTupleExpr :: [LHsExpr (GhcPass a)] -> LHsExpr (GhcPass a)
-- Makes a pre-typechecker boxed tuple, deals with 1 case
mkLHsTupleExpr [e] = e
mkLHsTupleExpr es
- = noLoc $ ExplicitTuple noExt (map (noLoc . (Present noExt)) es) Boxed
+ = noLoc $ ExplicitTuple noExtField (map (noLoc . (Present noExtField)) es) Boxed
mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a)
mkLHsVarTuple ids = mkLHsTupleExpr (map nlHsVar ids)
nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs
-nlTuplePat pats box = noLoc (TuplePat noExt pats box)
+nlTuplePat pats box = noLoc (TuplePat noExtField pats box)
missingTupArg :: HsTupArg GhcPs
-missingTupArg = Missing noExt
+missingTupArg = Missing noExtField
mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn
-mkLHsPatTup [] = noLoc $ TuplePat noExt [] Boxed
+mkLHsPatTup [] = noLoc $ TuplePat noExtField [] Boxed
mkLHsPatTup [lpat] = lpat
-mkLHsPatTup lpats = cL (getLoc (head lpats)) $ TuplePat noExt lpats Boxed
+mkLHsPatTup lpats = cL (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed
-- The Big equivalents for the source tuple expressions
mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
@@ -637,7 +637,7 @@ mkClassOpSigs sigs
= map fiddle sigs
where
fiddle (dL->L loc (TypeSig _ nms ty))
- = cL loc (ClassOpSig noExt False nms (dropWildCards ty))
+ = cL loc (ClassOpSig noExtField False nms (dropWildCards ty))
fiddle sig = sig
typeToLHsType :: Type -> LHsType GhcPs
@@ -655,25 +655,25 @@ typeToLHsType ty
VisArg -> nlHsFunTy (go arg) (go res)
InvisArg | (theta, tau) <- tcSplitPhiTy ty
-> noLoc (HsQualTy { hst_ctxt = noLoc (map go theta)
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = go tau })
go ty@(ForAllTy (Bndr _ argf) _)
| (tvs, tau) <- tcSplitForAllTysSameVis argf ty
= noLoc (HsForAllTy { hst_fvf = argToForallVisFlag argf
, hst_bndrs = map go_tv tvs
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = go tau })
go (TyVarTy tv) = nlHsTyVar (getRdrName tv)
go (LitTy (NumTyLit n))
- = noLoc $ HsTyLit NoExt (HsNumTy NoSourceText n)
+ = noLoc $ HsTyLit noExtField (HsNumTy NoSourceText n)
go (LitTy (StrTyLit s))
- = noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s)
+ = noLoc $ HsTyLit noExtField (HsStrTy NoSourceText s)
go ty@(TyConApp tc args)
| tyConAppNeedsKindSig True tc (length args)
-- We must produce an explicit kind signature here to make certain
-- programs kind-check. See Note [Kind signatures in typeToLHsType].
- = nlHsParTy $ noLoc $ HsKindSig NoExt ty' (go (tcTypeKind ty))
+ = nlHsParTy $ noLoc $ HsKindSig noExtField ty' (go (tcTypeKind ty))
| otherwise = ty'
where
ty' :: LHsType GhcPs
@@ -703,7 +703,7 @@ typeToLHsType ty
head (zip args arg_flags)
go_tv :: TyVar -> LHsTyVarBndr GhcPs
- go_tv tv = noLoc $ KindedTyVar noExt (noLoc (getRdrName tv))
+ go_tv tv = noLoc $ KindedTyVar noExtField (noLoc (getRdrName tv))
(go (tyVarKind tv))
{-
@@ -762,7 +762,7 @@ mkLHsWrap co_fn (dL->L loc e) = cL loc (mkHsWrap co_fn e)
mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
mkHsWrap co_fn e | isIdHsWrapper co_fn = e
mkHsWrap co_fn (HsWrap _ co_fn' e) = mkHsWrap (co_fn <.> co_fn') e
-mkHsWrap co_fn e = HsWrap noExt co_fn e
+mkHsWrap co_fn e = HsWrap noExtField co_fn e
mkHsWrapCo :: TcCoercionN -- A Nominal coercion a ~N b
-> HsExpr (GhcPass id) -> HsExpr (GhcPass id)
@@ -777,18 +777,18 @@ mkLHsWrapCo co (dL->L loc e) = cL loc (mkHsWrapCo co e)
mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p)
mkHsCmdWrap w cmd | isIdHsWrapper w = cmd
- | otherwise = HsCmdWrap noExt w cmd
+ | otherwise = HsCmdWrap noExtField w cmd
mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)
mkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c)
mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p
- | otherwise = CoPat noExt co_fn p ty
+ | otherwise = CoPat noExtField co_fn p ty
mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id)
mkHsWrapPatCo co pat ty | isTcReflCo co = pat
- | otherwise = CoPat noExt (mkWpCastN co) pat ty
+ | otherwise = CoPat noExtField (mkWpCastN co) pat ty
mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
@@ -808,7 +808,7 @@ mkFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
mkFunBind fn ms = FunBind { fun_id = fn
, fun_matches = mkMatchGroup Generated ms
, fun_co_fn = idHsWrapper
- , fun_ext = noExt
+ , fun_ext = noExtField
, fun_tick = [] }
mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]
@@ -826,14 +826,14 @@ mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
mkVarBind var rhs = cL (getLoc rhs) $
- VarBind { var_ext = noExt,
+ VarBind { var_ext = noExtField,
var_id = var, var_rhs = rhs, var_inline = False }
mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)
-> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs
-mkPatSynBind name details lpat dir = PatSynBind noExt psb
+mkPatSynBind name details lpat dir = PatSynBind noExtField psb
where
- psb = PSB{ psb_ext = noExt
+ psb = PSB{ psb_ext = noExtField
, psb_id = name
, psb_args = details
, psb_def = lpat
@@ -867,13 +867,13 @@ mkMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))
-> Located (HsLocalBinds (GhcPass p))
-> LMatch (GhcPass p) (LHsExpr (GhcPass p))
mkMatch ctxt pats expr lbinds
- = noLoc (Match { m_ext = noExt
+ = noLoc (Match { m_ext = noExtField
, m_ctxt = ctxt
, m_pats = map paren pats
- , m_grhss = GRHSs noExt (unguardedRHS noSrcSpan expr) lbinds })
+ , m_grhss = GRHSs noExtField (unguardedRHS noSrcSpan expr) lbinds })
where
paren lp@(dL->L l p)
- | patNeedsParens appPrec p = cL l (ParPat noExt lp)
+ | patNeedsParens appPrec p = cL l (ParPat noExtField lp)
| otherwise = lp
{-
@@ -1054,7 +1054,7 @@ collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat
collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat
collectArgBinders _ = []
-collectStmtBinders XStmtLR{} = panic "collectStmtBinders"
+collectStmtBinders (XStmtLR nec) = noExtCon nec
----------------- Patterns --------------------------
@@ -1130,7 +1130,7 @@ hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
hs_fords = foreign_decls })
= collectHsValBinders val_decls
++ hsTyClForeignBinders tycl_decls foreign_decls
-hsGroupBinders (XHsGroup {}) = panic "hsGroupBinders"
+hsGroupBinders (XHsGroup nec) = noExtCon nec
hsTyClForeignBinders :: [TyClGroup GhcRn]
-> [LForeignDecl GhcRn]
@@ -1148,8 +1148,8 @@ hsTyClForeignBinders tycl_decls foreign_decls
getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs
-------------------
-hsLTyClDeclBinders :: Located (TyClDecl pass)
- -> ([Located (IdP pass)], [LFieldOcc pass])
+hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p))
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
-- ^ Returns all the /binding/ names of the decl. The first one is
-- guaranteed to be the name of the decl. The first component
-- represents all binding names except record fields; the second
@@ -1162,8 +1162,8 @@ hsLTyClDeclBinders :: Located (TyClDecl pass)
hsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl
{ fdLName = (dL->L _ name) } }))
= ([cL loc name], [])
-hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl _ }))
- = panic "hsLTyClDeclBinders"
+hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl nec }))
+ = noExtCon nec
hsLTyClDeclBinders (dL->L loc (SynDecl
{ tcdLName = (dL->L _ name) }))
= ([cL loc name], [])
@@ -1181,7 +1181,7 @@ hsLTyClDeclBinders (dL->L loc (ClassDecl
hsLTyClDeclBinders (dL->L loc (DataDecl { tcdLName = (dL->L _ name)
, tcdDataDefn = defn }))
= (\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn
-hsLTyClDeclBinders (dL->L _ (XTyClDecl _)) = panic "hsLTyClDeclBinders"
+hsLTyClDeclBinders (dL->L _ (XTyClDecl nec)) = noExtCon nec
hsLTyClDeclBinders _ = panic "hsLTyClDeclBinders: Impossible Match"
-- due to #15884
@@ -1224,48 +1224,50 @@ hsLInstDeclBinders (dL->L _ (ClsInstD
hsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi }))
= hsDataFamInstBinders fi
hsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty
-hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl {})))
- = panic "hsLInstDeclBinders"
-hsLInstDeclBinders (dL->L _ (XInstDecl _))
- = panic "hsLInstDeclBinders"
+hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl nec)))
+ = noExtCon nec
+hsLInstDeclBinders (dL->L _ (XInstDecl nec))
+ = noExtCon nec
hsLInstDeclBinders _ = panic "hsLInstDeclBinders: Impossible Match"
-- due to #15884
-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
-hsDataFamInstBinders :: DataFamInstDecl pass
- -> ([Located (IdP pass)], [LFieldOcc pass])
+hsDataFamInstBinders :: DataFamInstDecl (GhcPass p)
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
FamEqn { feqn_rhs = defn }}})
= hsDataDefnBinders defn
-- There can't be repeated symbols because only data instances have binders
hsDataFamInstBinders (DataFamInstDecl
- { dfid_eqn = HsIB { hsib_body = XFamEqn _}})
- = panic "hsDataFamInstBinders"
-hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _))
- = panic "hsDataFamInstBinders"
+ { dfid_eqn = HsIB { hsib_body = XFamEqn nec}})
+ = noExtCon nec
+hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs nec))
+ = noExtCon nec
-------------------
-- the SrcLoc returned are for the whole declarations, not just the names
-hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])
+hsDataDefnBinders :: HsDataDefn (GhcPass p)
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
hsDataDefnBinders (HsDataDefn { dd_cons = cons })
= hsConDeclsBinders cons
-- See Note [Binders in family instances]
-hsDataDefnBinders (XHsDataDefn _) = panic "hsDataDefnBinders"
+hsDataDefnBinders (XHsDataDefn nec) = noExtCon nec
-------------------
-type Seen pass = [LFieldOcc pass] -> [LFieldOcc pass]
+type Seen p = [LFieldOcc (GhcPass p)] -> [LFieldOcc (GhcPass p)]
-- Filters out ones that have already been seen
-hsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])
+hsConDeclsBinders :: [LConDecl (GhcPass p)]
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
-- See hsLTyClDeclBinders for what this does
-- The function is boringly complicated because of the records
-- And since we only have equality, we have to be a little careful
hsConDeclsBinders cons
= go id cons
where
- go :: Seen pass -> [LConDecl pass]
- -> ([Located (IdP pass)], [LFieldOcc pass])
+ go :: Seen p -> [LConDecl (GhcPass p)]
+ -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])
go _ [] = ([], [])
go remSeen (r:rs)
-- Don't re-mangle the location of field names, because we don't
@@ -1286,10 +1288,10 @@ hsConDeclsBinders cons
(remSeen', flds) = get_flds remSeen args
(ns, fs) = go remSeen' rs
- XConDecl _ -> panic "hsConDeclsBinders"
+ XConDecl nec -> noExtCon nec
- get_flds :: Seen pass -> HsConDeclDetails pass
- -> (Seen pass, [LFieldOcc pass])
+ get_flds :: Seen p -> HsConDeclDetails (GhcPass p)
+ -> (Seen p, [LFieldOcc (GhcPass p)])
get_flds remSeen (RecCon flds)
= (remSeen', fld_names)
where
@@ -1355,7 +1357,7 @@ lStmtsImplicits = hs_lstmts
hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args
where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat
do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts
- do_arg (_, XApplicativeArg _) = panic "lStmtsImplicits"
+ do_arg (_, XApplicativeArg nec) = noExtCon nec
hs_stmt (LetStmt _ binds) = hs_local_binds (unLoc binds)
hs_stmt (BodyStmt {}) = []
hs_stmt (LastStmt {}) = []
@@ -1363,7 +1365,7 @@ lStmtsImplicits = hs_lstmts
, s <- ss]
hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss
- hs_stmt (XStmtLR {}) = panic "lStmtsImplicits"
+ hs_stmt (XStmtLR nec) = noExtCon nec
hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds
hs_local_binds (HsIPBinds {}) = []
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index d5b3f907373b4c382eddc74ac0dcad02bddc6892..c7557922bc21a7ae90a78dac816605a13668b3e2 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -127,7 +127,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls
preludeImportDecl :: LImportDecl GhcPs
preludeImportDecl
- = cL loc $ ImportDecl { ideclExt = noExt,
+ = cL loc $ ImportDecl { ideclExt = noExtField,
ideclSourceSrc = NoSourceText,
ideclName = cL loc pRELUDE_NAME,
ideclPkgQual = Nothing,
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index aa29554e9d64c23036c2768a2ed3f7f23c32f4fd..aaf9a3c28582e66cb2b430b43aa21b945d46c6ae 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -965,11 +965,13 @@ hscCheckSafeImports tcg_env = do
-> return tcg_env'
warns dflags rules = listToBag $ map (warnRules dflags) rules
+
+ warnRules :: DynFlags -> GenLocated SrcSpan (RuleDecl GhcTc) -> ErrMsg
warnRules dflags (L loc (HsRule { rd_name = n })) =
mkPlainWarnMsg dflags loc $
text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$
text "User defined rules are disabled under Safe Haskell"
- warnRules _ (L _ (XRuleDecl _)) = panic "hscCheckSafeImports"
+ warnRules _ (L _ (XRuleDecl nec)) = noExtCon nec
-- | Validate that safe imported modules are actually safe. For modules in the
-- HomePackage (the package the module we are compiling in resides) this just
diff --git a/compiler/main/HscStats.hs b/compiler/main/HscStats.hs
index fdd5ee78e22162e982598a034bf2d166da838c32..df77ae41a46dd1d6621c799801d19300e88b1e51 100644
--- a/compiler/main/HscStats.hs
+++ b/compiler/main/HscStats.hs
@@ -122,7 +122,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
import_info (dL->L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
, ideclAs = as, ideclHiding = spec }))
= add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec)
- import_info (dL->L _ (XImportDecl _)) = panic "import_info"
+ import_info (dL->L _ (XImportDecl nec)) = noExtCon nec
import_info _ = panic " import_info: Impossible Match"
-- due to #15884
@@ -163,8 +163,8 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
ss, is, length ats, length adts)
where
methods = map unLoc $ bagToList inst_meths
- inst_info (ClsInstD _ (XClsInstDecl _)) = panic "inst_info"
- inst_info (XInstDecl _) = panic "inst_info"
+ inst_info (ClsInstD _ (XClsInstDecl nec)) = noExtCon nec
+ inst_info (XInstDecl nec) = noExtCon nec
-- TODO: use Sum monoid
addpr :: (Int,Int,Int) -> Int
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 091efb37fd7d237e4420b8bfca50fbd5ad7ca80a..b2c644e65c0632931a147a214f704472d3d10b20 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -1138,8 +1138,8 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
-- create a new binding.
let expr_fs = fsLit "_compileParsedExpr"
expr_name = mkInternalName (getUnique expr_fs) (mkTyVarOccFS expr_fs) loc
- let_stmt = L loc . LetStmt noExt . L loc . (HsValBinds noExt) $
- ValBinds noExt
+ let_stmt = L loc . LetStmt noExtField . L loc . (HsValBinds noExtField) $
+ ValBinds noExtField
(unitBag $ mkHsVarBind loc (getRdrName expr_name) expr) []
pstmt <- liftIO $ hscParsedStmt hsc_env let_stmt
@@ -1167,7 +1167,7 @@ dynCompileExpr expr = do
parsed_expr <- parseExpr expr
-- > Data.Dynamic.toDyn expr
let loc = getLoc parsed_expr
- to_dyn_expr = mkHsApp (L loc . HsVar noExt . L loc $ getRdrName toDynName)
+ to_dyn_expr = mkHsApp (L loc . HsVar noExtField . L loc $ getRdrName toDynName)
parsed_expr
hval <- compileParsedExpr to_dyn_expr
return (unsafeCoerce# hval :: Dynamic)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 087474f9af961ee628f9ff633f22a09057fe930e..774b32f0aba81c4de7f8d4697db7d96967b43329 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -869,9 +869,9 @@ expdoclist :: { OrdList (LIE GhcPs) }
| {- empty -} { nilOL }
exp_doc :: { OrdList (LIE GhcPs) }
- : docsection { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup noExt n doc)) }
- | docnamed { unitOL (sL1 $1 (IEDocNamed noExt ((fst . unLoc) $1))) }
- | docnext { unitOL (sL1 $1 (IEDoc noExt (unLoc $1))) }
+ : docsection { unitOL (sL1 $1 (case (unLoc $1) of (n, doc) -> IEGroup noExtField n doc)) }
+ | docnamed { unitOL (sL1 $1 (IEDocNamed noExtField ((fst . unLoc) $1))) }
+ | docnext { unitOL (sL1 $1 (IEDoc noExtField (unLoc $1))) }
-- No longer allow things like [] and (,,,) to be exported
@@ -879,9 +879,9 @@ exp_doc :: { OrdList (LIE GhcPs) }
export :: { OrdList (LIE GhcPs) }
: qcname_ext export_subspec {% mkModuleImpExp $1 (snd $ unLoc $2)
>>= \ie -> amsu (sLL $1 $> ie) (fst $ unLoc $2) }
- | 'module' modid {% amsu (sLL $1 $> (IEModuleContents noExt $2))
+ | 'module' modid {% amsu (sLL $1 $> (IEModuleContents noExtField $2))
[mj AnnModule $1] }
- | 'pattern' qcon {% amsu (sLL $1 $> (IEVar noExt (sLL $1 $> (IEPattern $2))))
+ | 'pattern' qcon {% amsu (sLL $1 $> (IEVar noExtField (sLL $1 $> (IEPattern $2))))
[mj AnnPattern $1] }
export_subspec :: { Located ([AddAnn],ImpExpSubSpec) }
@@ -960,7 +960,7 @@ importdecl :: { LImportDecl GhcPs }
{% do {
; checkImportDecl $4 $7
; ams (cL (comb4 $1 $6 (snd $8) $9) $
- ImportDecl { ideclExt = noExt
+ ImportDecl { ideclExt = noExtField
, ideclSourceSrc = snd $ fst $2
, ideclName = $6, ideclPkgQual = snd $5
, ideclSource = snd $2, ideclSafe = snd $3
@@ -1047,21 +1047,21 @@ topdecls_semi :: { OrdList (LHsDecl GhcPs) }
| {- empty -} { nilOL }
topdecl :: { LHsDecl GhcPs }
- : cl_decl { sL1 $1 (TyClD noExt (unLoc $1)) }
- | ty_decl { sL1 $1 (TyClD noExt (unLoc $1)) }
- | inst_decl { sL1 $1 (InstD noExt (unLoc $1)) }
- | stand_alone_deriving { sLL $1 $> (DerivD noExt (unLoc $1)) }
- | role_annot { sL1 $1 (RoleAnnotD noExt (unLoc $1)) }
- | 'default' '(' comma_types0 ')' {% ams (sLL $1 $> (DefD noExt (DefaultDecl noExt $3)))
+ : cl_decl { sL1 $1 (TyClD noExtField (unLoc $1)) }
+ | ty_decl { sL1 $1 (TyClD noExtField (unLoc $1)) }
+ | inst_decl { sL1 $1 (InstD noExtField (unLoc $1)) }
+ | stand_alone_deriving { sLL $1 $> (DerivD noExtField (unLoc $1)) }
+ | role_annot { sL1 $1 (RoleAnnotD noExtField (unLoc $1)) }
+ | 'default' '(' comma_types0 ')' {% ams (sLL $1 $> (DefD noExtField (DefaultDecl noExtField $3)))
[mj AnnDefault $1
,mop $2,mcp $4] }
| 'foreign' fdecl {% ams (sLL $1 $> (snd $ unLoc $2))
(mj AnnForeign $1:(fst $ unLoc $2)) }
- | '{-# DEPRECATED' deprecations '#-}' {% ams (sLL $1 $> $ WarningD noExt (Warnings noExt (getDEPRECATED_PRAGs $1) (fromOL $2)))
+ | '{-# DEPRECATED' deprecations '#-}' {% ams (sLL $1 $> $ WarningD noExtField (Warnings noExtField (getDEPRECATED_PRAGs $1) (fromOL $2)))
[mo $1,mc $3] }
- | '{-# WARNING' warnings '#-}' {% ams (sLL $1 $> $ WarningD noExt (Warnings noExt (getWARNING_PRAGs $1) (fromOL $2)))
+ | '{-# WARNING' warnings '#-}' {% ams (sLL $1 $> $ WarningD noExtField (Warnings noExtField (getWARNING_PRAGs $1) (fromOL $2)))
[mo $1,mc $3] }
- | '{-# RULES' rules '#-}' {% ams (sLL $1 $> $ RuleD noExt (HsRules noExt (getRULES_PRAGs $1) (fromOL $2)))
+ | '{-# RULES' rules '#-}' {% ams (sLL $1 $> $ RuleD noExtField (HsRules noExtField (getRULES_PRAGs $1) (fromOL $2)))
[mo $1,mc $3] }
| annotation { $1 }
| decl_no_th { $1 }
@@ -1134,13 +1134,13 @@ ty_decl :: { LTyClDecl GhcPs }
inst_decl :: { LInstDecl GhcPs }
: 'instance' overlap_pragma inst_type where_inst
{% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4)
- ; let cid = ClsInstDecl { cid_ext = noExt
+ ; let cid = ClsInstDecl { cid_ext = noExtField
, cid_poly_ty = $3, cid_binds = binds
, cid_sigs = mkClassOpSigs sigs
, cid_tyfam_insts = ats
, cid_overlap_mode = $2
, cid_datafam_insts = adts }
- ; ams (cL (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExt, cid_inst = cid }))
+ ; ams (cL (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid }))
(mj AnnInstance $1 : (fst $ unLoc $4)) } }
-- type instance declarations
@@ -1362,22 +1362,22 @@ opt_kind_sig :: { Located ([AddAnn], Maybe (LHsKind GhcPs)) }
| '::' kind { sLL $1 $> ([mu AnnDcolon $1], Just $2) }
opt_datafam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
- : { noLoc ([] , noLoc (NoSig noExt) )}
- | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExt $2))}
+ : { noLoc ([] , noLoc (NoSig noExtField) )}
+ | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExtField $2))}
opt_tyfam_kind_sig :: { Located ([AddAnn], LFamilyResultSig GhcPs) }
- : { noLoc ([] , noLoc (NoSig noExt) )}
- | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExt $2))}
- | '=' tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig noExt $2))}
+ : { noLoc ([] , noLoc (NoSig noExtField) )}
+ | '::' kind { sLL $1 $> ([mu AnnDcolon $1], sLL $1 $> (KindSig noExtField $2))}
+ | '=' tv_bndr { sLL $1 $> ([mj AnnEqual $1] , sLL $1 $> (TyVarSig noExtField $2))}
opt_at_kind_inj_sig :: { Located ([AddAnn], ( LFamilyResultSig GhcPs
, Maybe (LInjectivityAnn GhcPs)))}
- : { noLoc ([], (noLoc (NoSig noExt), Nothing)) }
+ : { noLoc ([], (noLoc (NoSig noExtField), Nothing)) }
| '::' kind { sLL $1 $> ( [mu AnnDcolon $1]
- , (sLL $2 $> (KindSig noExt $2), Nothing)) }
+ , (sLL $2 $> (KindSig noExtField $2), Nothing)) }
| '=' tv_bndr '|' injectivity_cond
{ sLL $1 $> ([mj AnnEqual $1, mj AnnVbar $3]
- , (sLL $1 $2 (TyVarSig noExt $2), Just $4))}
+ , (sLL $1 $2 (TyVarSig noExtField $2), Just $4))}
-- tycl_hdr parses the header of a class or data type decl,
-- which takes the form
@@ -1430,7 +1430,7 @@ stand_alone_deriving :: { LDerivDecl GhcPs }
{% do { let { err = text "in the stand-alone deriving instance"
<> colon <+> quotes (ppr $5) }
; ams (sLL $1 (hsSigType $>)
- (DerivDecl noExt (mkHsWildCardBndrs $5) $2 $4))
+ (DerivDecl noExtField (mkHsWildCardBndrs $5) $2 $4))
[mj AnnDeriving $1, mj AnnInstance $3] } }
-----------------------------------------------------------------------------
@@ -1461,20 +1461,20 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 }
pattern_synonym_decl :: { LHsDecl GhcPs }
: 'pattern' pattern_synonym_lhs '=' pat
{% let (name, args,as ) = $2 in
- ams (sLL $1 $> . ValD noExt $ mkPatSynBind name args $4
+ ams (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4
ImplicitBidirectional)
(as ++ [mj AnnPattern $1, mj AnnEqual $3])
}
| 'pattern' pattern_synonym_lhs '<-' pat
{% let (name, args, as) = $2 in
- ams (sLL $1 $> . ValD noExt $ mkPatSynBind name args $4 Unidirectional)
+ ams (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional)
(as ++ [mj AnnPattern $1,mu AnnLarrow $3]) }
| 'pattern' pattern_synonym_lhs '<-' pat where_decls
{% do { let (name, args, as) = $2
; mg <- mkPatSynMatchGroup name (snd $ unLoc $5)
- ; ams (sLL $1 $> . ValD noExt $
+ ; ams (sLL $1 $> . ValD noExtField $
mkPatSynBind name args $4 (ExplicitBidirectional mg))
(as ++ ((mj AnnPattern $1:mu AnnLarrow $3:(fst $ unLoc $5))) )
}}
@@ -1502,7 +1502,7 @@ where_decls :: { Located ([AddAnn]
pattern_synonym_sig :: { LSig GhcPs }
: 'pattern' con_list '::' sigtypedoc
- {% ams (sLL $1 $> $ PatSynSig noExt (unLoc $2) (mkLHsSigType $4))
+ {% ams (sLL $1 $> $ PatSynSig noExtField (unLoc $2) (mkLHsSigType $4))
[mj AnnPattern $1, mu AnnDcolon $3] }
-----------------------------------------------------------------------------
@@ -1520,7 +1520,7 @@ decl_cls : at_decl_cls { $1 }
do { v <- checkValSigLhs $2
; let err = text "in default signature" <> colon <+>
quotes (ppr $2)
- ; ams (sLL $1 $> $ SigD noExt $ ClassOpSig noExt True [v] $ mkLHsSigType $4)
+ ; ams (sLL $1 $> $ SigD noExtField $ ClassOpSig noExtField True [v] $ mkLHsSigType $4)
[mj AnnDefault $1,mu AnnDcolon $3] } }
decls_cls :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
@@ -1558,7 +1558,7 @@ where_cls :: { Located ([AddAnn]
-- Declarations in instance bodies
--
decl_inst :: { Located (OrdList (LHsDecl GhcPs)) }
-decl_inst : at_decl_inst { sLL $1 $> (unitOL (sL1 $1 (InstD noExt (unLoc $1)))) }
+decl_inst : at_decl_inst { sLL $1 $> (unitOL (sL1 $1 (InstD noExtField (unLoc $1)))) }
| decl { sLL $1 $> (unitOL $1) }
decls_inst :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
@@ -1626,13 +1626,13 @@ binds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
-- No type declarations
: decllist {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1)
; return (sL1 $1 (fst $ unLoc $1
- ,sL1 $1 $ HsValBinds noExt val_binds)) } }
+ ,sL1 $1 $ HsValBinds noExtField val_binds)) } }
| '{' dbinds '}' { sLL $1 $> ([moc $1,mcc $3]
- ,sL1 $2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc $2))) }
+ ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) }
| vocurly dbinds close { cL (getLoc $2) ([]
- ,sL1 $2 $ HsIPBinds noExt (IPBinds noExt (reverse $ unLoc $2))) }
+ ,sL1 $2 $ HsIPBinds noExtField (IPBinds noExtField (reverse $ unLoc $2))) }
wherebinds :: { Located ([AddAnn],Located (HsLocalBinds GhcPs)) }
@@ -1658,7 +1658,7 @@ rule :: { LRuleDecl GhcPs }
: STRING rule_activation rule_foralls infixexp '=' exp
{%runECP_P $4 >>= \ $4 ->
runECP_P $6 >>= \ $6 ->
- ams (sLL $1 $> $ HsRule { rd_ext = noExt
+ ams (sLL $1 $> $ HsRule { rd_ext = noExtField
, rd_name = cL (gl $1) (getSTRINGs $1, getSTRING $1)
, rd_act = (snd $2) `orElse` AlwaysActive
, rd_tyvs = sndOf3 $3, rd_tmvs = thdOf3 $3
@@ -1735,7 +1735,7 @@ warnings :: { OrdList (LWarnDecl GhcPs) }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
warning :: { OrdList (LWarnDecl GhcPs) }
: namelist strings
- {% amsu (sLL $1 $> (Warning noExt (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
+ {% amsu (sLL $1 $> (Warning noExtField (unLoc $1) (WarningTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
(fst $ unLoc $2) }
deprecations :: { OrdList (LWarnDecl GhcPs) }
@@ -1750,7 +1750,7 @@ deprecations :: { OrdList (LWarnDecl GhcPs) }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
deprecation :: { OrdList (LWarnDecl GhcPs) }
: namelist strings
- {% amsu (sLL $1 $> $ (Warning noExt (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
+ {% amsu (sLL $1 $> $ (Warning noExtField (unLoc $1) (DeprecatedTxt (noLoc NoSourceText) $ snd $ unLoc $2)))
(fst $ unLoc $2) }
strings :: { Located ([AddAnn],[Located StringLiteral]) }
@@ -1768,19 +1768,19 @@ stringlist :: { Located (OrdList (Located StringLiteral)) }
-- Annotations
annotation :: { LHsDecl GhcPs }
: '{-# ANN' name_var aexp '#-}' {% runECP_P $3 >>= \ $3 ->
- ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
+ ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField
(getANN_PRAGs $1)
(ValueAnnProvenance $2) $3))
[mo $1,mc $4] }
| '{-# ANN' 'type' tycon aexp '#-}' {% runECP_P $4 >>= \ $4 ->
- ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
+ ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField
(getANN_PRAGs $1)
(TypeAnnProvenance $3) $4))
[mo $1,mj AnnType $2,mc $5] }
| '{-# ANN' 'module' aexp '#-}' {% runECP_P $3 >>= \ $3 ->
- ams (sLL $1 $> (AnnD noExt $ HsAnnotation noExt
+ ams (sLL $1 $> (AnnD noExtField $ HsAnnotation noExtField
(getANN_PRAGs $1)
ModuleAnnProvenance $3))
[mo $1,mj AnnModule $2,mc $4] }
@@ -1866,12 +1866,12 @@ forall_vis_flag :: { (AddAnn, ForallVisFlag) }
-- A ktype/ktypedoc is a ctype/ctypedoc, possibly with a kind annotation
ktype :: { LHsType GhcPs }
: ctype { $1 }
- | ctype '::' kind {% ams (sLL $1 $> $ HsKindSig noExt $1 $3)
+ | ctype '::' kind {% ams (sLL $1 $> $ HsKindSig noExtField $1 $3)
[mu AnnDcolon $2] }
ktypedoc :: { LHsType GhcPs }
: ctypedoc { $1 }
- | ctypedoc '::' kind {% ams (sLL $1 $> $ HsKindSig noExt $1 $3)
+ | ctypedoc '::' kind {% ams (sLL $1 $> $ HsKindSig noExtField $1 $3)
[mu AnnDcolon $2] }
-- A ctype is a for-all type
@@ -1882,15 +1882,15 @@ ctype :: { LHsType GhcPs }
ams (sLL $1 $> $
HsForAllTy { hst_fvf = fv_flag
, hst_bndrs = $2
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = $4 })
[mu AnnForall $1,fv_ann] }
| context '=>' ctype {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> return (sLL $1 $> $
HsQualTy { hst_ctxt = $1
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = $3 }) }
- | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
+ | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3))
[mu AnnDcolon $2] }
| type { $1 }
@@ -1912,15 +1912,15 @@ ctypedoc :: { LHsType GhcPs }
ams (sLL $1 $> $
HsForAllTy { hst_fvf = fv_flag
, hst_bndrs = $2
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = $4 })
[mu AnnForall $1,fv_ann] }
| context '=>' ctypedoc {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> return (sLL $1 $> $
HsQualTy { hst_ctxt = $1
- , hst_xqual = noExt
+ , hst_xqual = noExtField
, hst_body = $3 }) }
- | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
+ | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3))
[mu AnnDcolon $2] }
| typedoc { $1 }
@@ -1968,27 +1968,27 @@ is connected to the first type too.
type :: { LHsType GhcPs }
: btype { $1 }
| btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
- >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
+ >> ams (sLL $1 $> $ HsFunTy noExtField $1 $3)
[mu AnnRarrow $2] }
typedoc :: { LHsType GhcPs }
: btype { $1 }
- | btype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 }
- | docnext btype { sLL $1 $> $ HsDocTy noExt $2 $1 }
+ | btype docprev { sLL $1 $> $ HsDocTy noExtField $1 $2 }
+ | docnext btype { sLL $1 $> $ HsDocTy noExtField $2 $1 }
| btype '->' ctypedoc {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
- >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
+ >> ams (sLL $1 $> $ HsFunTy noExtField $1 $3)
[mu AnnRarrow $2] }
| btype docprev '->' ctypedoc {% ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
>> ams (sLL $1 $> $
- HsFunTy noExt (cL (comb2 $1 $2)
- (HsDocTy noExt $1 $2))
+ HsFunTy noExtField (cL (comb2 $1 $2)
+ (HsDocTy noExtField $1 $2))
$4)
[mu AnnRarrow $3] }
| docnext btype '->' ctypedoc {% ams $2 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
>> ams (sLL $1 $> $
- HsFunTy noExt (cL (comb2 $1 $2)
- (HsDocTy noExt $2 $1))
+ HsFunTy noExtField (cL (comb2 $1 $2)
+ (HsDocTy noExtField $2 $1))
$4)
[mu AnnRarrow $3] }
@@ -2027,42 +2027,42 @@ tyapp :: { Located TyEl }
| unpackedness { sL1 $1 $ TyElUnpackedness (unLoc $1) }
atype :: { LHsType GhcPs }
- : ntgtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- Not including unit tuples
- | tyvar { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- (See Note [Unit tuples])
+ : ntgtycon { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- Not including unit tuples
+ | tyvar { sL1 $1 (HsTyVar noExtField NotPromoted $1) } -- (See Note [Unit tuples])
| '*' {% do { warnStarIsType (getLoc $1)
- ; return $ sL1 $1 (HsStarTy noExt (isUnicode $1)) } }
+ ; return $ sL1 $1 (HsStarTy noExtField (isUnicode $1)) } }
| '{' fielddecls '}' {% amms (checkRecordSyntax
- (sLL $1 $> $ HsRecTy noExt $2))
+ (sLL $1 $> $ HsRecTy noExtField $2))
-- Constructor sigs only
[moc $1,mcc $3] }
- | '(' ')' {% ams (sLL $1 $> $ HsTupleTy noExt
+ | '(' ')' {% ams (sLL $1 $> $ HsTupleTy noExtField
HsBoxedOrConstraintTuple [])
[mop $1,mcp $2] }
| '(' ktype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
(gl $3) >>
- ams (sLL $1 $> $ HsTupleTy noExt
+ ams (sLL $1 $> $ HsTupleTy noExtField
HsBoxedOrConstraintTuple ($2 : $4))
[mop $1,mcp $5] }
- | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple [])
+ | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy noExtField HsUnboxedTuple [])
[mo $1,mc $2] }
- | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple $2)
+ | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy noExtField HsUnboxedTuple $2)
[mo $1,mc $3] }
- | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy noExt $2)
+ | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy noExtField $2)
[mo $1,mc $3] }
- | '[' ktype ']' {% ams (sLL $1 $> $ HsListTy noExt $2) [mos $1,mcs $3] }
- | '(' ktype ')' {% ams (sLL $1 $> $ HsParTy noExt $2) [mop $1,mcp $3] }
- | quasiquote { mapLoc (HsSpliceTy noExt) $1 }
- | splice_untyped { mapLoc (HsSpliceTy noExt) $1 }
+ | '[' ktype ']' {% ams (sLL $1 $> $ HsListTy noExtField $2) [mos $1,mcs $3] }
+ | '(' ktype ')' {% ams (sLL $1 $> $ HsParTy noExtField $2) [mop $1,mcp $3] }
+ | quasiquote { mapLoc (HsSpliceTy noExtField) $1 }
+ | splice_untyped { mapLoc (HsSpliceTy noExtField) $1 }
-- see Note [Promotion] for the followings
- | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
+ | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExtField IsPromoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
| SIMPLEQUOTE '(' ktype ',' comma_types1 ')'
{% addAnnotation (gl $3) AnnComma (gl $4) >>
- ams (sLL $1 $> $ HsExplicitTupleTy noExt ($3 : $5))
+ ams (sLL $1 $> $ HsExplicitTupleTy noExtField ($3 : $5))
[mj AnnSimpleQuote $1,mop $2,mcp $6] }
- | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExt IsPromoted $3)
+ | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExtField IsPromoted $3)
[mj AnnSimpleQuote $1,mos $2,mcs $4] }
- | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExt IsPromoted $2)
+ | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExtField IsPromoted $2)
[mj AnnSimpleQuote $1,mj AnnName $2] }
-- Two or more [ty, ty, ty] must be a promoted list type, just as
@@ -2071,11 +2071,11 @@ atype :: { LHsType GhcPs }
-- so you have to quote those.)
| '[' ktype ',' comma_types1 ']' {% addAnnotation (gl $2) AnnComma
(gl $3) >>
- ams (sLL $1 $> $ HsExplicitListTy noExt NotPromoted ($2 : $4))
+ ams (sLL $1 $> $ HsExplicitListTy noExtField NotPromoted ($2 : $4))
[mos $1,mcs $5] }
- | INTEGER { sLL $1 $> $ HsTyLit noExt $ HsNumTy (getINTEGERs $1)
+ | INTEGER { sLL $1 $> $ HsTyLit noExtField $ HsNumTy (getINTEGERs $1)
(il_value (getINTEGER $1)) }
- | STRING { sLL $1 $> $ HsTyLit noExt $ HsStrTy (getSTRINGs $1)
+ | STRING { sLL $1 $> $ HsTyLit noExtField $ HsStrTy (getSTRINGs $1)
(getSTRING $1) }
| '_' { sL1 $1 $ mkAnonWildCardTy }
@@ -2111,8 +2111,8 @@ tv_bndrs :: { [LHsTyVarBndr GhcPs] }
| {- empty -} { [] }
tv_bndr :: { LHsTyVarBndr GhcPs }
- : tyvar { sL1 $1 (UserTyVar noExt $1) }
- | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar noExt $2 $4))
+ : tyvar { sL1 $1 (UserTyVar noExtField $1) }
+ | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar noExtField $2 $4))
[mop $1,mu AnnDcolon $3
,mcp $5] }
@@ -2323,7 +2323,7 @@ fielddecl :: { LConDeclField GhcPs }
-- A list because of f,g :: Int
: maybe_docnext sig_vars '::' ctype maybe_docprev
{% ams (cL (comb2 $2 $4)
- (ConDeclField noExt (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExt ln) (unLoc $2))) $4 ($1 `mplus` $5)))
+ (ConDeclField noExtField (reverse (map (\ln@(dL->L l n) -> cL l $ FieldOcc noExtField ln) (unLoc $2))) $4 ($1 `mplus` $5)))
[mu AnnDcolon $3] }
-- Reversed!
@@ -2341,17 +2341,17 @@ derivings :: { HsDeriving GhcPs }
deriving :: { LHsDerivingClause GhcPs }
: 'deriving' deriv_clause_types
{% let { full_loc = comb2 $1 $> }
- in ams (cL full_loc $ HsDerivingClause noExt Nothing $2)
+ in ams (cL full_loc $ HsDerivingClause noExtField Nothing $2)
[mj AnnDeriving $1] }
| 'deriving' deriv_strategy_no_via deriv_clause_types
{% let { full_loc = comb2 $1 $> }
- in ams (cL full_loc $ HsDerivingClause noExt (Just $2) $3)
+ in ams (cL full_loc $ HsDerivingClause noExtField (Just $2) $3)
[mj AnnDeriving $1] }
| 'deriving' deriv_clause_types deriv_strategy_via
{% let { full_loc = comb2 $1 $> }
- in ams (cL full_loc $ HsDerivingClause noExt (Just $3) $2)
+ in ams (cL full_loc $ HsDerivingClause noExtField (Just $3) $2)
[mj AnnDeriving $1] }
deriv_clause_types :: { Located [LHsSigType GhcPs] }
@@ -2389,7 +2389,7 @@ There's an awkward overlap with a type signature. Consider
-}
docdecl :: { LHsDecl GhcPs }
- : docdecld { sL1 $1 (DocD noExt (unLoc $1)) }
+ : docdecld { sL1 $1 (DocD noExtField (unLoc $1)) }
docdecld :: { LDocDecl }
: docnext { sL1 $1 (DocCommentNext (unLoc $1)) }
@@ -2415,7 +2415,7 @@ decl_no_th :: { LHsDecl GhcPs }
amsL l [] >> return () } ;
_ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ;
- return $! (sL l $ ValD noExt r) } }
+ return $! (sL l $ ValD noExtField r) } }
| infixexp_top opt_sig rhs {% runECP_P $1 >>= \ $1 ->
do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3;
@@ -2429,7 +2429,7 @@ decl_no_th :: { LHsDecl GhcPs }
(PatBind _ (dL->L lh _lhs) _rhs _) ->
amsL lh (fst $2) >> return () } ;
_ <- amsL l (ann ++ (fst $ unLoc $3));
- return $! (sL l $ ValD noExt r) } }
+ return $! (sL l $ ValD noExtField r) } }
| pattern_synonym_decl { $1 }
| docdecl { $1 }
@@ -2445,10 +2445,10 @@ rhs :: { Located ([AddAnn],GRHSs GhcPs (LHsExpr GhcPs)) }
: '=' exp wherebinds {% runECP_P $2 >>= \ $2 -> return $
sL (comb3 $1 $2 $3)
((mj AnnEqual $1 : (fst $ unLoc $3))
- ,GRHSs noExt (unguardedRHS (comb3 $1 $2 $3) $2)
+ ,GRHSs noExtField (unguardedRHS (comb3 $1 $2 $3) $2)
(snd $ unLoc $3)) }
| gdrhs wherebinds { sLL $1 $> (fst $ unLoc $2
- ,GRHSs noExt (reverse (unLoc $1))
+ ,GRHSs noExtField (reverse (unLoc $1))
(snd $ unLoc $2)) }
gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
@@ -2457,7 +2457,7 @@ gdrhs :: { Located [LGRHS GhcPs (LHsExpr GhcPs)] }
gdrh :: { LGRHS GhcPs (LHsExpr GhcPs) }
: '|' guardquals '=' exp {% runECP_P $4 >>= \ $4 ->
- ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
+ ams (sL (comb2 $1 $>) $ GRHS noExtField (unLoc $2) $4)
[mj AnnVbar $1,mj AnnEqual $3] }
sigdecl :: { LHsDecl GhcPs }
@@ -2467,70 +2467,70 @@ sigdecl :: { LHsDecl GhcPs }
{% do { $1 <- runECP_P $1
; v <- checkValSigLhs $1
; _ <- amsL (comb2 $1 $>) [mu AnnDcolon $2]
- ; return (sLL $1 $> $ SigD noExt $
- TypeSig noExt [v] (mkLHsSigWcType $3))} }
+ ; return (sLL $1 $> $ SigD noExtField $
+ TypeSig noExtField [v] (mkLHsSigWcType $3))} }
| var ',' sig_vars '::' sigtypedoc
- {% do { let sig = TypeSig noExt ($1 : reverse (unLoc $3))
+ {% do { let sig = TypeSig noExtField ($1 : reverse (unLoc $3))
(mkLHsSigWcType $5)
; addAnnotation (gl $1) AnnComma (gl $2)
- ; ams ( sLL $1 $> $ SigD noExt sig )
+ ; ams ( sLL $1 $> $ SigD noExtField sig )
[mu AnnDcolon $4] } }
| infix prec ops
{% checkPrecP $2 $3 >>
- ams (sLL $1 $> $ SigD noExt
- (FixSig noExt (FixitySig noExt (fromOL $ unLoc $3)
+ ams (sLL $1 $> $ SigD noExtField
+ (FixSig noExtField (FixitySig noExtField (fromOL $ unLoc $3)
(Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1)))))
[mj AnnInfix $1,mj AnnVal $2] }
- | pattern_synonym_sig { sLL $1 $> . SigD noExt . unLoc $ $1 }
+ | pattern_synonym_sig { sLL $1 $> . SigD noExtField . unLoc $ $1 }
| '{-# COMPLETE' con_list opt_tyconsig '#-}'
{% let (dcolon, tc) = $3
in ams
(sLL $1 $>
- (SigD noExt (CompleteMatchSig noExt (getCOMPLETE_PRAGs $1) $2 tc)))
+ (SigD noExtField (CompleteMatchSig noExtField (getCOMPLETE_PRAGs $1) $2 tc)))
([ mo $1 ] ++ dcolon ++ [mc $4]) }
-- This rule is for both INLINE and INLINABLE pragmas
| '{-# INLINE' activation qvar '#-}'
- {% ams ((sLL $1 $> $ SigD noExt (InlineSig noExt $3
+ {% ams ((sLL $1 $> $ SigD noExtField (InlineSig noExtField $3
(mkInlinePragma (getINLINE_PRAGs $1) (getINLINE $1)
(snd $2)))))
((mo $1:fst $2) ++ [mc $4]) }
| '{-# SCC' qvar '#-}'
- {% ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 Nothing)))
+ {% ams (sLL $1 $> (SigD noExtField (SCCFunSig noExtField (getSCC_PRAGs $1) $2 Nothing)))
[mo $1, mc $3] }
| '{-# SCC' qvar STRING '#-}'
{% do { scc <- getSCC $3
; let str_lit = StringLiteral (getSTRINGs $3) scc
- ; ams (sLL $1 $> (SigD noExt (SCCFunSig noExt (getSCC_PRAGs $1) $2 (Just ( sL1 $3 str_lit)))))
+ ; ams (sLL $1 $> (SigD noExtField (SCCFunSig noExtField (getSCC_PRAGs $1) $2 (Just ( sL1 $3 str_lit)))))
[mo $1, mc $4] } }
| '{-# SPECIALISE' activation qvar '::' sigtypes1 '#-}'
{% ams (
let inl_prag = mkInlinePragma (getSPEC_PRAGs $1)
(NoUserInline, FunLike) (snd $2)
- in sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5) inl_prag))
+ in sLL $1 $> $ SigD noExtField (SpecSig noExtField $3 (fromOL $5) inl_prag))
(mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
- {% ams (sLL $1 $> $ SigD noExt (SpecSig noExt $3 (fromOL $5)
+ {% ams (sLL $1 $> $ SigD noExtField (SpecSig noExtField $3 (fromOL $5)
(mkInlinePragma (getSPEC_INLINE_PRAGs $1)
(getSPEC_INLINE $1) (snd $2))))
(mo $1:mu AnnDcolon $4:mc $6:(fst $2)) }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
{% ams (sLL $1 $>
- $ SigD noExt (SpecInstSig noExt (getSPEC_PRAGs $1) $3))
+ $ SigD noExtField (SpecInstSig noExtField (getSPEC_PRAGs $1) $3))
[mo $1,mj AnnInstance $2,mc $4] }
-- A minimal complete definition
| '{-# MINIMAL' name_boolformula_opt '#-}'
- {% ams (sLL $1 $> $ SigD noExt (MinimalSig noExt (getMINIMAL_PRAGs $1) $2))
+ {% ams (sLL $1 $> $ SigD noExtField (MinimalSig noExtField (getMINIMAL_PRAGs $1) $2))
[mo $1,mc $3] }
activation :: { ([AddAnn],Maybe Activation) }
@@ -2565,25 +2565,25 @@ exp :: { ECP }
| infixexp '-<' exp {% runECP_P $1 >>= \ $1 ->
runECP_P $3 >>= \ $3 ->
fmap ecpFromCmd $
- ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
+ ams (sLL $1 $> $ HsCmdArrApp noExtField $1 $3
HsFirstOrderApp True)
[mu Annlarrowtail $2] }
| infixexp '>-' exp {% runECP_P $1 >>= \ $1 ->
runECP_P $3 >>= \ $3 ->
fmap ecpFromCmd $
- ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
+ ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1
HsFirstOrderApp False)
[mu Annrarrowtail $2] }
| infixexp '-<<' exp {% runECP_P $1 >>= \ $1 ->
runECP_P $3 >>= \ $3 ->
fmap ecpFromCmd $
- ams (sLL $1 $> $ HsCmdArrApp noExt $1 $3
+ ams (sLL $1 $> $ HsCmdArrApp noExtField $1 $3
HsHigherOrderApp True)
[mu AnnLarrowtail $2] }
| infixexp '>>-' exp {% runECP_P $1 >>= \ $1 ->
runECP_P $3 >>= \ $3 ->
fmap ecpFromCmd $
- ams (sLL $1 $> $ HsCmdArrApp noExt $3 $1
+ ams (sLL $1 $> $ HsCmdArrApp noExtField $3 $1
HsHigherOrderApp False)
[mu AnnRarrowtail $2] }
| infixexp { $1 }
@@ -2619,13 +2619,13 @@ exp10_top :: { ECP }
| hpc_annot exp {% runECP_P $2 >>= \ $2 ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
+ ams (sLL $1 $> $ HsTickPragma noExtField (snd $ fst $ fst $ unLoc $1)
(snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
(fst $ fst $ fst $ unLoc $1) }
| '{-# CORE' STRING '#-}' exp {% runECP_P $4 >>= \ $4 ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
+ ams (sLL $1 $> $ HsCoreAnn noExtField (getCORE_PRAGs $1) (getStringLiteral $2) $4)
[mo $1,mj AnnVal $2
,mc $3] }
-- hdaume: core annotation
@@ -2635,7 +2635,7 @@ exp10 :: { ECP }
: exp10_top { $1 }
| scc_annot exp {% runECP_P $2 >>= \ $2 ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
+ ams (sLL $1 $> $ HsSCC noExtField (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
(fst $ fst $ unLoc $1) }
optSemi :: { ([Located Token],Bool) }
@@ -2686,11 +2686,11 @@ fexp :: { ECP }
| fexp TYPEAPP atype {% runECP_P $1 >>= \ $1 ->
runPV (checkExpBlockArguments $1) >>= \_ ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsAppType noExt $1 (mkHsWildCardBndrs $3))
+ ams (sLL $1 $> $ HsAppType noExtField $1 (mkHsWildCardBndrs $3))
[mj AnnAt $2] }
| 'static' aexp {% runECP_P $2 >>= \ $2 ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsStatic noExt $2)
+ ams (sLL $1 $> $ HsStatic noExtField $2)
[mj AnnStatic $1] }
| aexp { $1 }
@@ -2709,7 +2709,7 @@ aexp :: { ECP }
{ ECP $
runECP_PV $5 >>= \ $5 ->
amms (mkHsLamPV (comb2 $1 $>) (mkMatchGroup FromSource
- [sLL $1 $> $ Match { m_ext = noExt
+ [sLL $1 $> $ Match { m_ext = noExtField
, m_ctxt = LambdaExpr
, m_pats = $2:$3
, m_grhss = unguardedGRHSs $5 }]))
@@ -2722,7 +2722,7 @@ aexp :: { ECP }
| '\\' 'lcase' altslist
{% runPV $3 >>= \ $3 ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsLamCase noExt
+ ams (sLL $1 $> $ HsLamCase noExtField
(mkMatchGroup FromSource (snd $ unLoc $3)))
(mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
| 'if' exp optSemi 'then' exp optSemi 'else' exp
@@ -2737,7 +2737,7 @@ aexp :: { ECP }
++(map (\l -> mj AnnSemi l) (fst $6))) }
| 'if' ifgdpats {% hintMultiWayIf (getLoc $1) >>= \_ ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsMultiIf noExt
+ ams (sLL $1 $> $ HsMultiIf noExtField
(reverse $ snd $ unLoc $2))
(mj AnnIf $1:(fst $ unLoc $2)) }
| 'case' exp 'of' altslist {% runECP_P $2 >>= \ $2 ->
@@ -2760,7 +2760,7 @@ aexp :: { ECP }
{% (checkPattern <=< runECP_P) $2 >>= \ p ->
runECP_P $4 >>= \ $4@cmd ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd))
+ ams (sLL $1 $> $ HsProc noExtField p (sLL $1 $> $ HsCmdTop noExtField cmd))
-- TODO: is LL right here?
[mj AnnProc $1,mu AnnRarrow $3] }
@@ -2777,13 +2777,13 @@ aexp1 :: { ECP }
aexp2 :: { ECP }
: qvar { ECP $ mkHsVarPV $! $1 }
| qcon { ECP $ mkHsVarPV $! $1 }
- | ipvar { ecpFromExp $ sL1 $1 (HsIPVar noExt $! unLoc $1) }
- | overloaded_label { ecpFromExp $ sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) }
+ | ipvar { ecpFromExp $ sL1 $1 (HsIPVar noExtField $! unLoc $1) }
+ | overloaded_label { ecpFromExp $ sL1 $1 (HsOverLabel noExtField Nothing $! unLoc $1) }
| literal { ECP $ mkHsLitPV $! $1 }
-- This will enable overloaded strings permanently. Normally the renamer turns HsString
-- into HsOverLit when -foverloaded-strings is on.
-- | STRING { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
--- (getSTRING $1) noExt) }
+-- (getSTRING $1) noExtField) }
| INTEGER { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsIntegral (getINTEGER $1)) }
| RATIONAL { ECP $ mkHsOverLitPV (sL1 $1 $ mkHsFractional (getRATIONAL $1)) }
@@ -2813,47 +2813,47 @@ aexp2 :: { ECP }
-- Template Haskell Extension
| splice_untyped { ECP $ mkHsSplicePV $1 }
- | splice_typed { ecpFromExp $ mapLoc (HsSpliceE noExt) $1 }
+ | splice_typed { ecpFromExp $ mapLoc (HsSpliceE noExtField) $1 }
- | SIMPLEQUOTE qvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
- | SIMPLEQUOTE qcon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
- | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
- | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+ | SIMPLEQUOTE qvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+ | SIMPLEQUOTE qcon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+ | TH_TY_QUOTE tyvar {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+ | TH_TY_QUOTE gtycon {% fmap ecpFromExp $ ams (sLL $1 $> $ HsBracket noExtField (VarBr noExtField False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
| TH_TY_QUOTE {- nothing -} {% reportEmptyDoubleQuotes (getLoc $1) }
| '[|' exp '|]' {% runECP_P $2 >>= \ $2 ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsBracket noExt (ExpBr noExt $2))
+ ams (sLL $1 $> $ HsBracket noExtField (ExpBr noExtField $2))
(if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
| '[||' exp '||]' {% runECP_P $2 >>= \ $2 ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2))
+ ams (sLL $1 $> $ HsBracket noExtField (TExpBr noExtField $2))
(if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
| '[t|' ktype '|]' {% fmap ecpFromExp $
- ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] }
+ ams (sLL $1 $> $ HsBracket noExtField (TypBr noExtField $2)) [mo $1,mu AnnCloseQ $3] }
| '[p|' infixexp '|]' {% (checkPattern <=< runECP_P) $2 >>= \p ->
fmap ecpFromExp $
- ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p))
+ ams (sLL $1 $> $ HsBracket noExtField (PatBr noExtField p))
[mo $1,mu AnnCloseQ $3] }
| '[d|' cvtopbody '|]' {% fmap ecpFromExp $
- ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2)))
+ ams (sLL $1 $> $ HsBracket noExtField (DecBrL noExtField (snd $2)))
(mo $1:mu AnnCloseQ $3:fst $2) }
| quasiquote { ECP $ mkHsSplicePV $1 }
-- arrow notation extension
| '(|' aexp2 cmdargs '|)' {% runECP_P $2 >>= \ $2 ->
fmap ecpFromCmd $
- ams (sLL $1 $> $ HsCmdArrForm noExt $2 Prefix
+ ams (sLL $1 $> $ HsCmdArrForm noExtField $2 Prefix
Nothing (reverse $3))
[mu AnnOpenB $1,mu AnnCloseB $4] }
splice_exp :: { LHsExpr GhcPs }
- : splice_untyped { mapLoc (HsSpliceE noExt) $1 }
- | splice_typed { mapLoc (HsSpliceE noExt) $1 }
+ : splice_untyped { mapLoc (HsSpliceE noExtField) $1 }
+ | splice_typed { mapLoc (HsSpliceE noExtField) $1 }
splice_untyped :: { Located (HsSplice GhcPs) }
: TH_ID_SPLICE {% ams (sL1 $1 $ mkUntypedSplice HasDollar
- (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
+ (sL1 $1 $ HsVar noExtField (sL1 $1 (mkUnqual varName
(getTH_ID_SPLICE $1)))))
[mj AnnThIdSplice $1] }
| '$(' exp ')' {% runECP_P $2 >>= \ $2 ->
@@ -2862,7 +2862,7 @@ splice_untyped :: { Located (HsSplice GhcPs) }
splice_typed :: { Located (HsSplice GhcPs) }
: TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkTypedSplice HasDollar
- (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
+ (sL1 $1 $ HsVar noExtField (sL1 $1 (mkUnqual varName
(getTH_ID_TY_SPLICE $1)))))
[mj AnnThIdTySplice $1] }
| '$$(' exp ')' {% runECP_P $2 >>= \ $2 ->
@@ -2875,7 +2875,7 @@ cmdargs :: { [LHsCmdTop GhcPs] }
acmd :: { LHsCmdTop GhcPs }
: aexp2 {% runECP_P $1 >>= \ cmd ->
- return (sL1 cmd $ HsCmdTop noExt cmd) }
+ return (sL1 cmd $ HsCmdTop noExtField cmd) }
cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
: '{' cvtopdecls0 '}' { ([mj AnnOpenC $1
@@ -2909,7 +2909,7 @@ texp :: { ECP }
| infixexp qop {% runECP_P $1 >>= \ $1 ->
runPV $2 >>= \ $2 ->
return $ ecpFromExp $
- sLL $1 $> $ SectionL noExt $1 $2 }
+ sLL $1 $> $ SectionL noExtField $1 $2 }
| qopm infixexp { ECP $
superInfixOp $
runECP_PV $2 >>= \ $2 ->
@@ -2973,25 +2973,25 @@ list :: { forall b. DisambECP b => SrcSpan -> PV (Located b) }
| lexps { \loc -> $1 >>= \ $1 ->
mkHsExplicitListPV loc (reverse $1) }
| texp '..' { \loc -> runECP_PV $1 >>= \ $1 ->
- ams (cL loc $ ArithSeq noExt Nothing (From $1))
+ ams (cL loc $ ArithSeq noExtField Nothing (From $1))
[mj AnnDotdot $2]
>>= ecpFromExp' }
| texp ',' exp '..' { \loc ->
runECP_PV $1 >>= \ $1 ->
runECP_PV $3 >>= \ $3 ->
- ams (cL loc $ ArithSeq noExt Nothing (FromThen $1 $3))
+ ams (cL loc $ ArithSeq noExtField Nothing (FromThen $1 $3))
[mj AnnComma $2,mj AnnDotdot $4]
>>= ecpFromExp' }
| texp '..' exp { \loc -> runECP_PV $1 >>= \ $1 ->
runECP_PV $3 >>= \ $3 ->
- ams (cL loc $ ArithSeq noExt Nothing (FromTo $1 $3))
+ ams (cL loc $ ArithSeq noExtField Nothing (FromTo $1 $3))
[mj AnnDotdot $2]
>>= ecpFromExp' }
| texp ',' exp '..' exp { \loc ->
runECP_PV $1 >>= \ $1 ->
runECP_PV $3 >>= \ $3 ->
runECP_PV $5 >>= \ $5 ->
- ams (cL loc $ ArithSeq noExt Nothing (FromThenTo $1 $3 $5))
+ ams (cL loc $ ArithSeq noExtField Nothing (FromThenTo $1 $3 $5))
[mj AnnComma $2,mj AnnDotdot $4]
>>= ecpFromExp' }
| texp '|' flattenedpquals
@@ -3022,7 +3022,7 @@ flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
-- We just had one thing in our "parallel" list so
-- we simply return that thing directly
- qss -> sL1 $1 [sL1 $1 $ ParStmt noExt [ParStmtBlock noExt qs [] noSyntaxExpr |
+ qss -> sL1 $1 [sL1 $1 $ ParStmt noExtField [ParStmtBlock noExtField qs [] noSyntaxExpr |
qs <- qss]
noExpr noSyntaxExpr]
-- We actually found some actual parallel lists so
@@ -3135,7 +3135,7 @@ alts1 :: { forall b. DisambECP b => PV (Located ([AddAnn],[LMatch GhcPs (Locat
alt :: { forall b. DisambECP b => PV (LMatch GhcPs (Located b)) }
: pat alt_rhs { $2 >>= \ $2 ->
- ams (sLL $1 $> (Match { m_ext = noExt
+ ams (sLL $1 $> (Match { m_ext = noExtField
, m_ctxt = CaseAlt
, m_pats = [$1]
, m_grhss = snd $ unLoc $2 }))
@@ -3143,7 +3143,7 @@ alt :: { forall b. DisambECP b => PV (LMatch GhcPs (Located b)) }
alt_rhs :: { forall b. DisambECP b => PV (Located ([AddAnn],GRHSs GhcPs (Located b))) }
: ralt wherebinds { $1 >>= \alt ->
- return $ sLL alt $> (fst $ unLoc $2, GRHSs noExt (unLoc alt) (snd $ unLoc $2)) }
+ return $ sLL alt $> (fst $ unLoc $2, GRHSs noExtField (unLoc alt) (snd $ unLoc $2)) }
ralt :: { forall b. DisambECP b => PV (Located [LGRHS GhcPs (Located b)]) }
: '->' exp { runECP_PV $2 >>= \ $2 ->
@@ -3170,7 +3170,7 @@ ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) }
gdpat :: { forall b. DisambECP b => PV (LGRHS GhcPs (Located b)) }
: '|' guardquals '->' exp
{ runECP_PV $4 >>= \ $4 ->
- ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4)
+ ams (sL (comb2 $1 $>) $ GRHS noExtField (unLoc $2) $4)
[mj AnnVbar $1,mu AnnRarrow $3] }
-- 'pat' recognises a pattern, including one with a bang at the top
@@ -3264,7 +3264,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) }
[mu AnnLarrow $2] }
| exp { runECP_PV $1 >>= \ $1 ->
return $ sL1 $1 $ mkBodyStmt $1 }
- | 'let' binds { ams (sLL $1 $> $ LetStmt noExt (snd $ unLoc $2))
+ | 'let' binds { ams (sLL $1 $> $ LetStmt noExtField (snd $ unLoc $2))
(mj AnnLet $1:(fst $ unLoc $2)) }
-----------------------------------------------------------------------------
@@ -3312,7 +3312,7 @@ dbinds :: { Located [LIPBind GhcPs] }
dbind :: { LIPBind GhcPs }
dbind : ipvar '=' exp {% runECP_P $3 >>= \ $3 ->
- ams (sLL $1 $> (IPBind noExt (Left $1) $3))
+ ams (sLL $1 $> (IPBind noExtField (Left $1) $3))
[mj AnnEqual $2] }
ipvar :: { Located HsIPName }
@@ -3489,8 +3489,8 @@ qtycon :: { Located RdrName } -- Qualified or unqualified
| tycon { $1 }
qtycondoc :: { LHsType GhcPs } -- Qualified or unqualified
- : qtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) }
- | qtycon docprev { sLL $1 $> (HsDocTy noExt (sL1 $1 (HsTyVar noExt NotPromoted $1)) $2) }
+ : qtycon { sL1 $1 (HsTyVar noExtField NotPromoted $1) }
+ | qtycon docprev { sLL $1 $> (HsDocTy noExtField (sL1 $1 (HsTyVar noExtField NotPromoted $1)) $2) }
tycon :: { Located RdrName } -- Unqualified
: CONID { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
@@ -3700,8 +3700,8 @@ literal :: { Located (HsLit GhcPs) }
$ getPRIMCHAR $1 }
| PRIMSTRING { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
$ getPRIMSTRING $1 }
- | PRIMFLOAT { sL1 $1 $ HsFloatPrim noExt $ getPRIMFLOAT $1 }
- | PRIMDOUBLE { sL1 $1 $ HsDoublePrim noExt $ getPRIMDOUBLE $1 }
+ | PRIMFLOAT { sL1 $1 $ HsFloatPrim noExtField $ getPRIMFLOAT $1 }
+ | PRIMDOUBLE { sL1 $1 $ HsDoublePrim noExtField $ getPRIMDOUBLE $1 }
-----------------------------------------------------------------------------
-- Layout
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index c479ab0e1c25f0997ec4e26220d071e37157ef56..b16858de562a359b20167917ebcacc0f98978112 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -160,10 +160,10 @@ import Data.Data ( dataTypeOf, fromConstr, dataTypeConstrs )
-- *** See Note [The Naming story] in HsDecls ****
mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)
-mkTyClD (dL->L loc d) = cL loc (TyClD noExt d)
+mkTyClD (dL->L loc d) = cL loc (TyClD noExtField d)
mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)
-mkInstD (dL->L loc d) = cL loc (InstD noExt d)
+mkInstD (dL->L loc d) = cL loc (InstD noExtField d)
mkClassDecl :: SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
@@ -178,7 +178,7 @@ mkClassDecl loc (dL->L _ (mcxt, tycl_hdr)) fds where_cls
; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams
; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan
- ; return (cL loc (ClassDecl { tcdCExt = noExt, tcdCtxt = cxt
+ ; return (cL loc (ClassDecl { tcdCExt = noExtField, tcdCtxt = cxt
, tcdLName = cls, tcdTyVars = tyvars
, tcdFixity = fixity
, tcdFDs = snd (unLoc fds)
@@ -202,7 +202,7 @@ mkTyData loc new_or_data cType (dL->L _ (mcxt, tycl_hdr))
; (tyvars, anns) <- checkTyVars (ppr new_or_data) equalsDots tc tparams
; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
- ; return (cL loc (DataDecl { tcdDExt = noExt,
+ ; return (cL loc (DataDecl { tcdDExt = noExtField,
tcdLName = tc, tcdTyVars = tyvars,
tcdFixity = fixity,
tcdDataDefn = defn })) }
@@ -217,7 +217,7 @@ mkDataDefn :: NewOrData
mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
= do { checkDatatypeContext mcxt
; let cxt = fromMaybe (noLoc []) mcxt
- ; return (HsDataDefn { dd_ext = noExt
+ ; return (HsDataDefn { dd_ext = noExtField
, dd_ND = new_or_data, dd_cType = cType
, dd_ctxt = cxt
, dd_cons = data_cons
@@ -234,7 +234,7 @@ mkTySynonym loc lhs rhs
; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
; (tyvars, anns) <- checkTyVars (text "type") equalsDots tc tparams
; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
- ; return (cL loc (SynDecl { tcdSExt = noExt
+ ; return (cL loc (SynDecl { tcdSExt = noExtField
, tcdLName = tc, tcdTyVars = tyvars
, tcdFixity = fixity
, tcdRhs = rhs })) }
@@ -246,7 +246,7 @@ mkTyFamInstEqn :: Maybe [LHsTyVarBndr GhcPs]
mkTyFamInstEqn bndrs lhs rhs
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
; return (mkHsImplicitBndrs
- (FamEqn { feqn_ext = noExt
+ (FamEqn { feqn_ext = noExtField
, feqn_tycon = tc
, feqn_bndrs = bndrs
, feqn_pats = tparams
@@ -268,8 +268,8 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr
; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan
; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv
- ; return (cL loc (DataFamInstD noExt (DataFamInstDecl (mkHsImplicitBndrs
- (FamEqn { feqn_ext = noExt
+ ; return (cL loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs
+ (FamEqn { feqn_ext = noExtField
, feqn_tycon = tc
, feqn_bndrs = bndrs
, feqn_pats = tparams
@@ -280,7 +280,7 @@ mkTyFamInst :: SrcSpan
-> TyFamInstEqn GhcPs
-> P (LInstDecl GhcPs)
mkTyFamInst loc eqn
- = return (cL loc (TyFamInstD noExt (TyFamInstDecl eqn)))
+ = return (cL loc (TyFamInstD noExtField (TyFamInstDecl eqn)))
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
@@ -293,8 +293,8 @@ mkFamDecl loc info lhs ksig injAnn
; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan
; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams
; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan
- ; return (cL loc (FamDecl noExt (FamilyDecl
- { fdExt = noExt
+ ; return (cL loc (FamDecl noExtField (FamilyDecl
+ { fdExt = noExtField
, fdInfo = info, fdLName = tc
, fdTyVars = tyvars
, fdFixity = fixity
@@ -318,13 +318,13 @@ mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs
-- as spliced declaration. See #10945
mkSpliceDecl lexpr@(dL->L loc expr)
| HsSpliceE _ splice@(HsUntypedSplice {}) <- expr
- = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)
+ = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice)
| HsSpliceE _ splice@(HsQuasiQuote {}) <- expr
- = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)
+ = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice)
| otherwise
- = SpliceD noExt (SpliceDecl noExt (cL loc (mkUntypedSplice NoParens lexpr))
+ = SpliceD noExtField (SpliceDecl noExtField (cL loc (mkUntypedSplice NoParens lexpr))
ImplicitSplice)
mkRoleAnnotDecl :: SrcSpan
@@ -333,7 +333,7 @@ mkRoleAnnotDecl :: SrcSpan
-> P (LRoleAnnotDecl GhcPs)
mkRoleAnnotDecl loc tycon roles
= do { roles' <- mapM parse_role roles
- ; return $ cL loc $ RoleAnnotDecl noExt tycon roles' }
+ ; return $ cL loc $ RoleAnnotDecl noExtField tycon roles' }
where
role_data_type = dataTypeOf (undefined :: Role)
all_roles = map fromConstr $ dataTypeConstrs role_data_type
@@ -387,7 +387,7 @@ cvBindGroup binding
= do { (mbs, sigs, fam_ds, tfam_insts
, dfam_insts, _) <- cvBindsAndSigs binding
; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)
- return $ ValBinds noExt mbs sigs }
+ return $ ValBinds noExtField mbs sigs }
cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]
@@ -473,7 +473,7 @@ has_args ((dL->L _ (Match { m_pats = args })) : _) = not (null args)
-- no arguments. This is necessary now that variable bindings
-- with no arguments are now treated as FunBinds rather
-- than pattern bindings (tests/rename/should_fail/rnfail002).
-has_args ((dL->L _ (XMatch _)) : _) = panic "has_args"
+has_args ((dL->L _ (XMatch nec)) : _) = noExtCon nec
has_args (_ : _) = panic "has_args:Impossible Match" -- due to #15884
{- **********************************************************************
@@ -588,7 +588,7 @@ mkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) =
do { unless (name == patsyn_name) $
wrongNameBindingErr loc decl
; match <- case details of
- PrefixCon pats -> return $ Match { m_ext = noExt
+ PrefixCon pats -> return $ Match { m_ext = noExtField
, m_ctxt = ctxt, m_pats = pats
, m_grhss = rhs }
where
@@ -596,7 +596,7 @@ mkPatSynMatchGroup (dL->L loc patsyn_name) (dL->L _ decls) =
, mc_fixity = Prefix
, mc_strictness = NoSrcStrict }
- InfixCon p1 p2 -> return $ Match { m_ext = noExt
+ InfixCon p1 p2 -> return $ Match { m_ext = noExtField
, m_ctxt = ctxt
, m_pats = [p1, p2]
, m_grhss = rhs }
@@ -635,7 +635,7 @@ mkConDeclH98 :: Located RdrName -> Maybe [LHsTyVarBndr GhcPs]
-> ConDecl GhcPs
mkConDeclH98 name mb_forall mb_cxt args
- = ConDeclH98 { con_ext = noExt
+ = ConDeclH98 { con_ext = noExtField
, con_name = name
, con_forall = noLoc $ isJust mb_forall
, con_ex_tvs = mb_forall `orElse` []
@@ -647,7 +647,7 @@ mkGadtDecl :: [Located RdrName]
-> LHsType GhcPs -- Always a HsForAllTy
-> (ConDecl GhcPs, [AddAnn])
mkGadtDecl names ty
- = (ConDeclGADT { con_g_ext = noExt
+ = (ConDeclGADT { con_g_ext = noExtField
, con_names = names
, con_forall = cL l $ isLHsForAllTy ty'
, con_qvars = mkHsQTvs tvs
@@ -809,9 +809,9 @@ checkTyVars pp_what equals_or_where tc tparms
-- Check that the name space is correct!
chk :: LHsType GhcPs -> P (LHsTyVarBndr GhcPs)
chk (dL->L l (HsKindSig _ (dL->L lv (HsTyVar _ _ (dL->L _ tv))) k))
- | isRdrTyVar tv = return (cL l (KindedTyVar noExt (cL lv tv) k))
+ | isRdrTyVar tv = return (cL l (KindedTyVar noExtField (cL lv tv) k))
chk (dL->L l (HsTyVar _ _ (dL->L ltv tv)))
- | isRdrTyVar tv = return (cL l (UserTyVar noExt (cL ltv tv)))
+ | isRdrTyVar tv = return (cL l (UserTyVar noExtField (cL ltv tv)))
chk t@(dL->L loc _)
= addFatalError loc $
vcat [ text "Unexpected type" <+> quotes (ppr t)
@@ -853,16 +853,16 @@ data RuleTyTmVar = RuleTyTmVar (Located RdrName) (Maybe (LHsType GhcPs))
-- turns RuleTyTmVars into RuleBnrs - this is straightforward
mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs]
mkRuleBndrs = fmap (fmap cvt_one)
- where cvt_one (RuleTyTmVar v Nothing) = RuleBndr noExt v
+ where cvt_one (RuleTyTmVar v Nothing) = RuleBndr noExtField v
cvt_one (RuleTyTmVar v (Just sig)) =
- RuleBndrSig noExt v (mkLHsSigWcType sig)
+ RuleBndrSig noExtField v (mkLHsSigWcType sig)
-- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting
mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs]
mkRuleTyVarBndrs = fmap (fmap cvt_one)
- where cvt_one (RuleTyTmVar v Nothing) = UserTyVar noExt (fmap tm_to_ty v)
+ where cvt_one (RuleTyTmVar v Nothing) = UserTyVar noExtField (fmap tm_to_ty v)
cvt_one (RuleTyTmVar v (Just sig))
- = KindedTyVar noExt (fmap tm_to_ty v) sig
+ = KindedTyVar noExtField (fmap tm_to_ty v) sig
-- takes something in namespace 'varName' to something in namespace 'tvName'
tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ)
tm_to_ty _ = panic "mkRuleTyVarBndrs"
@@ -1082,7 +1082,7 @@ checkAPat loc e0 = do
nPlusKPatterns <- getBit NPlusKPatternsBit
case e0 of
PatBuilderPat p -> return p
- PatBuilderVar x -> return (VarPat noExt x)
+ PatBuilderVar x -> return (VarPat noExtField x)
-- Overloaded numeric patterns (e.g. f 0 x = x)
-- Negation is recorded separately, so that the literal is zero or +ve
@@ -1093,7 +1093,7 @@ checkAPat loc e0 = do
-> do { hintBangPat loc e0
; e' <- checkLPat e
; addAnnotation loc AnnBang lb
- ; return (BangPat noExt e') }
+ ; return (BangPat noExtField e') }
-- n+k patterns
PatBuilderOpApp
@@ -1109,7 +1109,7 @@ checkAPat loc e0 = do
r <- checkLPat r
return (ConPatIn (cL cl c) (InfixCon l r))
- PatBuilderPar e -> checkLPat e >>= (return . (ParPat noExt))
+ PatBuilderPar e -> checkLPat e >>= (return . (ParPat noExtField))
_ -> patFail loc (ppr e0)
placeHolderPunRhs :: DisambECP b => PV (Located b)
@@ -1176,7 +1176,7 @@ checkFunBind strictness ann lhs_loc fun is_infix pats (dL->L rhs_span grhss)
-- Add back the annotations stripped from any HsPar values in the lhs
-- mapM_ (\a -> a match_span) ann
return (ann, makeFunBind fun
- [cL match_span (Match { m_ext = noExt
+ [cL match_span (Match { m_ext = noExtField
, m_ctxt = FunRhs
{ mc_fun = fun
, mc_fixity = is_infix
@@ -1190,7 +1190,7 @@ makeFunBind :: Located RdrName -> [LMatch GhcPs (LHsExpr GhcPs)]
-> HsBind GhcPs
-- Like HsUtils.mkFunBind, but we need to be able to set the fixity too
makeFunBind fn ms
- = FunBind { fun_ext = noExt,
+ = FunBind { fun_ext = noExtField,
fun_id = fn,
fun_matches = mkMatchGroup FromSource ms,
fun_co_fn = idHsWrapper,
@@ -1200,7 +1200,7 @@ checkPatBind :: LPat GhcPs
-> Located (a,GRHSs GhcPs (LHsExpr GhcPs))
-> P ([AddAnn],HsBind GhcPs)
checkPatBind lhs (dL->L _ (_,grhss))
- = return ([],PatBind noExt lhs grhss ([],[]))
+ = return ([],PatBind noExtField lhs grhss ([],[]))
checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
checkValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v)))
@@ -1400,7 +1400,7 @@ pBangTy lt@(dL->L l1 _) xs =
Nothing -> (False, lt, pure (), xs)
Just (dL->L l2 strictMark, anns, xs') ->
let bl = combineSrcSpans l1 l2
- bt = HsBangTy noExt strictMark lt
+ bt = HsBangTy noExtField strictMark lt
in (True, cL bl bt, addAnnsAt bl anns, xs')
-- | Merge a /reversed/ and /non-empty/ soup of operators and operands
@@ -1433,7 +1433,7 @@ mergeOps all_xs = go (0 :: Int) [] id all_xs
; let a = ops_acc acc'
strictMark = HsSrcBang unpkSrc unpk NoSrcStrict
bl = combineSrcSpans l (getLoc a)
- bt = HsBangTy noExt strictMark a
+ bt = HsBangTy noExtField strictMark a
; addAnnsAt bl anns
; return (cL bl bt) }
else addFatalError l unpkError
@@ -1841,8 +1841,8 @@ class DisambInfixOp b where
mkHsInfixHolePV :: SrcSpan -> PV (Located b)
instance p ~ GhcPs => DisambInfixOp (HsExpr p) where
- mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v)
- mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v)
+ mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExtField v)
+ mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExtField v)
mkHsInfixHolePV l = return $ cL l hsHoleExpr
instance DisambInfixOp RdrName where
@@ -1973,25 +1973,25 @@ instance p ~ GhcPs => DisambECP (HsCmd p) where
type Body (HsCmd p) = HsCmd
ecpFromCmd' = return
ecpFromExp' (dL-> L l e) = cmdFail l (ppr e)
- mkHsLamPV l mg = return $ cL l (HsCmdLam noExt mg)
- mkHsLetPV l bs e = return $ cL l (HsCmdLet noExt bs e)
+ mkHsLamPV l mg = return $ cL l (HsCmdLam noExtField mg)
+ mkHsLetPV l bs e = return $ cL l (HsCmdLet noExtField bs e)
type InfixOp (HsCmd p) = HsExpr p
superInfixOp m = m
mkHsOpAppPV l c1 op c2 = do
- let cmdArg c = cL (getLoc c) $ HsCmdTop noExt c
- return $ cL l $ HsCmdArrForm noExt op Infix Nothing [cmdArg c1, cmdArg c2]
- mkHsCasePV l c mg = return $ cL l (HsCmdCase noExt c mg)
+ let cmdArg c = cL (getLoc c) $ HsCmdTop noExtField c
+ return $ cL l $ HsCmdArrForm noExtField op Infix Nothing [cmdArg c1, cmdArg c2]
+ mkHsCasePV l c mg = return $ cL l (HsCmdCase noExtField c mg)
type FunArg (HsCmd p) = HsExpr p
superFunArg m = m
mkHsAppPV l c e = do
checkCmdBlockArguments c
checkExpBlockArguments e
- return $ cL l (HsCmdApp noExt c e)
+ return $ cL l (HsCmdApp noExtField c e)
mkHsIfPV l c semi1 a semi2 b = do
checkDoAndIfThenElse c semi1 a semi2 b
return $ cL l (mkHsCmdIf c a b)
- mkHsDoPV l stmts = return $ cL l (HsCmdDo noExt stmts)
- mkHsParPV l c = return $ cL l (HsCmdPar noExt c)
+ mkHsDoPV l stmts = return $ cL l (HsCmdDo noExtField stmts)
+ mkHsParPV l c = return $ cL l (HsCmdPar noExtField c)
mkHsVarPV (dL->L l v) = cmdFail l (ppr v)
mkHsLitPV (dL->L l a) = cmdFail l (ppr a)
mkHsOverLitPV (dL->L l a) = cmdFail l (ppr a)
@@ -2027,36 +2027,36 @@ instance p ~ GhcPs => DisambECP (HsExpr p) where
nest 2 (ppr c) ]
return (cL l hsHoleExpr)
ecpFromExp' = return
- mkHsLamPV l mg = return $ cL l (HsLam noExt mg)
- mkHsLetPV l bs c = return $ cL l (HsLet noExt bs c)
+ mkHsLamPV l mg = return $ cL l (HsLam noExtField mg)
+ mkHsLetPV l bs c = return $ cL l (HsLet noExtField bs c)
type InfixOp (HsExpr p) = HsExpr p
superInfixOp m = m
mkHsOpAppPV l e1 op e2 = do
- return $ cL l $ OpApp noExt e1 op e2
- mkHsCasePV l e mg = return $ cL l (HsCase noExt e mg)
+ return $ cL l $ OpApp noExtField e1 op e2
+ mkHsCasePV l e mg = return $ cL l (HsCase noExtField e mg)
type FunArg (HsExpr p) = HsExpr p
superFunArg m = m
mkHsAppPV l e1 e2 = do
checkExpBlockArguments e1
checkExpBlockArguments e2
- return $ cL l (HsApp noExt e1 e2)
+ return $ cL l (HsApp noExtField e1 e2)
mkHsIfPV l c semi1 a semi2 b = do
checkDoAndIfThenElse c semi1 a semi2 b
return $ cL l (mkHsIf c a b)
- mkHsDoPV l stmts = return $ cL l (HsDo noExt DoExpr stmts)
- mkHsParPV l e = return $ cL l (HsPar noExt e)
- mkHsVarPV v@(getLoc -> l) = return $ cL l (HsVar noExt v)
- mkHsLitPV (dL->L l a) = return $ cL l (HsLit noExt a)
- mkHsOverLitPV (dL->L l a) = return $ cL l (HsOverLit noExt a)
+ mkHsDoPV l stmts = return $ cL l (HsDo noExtField DoExpr stmts)
+ mkHsParPV l e = return $ cL l (HsPar noExtField e)
+ mkHsVarPV v@(getLoc -> l) = return $ cL l (HsVar noExtField v)
+ mkHsLitPV (dL->L l a) = return $ cL l (HsLit noExtField a)
+ mkHsOverLitPV (dL->L l a) = return $ cL l (HsOverLit noExtField a)
mkHsWildCardPV l = return $ cL l hsHoleExpr
- mkHsTySigPV l a sig = return $ cL l (ExprWithTySig noExt a (mkLHsSigWcType sig))
- mkHsExplicitListPV l xs = return $ cL l (ExplicitList noExt Nothing xs)
- mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExt) sp
+ mkHsTySigPV l a sig = return $ cL l (ExprWithTySig noExtField a (mkLHsSigWcType sig))
+ mkHsExplicitListPV l xs = return $ cL l (ExplicitList noExtField Nothing xs)
+ mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExtField) sp
mkHsRecordPV l lrec a (fbinds, ddLoc) = do
r <- mkRecConstrOrUpdate a lrec (fbinds, ddLoc)
checkRecordSyntax (cL l r)
- mkHsNegAppPV l a = return $ cL l (NegApp noExt a noSyntaxExpr)
- mkHsSectionR_PV l op e = return $ cL l (SectionR noExt op e)
+ mkHsNegAppPV l a = return $ cL l (NegApp noExtField a noSyntaxExpr)
+ mkHsSectionR_PV l op e = return $ cL l (SectionR noExtField op e)
mkHsViewPatPV l a b = patSynErr l (ppr a <+> text "->" <+> ppr b) empty
mkHsAsPatPV l v e = do
opt_TypeApplications <- getBit TypeApplicationsBit
@@ -2077,7 +2077,7 @@ patSynErr l e explanation =
; return (cL l hsHoleExpr) }
hsHoleExpr :: HsExpr (GhcPass id)
-hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_"))
+hsHoleExpr = HsUnboundVar noExtField (TrueExprHole (mkVarOcc "_"))
-- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
data PatBuilder p
@@ -2130,16 +2130,16 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where
mkHsVarPV v@(getLoc -> l) = return $ cL l (PatBuilderVar v)
mkHsLitPV lit@(dL->L l a) = do
checkUnboxedStringLitPat lit
- return $ cL l (PatBuilderPat (LitPat noExt a))
+ return $ cL l (PatBuilderPat (LitPat noExtField a))
mkHsOverLitPV (dL->L l a) = return $ cL l (PatBuilderOverLit a)
- mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExt))
+ mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExtField))
mkHsTySigPV l b sig = do
p <- checkLPat b
- return $ cL l (PatBuilderPat (SigPat noExt p (mkLHsSigWcType sig)))
+ return $ cL l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig)))
mkHsExplicitListPV l xs = do
ps <- traverse checkLPat xs
- return (cL l (PatBuilderPat (ListPat noExt ps)))
- mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExt sp))
+ return (cL l (PatBuilderPat (ListPat noExtField ps)))
+ mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExtField sp))
mkHsRecordPV l _ a (fbinds, ddLoc) = do
r <- mkPatRec a (mk_rec_fields fbinds ddLoc)
checkRecordSyntax (cL l r)
@@ -2153,13 +2153,13 @@ instance p ~ GhcPs => DisambECP (PatBuilder p) where
| otherwise = patFail l (pprInfixOcc (unLoc op) <> ppr p)
mkHsViewPatPV l a b = do
p <- checkLPat b
- return $ cL l (PatBuilderPat (ViewPat noExt a p))
+ return $ cL l (PatBuilderPat (ViewPat noExtField a p))
mkHsAsPatPV l v e = do
p <- checkLPat e
- return $ cL l (PatBuilderPat (AsPat noExt v p))
+ return $ cL l (PatBuilderPat (AsPat noExtField v p))
mkHsLazyPatPV l e = do
p <- checkLPat e
- return $ cL l (PatBuilderPat (LazyPat noExt p))
+ return $ cL l (PatBuilderPat (LazyPat noExtField p))
mkSumOrTuplePV = mkSumOrTuplePat
checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()
@@ -2671,13 +2671,13 @@ mkRecConstrOrUpdate exp _ (fs,dd)
mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
mkRdrRecordUpd exp flds
- = RecordUpd { rupd_ext = noExt
+ = RecordUpd { rupd_ext = noExtField
, rupd_expr = exp
, rupd_flds = flds }
mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
mkRdrRecordCon con flds
- = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }
+ = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds }
mk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg
mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
@@ -2686,9 +2686,9 @@ mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field (HsRecField (dL->L loc (FieldOcc _ rdr)) arg pun)
- = HsRecField (L loc (Unambiguous noExt rdr)) arg pun
-mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc _)) _ _)
- = panic "mk_rec_upd_field"
+ = HsRecField (L loc (Unambiguous noExtField rdr)) arg pun
+mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc nec)) _ _)
+ = noExtCon nec
mk_rec_upd_field (HsRecField _ _ _)
= panic "mk_rec_upd_field: Impossible Match" -- due to #15884
@@ -2747,8 +2747,8 @@ mkImport cconv safety (L loc (StringLiteral esrc entity), v, ty) =
funcTarget = CFunction (StaticTarget esrc entity' Nothing True)
importSpec = CImport cconv safety Nothing funcTarget (cL loc esrc)
- returnSpec spec = return $ ForD noExt $ ForeignImport
- { fd_i_ext = noExt
+ returnSpec spec = return $ ForD noExtField $ ForeignImport
+ { fd_i_ext = noExtField
, fd_name = v
, fd_sig_ty = ty
, fd_fi = spec
@@ -2821,8 +2821,8 @@ mkExport :: Located CCallConv
-> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)
-> P (HsDecl GhcPs)
mkExport (dL->L lc cconv) (dL->L le (StringLiteral esrc entity), v, ty)
- = return $ ForD noExt $
- ForeignExport { fd_e_ext = noExt, fd_name = v, fd_sig_ty = ty
+ = return $ ForD noExtField $
+ ForeignExport { fd_e_ext = noExtField, fd_name = v, fd_sig_ty = ty
, fd_fe = CExport (cL lc (CExportStatic esrc entity' cconv))
(cL le esrc) }
where
@@ -2855,11 +2855,11 @@ mkModuleImpExp (dL->L l specname) subs =
case subs of
ImpExpAbs
| isVarNameSpace (rdrNameSpace name)
- -> return $ IEVar noExt (cL l (ieNameFromSpec specname))
- | otherwise -> IEThingAbs noExt . cL l <$> nameT
- ImpExpAll -> IEThingAll noExt . cL l <$> nameT
+ -> return $ IEVar noExtField (cL l (ieNameFromSpec specname))
+ | otherwise -> IEThingAbs noExtField . cL l <$> nameT
+ ImpExpAll -> IEThingAll noExtField . cL l <$> nameT
ImpExpList xs ->
- (\newName -> IEThingWith noExt (cL l newName)
+ (\newName -> IEThingWith noExtField (cL l newName)
NoIEWildcard (wrapped xs) []) <$> nameT
ImpExpAllWith xs ->
do allowed <- getBit PatternSynonymsBit
@@ -2870,7 +2870,7 @@ mkModuleImpExp (dL->L l specname) subs =
(findIndex isImpExpQcWildcard withs)
ies = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
in (\newName
- -> IEThingWith noExt (cL l newName) pos ies [])
+ -> IEThingWith noExtField (cL l newName) pos ies [])
<$> nameT
else addFatalError l
(text "Illegal export form (use PatternSynonyms to enable)")
@@ -3133,14 +3133,14 @@ mkSumOrTupleExpr :: SrcSpan -> Boxity -> SumOrTuple (HsExpr GhcPs) -> PV (LHsExp
-- Tuple
mkSumOrTupleExpr l boxity (Tuple es) =
- return $ cL l (ExplicitTuple noExt (map toTupArg es) boxity)
+ return $ cL l (ExplicitTuple noExtField (map toTupArg es) boxity)
where
toTupArg :: Located (Maybe (LHsExpr GhcPs)) -> LHsTupArg GhcPs
- toTupArg = mapLoc (maybe missingTupArg (Present noExt))
+ toTupArg = mapLoc (maybe missingTupArg (Present noExtField))
-- Sum
mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
- return $ cL l (ExplicitSum noExt alt arity e)
+ return $ cL l (ExplicitSum noExtField alt arity e)
mkSumOrTupleExpr l Boxed a@Sum{} =
addFatalError l (hang (text "Boxed sums not supported:") 2
(pprSumOrTuple Boxed a))
@@ -3150,7 +3150,7 @@ mkSumOrTuplePat :: SrcSpan -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> PV (Loc
-- Tuple
mkSumOrTuplePat l boxity (Tuple ps) = do
ps' <- traverse toTupPat ps
- return $ cL l (PatBuilderPat (TuplePat noExt ps' boxity))
+ return $ cL l (PatBuilderPat (TuplePat noExtField ps' boxity))
where
toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs)
toTupPat (dL -> L l p) = case p of
@@ -3160,7 +3160,7 @@ mkSumOrTuplePat l boxity (Tuple ps) = do
-- Sum
mkSumOrTuplePat l Unboxed (Sum alt arity p) = do
p' <- checkLPat p
- return $ cL l (PatBuilderPat (SumPat noExt p' alt arity))
+ return $ cL l (PatBuilderPat (SumPat noExtField p' alt arity))
mkSumOrTuplePat l Boxed a@Sum{} =
addFatalError l (hang (text "Boxed sums not supported:") 2
(pprSumOrTuple Boxed a))
@@ -3173,7 +3173,7 @@ mkLHsOpTy x op y =
mkLHsDocTy :: LHsType GhcPs -> LHsDocString -> LHsType GhcPs
mkLHsDocTy t doc =
let loc = getLoc t `combineSrcSpans` getLoc doc
- in cL loc (HsDocTy noExt t doc)
+ in cL loc (HsDocTy noExtField t doc)
mkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs
mkLHsDocTyMaybe t = maybe t (mkLHsDocTy t)
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 22f2cf3e9f08980f2f5ed294adc57dfa63aa1698..db215522217e516ea3a6c550a54bb70f299a2865 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 772122bb99130ac09a5e2fdc62590da6cf78363e..91cf8f22f45e0232954cf1416892357c6decadf0 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 98d487df2dd72cc3873a9ad0bef3070e3a462f62..eadb4bca030520cd6d761a43fe59dc0d8c4502d6 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 1fa81c8fc2d7fb08669686b1b180847ee0631c8b..665d87747b5bb9fe248a7c38f49be71c591bbf1a 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 9a69423209727b6d64b4b2679a319f931035ffbc..5bfc1a37d8dca79d3efc033f1c50800dc8b7351f 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 4a08ab4761c96daf9b1b0f72d4234038cf2b347b..150b1cd23fc965ac8ed4a0ce988f3d62b060de38 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 e3c9576e94723ef19f30c45bd38baf75b4136e20..2aa5afbbd2259832e8ea3fce5d3e98451fd9c9d3 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 5766080fefbe5bb9f55d4dbec7e0b739dee4dc2a..9c3e3179589ed3d2c8daac976158a7cbe459499a 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 4b4d519324cd73be396555cae3a2f115ea526ce7..80b03d3f254569c03c4b852fa0a3fc23dd464ab4 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
diff --git a/compiler/simplStg/StgLiftLams/Transformation.hs b/compiler/simplStg/StgLiftLams/Transformation.hs
index 7b37bac91e417edfff3695838373635ce0b5a8a9..bef39a18565e7772e0400ba8ab71d43a89305ba3 100644
--- a/compiler/simplStg/StgLiftLams/Transformation.hs
+++ b/compiler/simplStg/StgLiftLams/Transformation.hs
@@ -107,12 +107,12 @@ liftRhs mb_former_fvs rhs@(StgRhsCon ccs con args)
liftRhs Nothing (StgRhsClosure _ ccs upd infos body) = do
-- This RHS wasn't lifted.
withSubstBndrs (map binderInfoBndr infos) $ \bndrs' ->
- StgRhsClosure noExtSilent ccs upd bndrs' <$> liftExpr body
+ StgRhsClosure noExtFieldSilent ccs upd bndrs' <$> liftExpr body
liftRhs (Just former_fvs) (StgRhsClosure _ ccs upd infos body) = do
-- This RHS was lifted. Insert extra binders for @former_fvs@.
withSubstBndrs (map binderInfoBndr infos) $ \bndrs' -> do
let bndrs'' = dVarSetElems former_fvs ++ bndrs'
- StgRhsClosure noExtSilent ccs upd bndrs'' <$> liftExpr body
+ StgRhsClosure noExtFieldSilent ccs upd bndrs'' <$> liftExpr body
liftArgs :: InStgArg -> LiftM OutStgArg
liftArgs a@(StgLitArg _) = pure a
@@ -142,13 +142,13 @@ liftExpr (StgLet scope bind body)
body' <- liftExpr body
case mb_bind' of
Nothing -> pure body' -- withLiftedBindPairs decided to lift it and already added floats
- Just bind' -> pure (StgLet noExtSilent bind' body')
+ Just bind' -> pure (StgLet noExtFieldSilent bind' body')
liftExpr (StgLetNoEscape scope bind body)
= withLiftedBind NotTopLevel bind scope $ \mb_bind' -> do
body' <- liftExpr body
case mb_bind' of
Nothing -> pprPanic "stgLiftLams" (text "Should never decide to lift LNEs")
- Just bind' -> pure (StgLetNoEscape noExtSilent bind' body')
+ Just bind' -> pure (StgLetNoEscape noExtFieldSilent bind' body')
liftAlt :: LlStgAlt -> LiftM OutStgAlt
liftAlt (con, infos, rhs) = withSubstBndrs (map binderInfoBndr infos) $ \bndrs' ->
diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs
index dae1e351eb177ccbb9d82c2e027d022c59d60dbb..7a530009fe2b77877b012e5fcb966a9c68a6e1c9 100644
--- a/compiler/stgSyn/CoreToStg.hs
+++ b/compiler/stgSyn/CoreToStg.hs
@@ -644,8 +644,8 @@ coreToStgLet bind body = do
-- Compute the new let-expression
let
- new_let | isJoinBind bind = StgLetNoEscape noExtSilent bind2 body2
- | otherwise = StgLet noExtSilent bind2 body2
+ new_let | isJoinBind bind = StgLetNoEscape noExtFieldSilent bind2 body2
+ | otherwise = StgLet noExtFieldSilent bind2 body2
return new_let
where
@@ -688,7 +688,7 @@ mkTopStgRhs :: DynFlags -> Module -> CollectedCCs
mkTopStgRhs dflags this_mod ccs bndr rhs
| StgLam bndrs body <- rhs
= -- StgLam can't have empty arguments, so not CAF
- ( StgRhsClosure noExtSilent
+ ( StgRhsClosure noExtFieldSilent
dontCareCCS
ReEntrant
(toList bndrs) body
@@ -704,13 +704,13 @@ mkTopStgRhs dflags this_mod ccs bndr rhs
-- Otherwise it's a CAF, see Note [Cost-centre initialization plan].
| gopt Opt_AutoSccsOnIndividualCafs dflags
- = ( StgRhsClosure noExtSilent
+ = ( StgRhsClosure noExtFieldSilent
caf_ccs
upd_flag [] rhs
, collectCC caf_cc caf_ccs ccs )
| otherwise
- = ( StgRhsClosure noExtSilent
+ = ( StgRhsClosure noExtFieldSilent
all_cafs_ccs
upd_flag [] rhs
, ccs )
@@ -738,14 +738,14 @@ mkTopStgRhs dflags this_mod ccs bndr rhs
mkStgRhs :: Id -> StgExpr -> StgRhs
mkStgRhs bndr rhs
| StgLam bndrs body <- rhs
- = StgRhsClosure noExtSilent
+ = StgRhsClosure noExtFieldSilent
currentCCS
ReEntrant
(toList bndrs) body
| isJoinId bndr -- must be a nullary join point
= ASSERT(idJoinArity bndr == 0)
- StgRhsClosure noExtSilent
+ StgRhsClosure noExtFieldSilent
currentCCS
ReEntrant -- ignored for LNE
[] rhs
@@ -754,7 +754,7 @@ mkStgRhs bndr rhs
= StgRhsCon currentCCS con args
| otherwise
- = StgRhsClosure noExtSilent
+ = StgRhsClosure noExtFieldSilent
currentCCS
upd_flag [] rhs
where
diff --git a/compiler/stgSyn/StgSyn.hs b/compiler/stgSyn/StgSyn.hs
index e6a12053990b9259a7b239e8b58b9ab2cc8fb85a..f7dae5dbe21b0042487fde75e0a44ced0cf377f0 100644
--- a/compiler/stgSyn/StgSyn.hs
+++ b/compiler/stgSyn/StgSyn.hs
@@ -25,7 +25,7 @@ module StgSyn (
GenStgAlt, AltType(..),
StgPass(..), BinderP, XRhsClosure, XLet, XLetNoEscape,
- NoExtSilent, noExtSilent,
+ NoExtFieldSilent, noExtFieldSilent,
OutputablePass,
UpdateFlag(..), isUpdatable,
@@ -450,19 +450,19 @@ data StgPass
| LiftLams
| CodeGen
--- | Like 'HsExpression.NoExt', but with an 'Outputable' instance that returns
--- 'empty'.
-data NoExtSilent = NoExtSilent
+-- | Like 'HsExtension.NoExtField', but with an 'Outputable' instance that
+-- returns 'empty'.
+data NoExtFieldSilent = NoExtFieldSilent
deriving (Data, Eq, Ord)
-instance Outputable NoExtSilent where
+instance Outputable NoExtFieldSilent where
ppr _ = empty
-- | Used when constructing a term with an unused extension point that should
-- not appear in pretty-printed output at all.
-noExtSilent :: NoExtSilent
-noExtSilent = NoExtSilent
--- TODO: Maybe move this to HsExtensions? I'm not sure about the implications
+noExtFieldSilent :: NoExtFieldSilent
+noExtFieldSilent = NoExtFieldSilent
+-- TODO: Maybe move this to HsExtension? I'm not sure about the implications
-- on build time...
-- TODO: Do we really want to the extension point type families to have a closed
@@ -472,17 +472,17 @@ type instance BinderP 'Vanilla = Id
type instance BinderP 'CodeGen = Id
type family XRhsClosure (pass :: StgPass)
-type instance XRhsClosure 'Vanilla = NoExtSilent
+type instance XRhsClosure 'Vanilla = NoExtFieldSilent
-- | Code gen needs to track non-global free vars
type instance XRhsClosure 'CodeGen = DIdSet
type family XLet (pass :: StgPass)
-type instance XLet 'Vanilla = NoExtSilent
-type instance XLet 'CodeGen = NoExtSilent
+type instance XLet 'Vanilla = NoExtFieldSilent
+type instance XLet 'CodeGen = NoExtFieldSilent
type family XLetNoEscape (pass :: StgPass)
-type instance XLetNoEscape 'Vanilla = NoExtSilent
-type instance XLetNoEscape 'CodeGen = NoExtSilent
+type instance XLetNoEscape 'Vanilla = NoExtFieldSilent
+type instance XLetNoEscape 'CodeGen = NoExtFieldSilent
stgRhsArity :: StgRhs -> Int
stgRhsArity (StgRhsClosure _ _ _ bndrs _)
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 28794aaafad2f650875e80f7c872a420903fa20f..1ec85b22d15cf2c13370fc3b8b7a9ece3e47b1bd 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -103,7 +103,7 @@ newMethodFromName origin name ty_args
; wrap <- ASSERT( not (isForAllTy ty) && isSingleton theta )
instCall origin ty_args theta
- ; return (mkHsWrap wrap (HsVar noExt (noLoc id))) }
+ ; return (mkHsWrap wrap (HsVar noExtField (noLoc id))) }
{-
************************************************************************
@@ -534,7 +534,7 @@ newOverloadedLit
= newNonTrivialOverloadedLit orig lit res_ty
where
orig = LiteralOrigin lit
-newOverloadedLit XOverLit{} _ = panic "newOverloadedLit"
+newOverloadedLit (XOverLit nec) _ = noExtCon nec
-- Does not handle things that 'shortCutLit' can handle. See also
-- newOverloadedLit in TcUnify
@@ -566,7 +566,7 @@ mkOverLit (HsIntegral i)
mkOverLit (HsFractional r)
= do { rat_ty <- tcMetaTy rationalTyConName
- ; return (HsRat noExt r rat_ty) }
+ ; return (HsRat noExtField r rat_ty) }
mkOverLit (HsIsString src s) = return (HsString src s)
diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs
index 60f21ccce74f9371a7b59c1e8dfd10e59c83b591..00c1958106d00796b75ed2b65146907ae7b542fe 100644
--- a/compiler/typecheck/TcAnnotations.hs
+++ b/compiler/typecheck/TcAnnotations.hs
@@ -66,7 +66,7 @@ tcAnnotation (L loc ann@(HsAnnotation _ _ provenance expr)) = do
where
safeHsErr = vcat [ text "Annotations are not compatible with Safe Haskell."
, text "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]
-tcAnnotation (L _ (XAnnDecl _)) = panic "tcAnnotation"
+tcAnnotation (L _ (XAnnDecl nec)) = noExtCon nec
annProvenanceToTarget :: Module -> AnnProvenance Name
-> AnnTarget Name
diff --git a/compiler/typecheck/TcArrows.hs b/compiler/typecheck/TcArrows.hs
index 763684bb750ac324d9634b315df3cb6bea63301a..c5e3ca99b28fd70ac73a7ea722e66ac81bff0c32 100644
--- a/compiler/typecheck/TcArrows.hs
+++ b/compiler/typecheck/TcArrows.hs
@@ -126,7 +126,7 @@ tcCmdTop env (L loc (HsCmdTop names cmd)) cmd_ty@(cmd_stk, res_ty)
do { cmd' <- tcCmd env cmd cmd_ty
; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names
; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names') cmd') }
-tcCmdTop _ (L _ XCmdTop{}) _ = panic "tcCmdTop"
+tcCmdTop _ (L _ (XCmdTop nec)) _ = noExtCon nec
----------------------------------------
tcCmd :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTcId)
@@ -254,7 +254,7 @@ tc_cmd env
tcPats LambdaExpr pats (map mkCheckExpType arg_tys) $
tc_grhss grhss cmd_stk' (mkCheckExpType res_ty)
- ; let match' = L mtch_loc (Match { m_ext = noExt
+ ; let match' = L mtch_loc (Match { m_ext = noExtField
, m_ctxt = LambdaExpr, m_pats = pats'
, m_grhss = grhss' })
arg_tys = map hsLPatType pats'
@@ -271,14 +271,14 @@ tc_cmd env
= do { (binds', grhss') <- tcLocalBinds binds $
mapM (wrapLocM (tc_grhs stk_ty res_ty)) grhss
; return (GRHSs x grhss' (L l binds')) }
- tc_grhss (XGRHSs _) _ _ = panic "tc_grhss"
+ tc_grhss (XGRHSs nec) _ _ = noExtCon nec
tc_grhs stk_ty res_ty (GRHS x guards body)
= do { (guards', rhs') <- tcStmtsAndThen pg_ctxt tcGuardStmt guards res_ty $
\ res_ty -> tcCmd env body
(stk_ty, checkingExpType "tc_grhs" res_ty)
; return (GRHS x guards' rhs') }
- tc_grhs _ _ (XGRHS _) = panic "tc_grhs"
+ tc_grhs _ _ (XGRHS nec) = noExtCon nec
-------------------------------------------
-- Do notation
@@ -323,7 +323,7 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty)
; cmd' <- tcCmdTop env' cmd (stk_ty, res_ty)
; return (cmd', mkCmdArrTy env' (mkPairTy alphaTy stk_ty) res_ty) }
-tc_cmd _ (XCmd {}) _ = panic "tc_cmd"
+tc_cmd _ (XCmd nec) _ = noExtCon nec
-----------------------------------------------------------------
-- Base case for illegal commands
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 6539c0d3e2fca63f89e83acbe87c405cc9725850..fcf871f75f96da7929f58869704c95f85b963dc5 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -360,17 +360,17 @@ tcLocalBinds (HsIPBinds x (IPBinds _ ip_binds)) thing_inside
; ip_id <- newDict ipClass [ p, ty ]
; expr' <- tcMonoExpr expr (mkCheckExpType ty)
; let d = toDict ipClass p ty `fmap` expr'
- ; return (ip_id, (IPBind noExt (Right ip_id) d)) }
+ ; return (ip_id, (IPBind noExtField (Right ip_id) d)) }
tc_ip_bind _ (IPBind _ (Right {}) _) = panic "tc_ip_bind"
- tc_ip_bind _ (XIPBind _) = panic "tc_ip_bind"
+ tc_ip_bind _ (XIPBind nec) = noExtCon nec
-- Coerces a `t` into a dictionry for `IP "x" t`.
-- co : t -> IP "x" t
toDict ipClass x ty = mkHsWrap $ mkWpCastR $
wrapIP $ mkClassPred ipClass [x,ty]
-tcLocalBinds (HsIPBinds _ (XHsIPBinds _ )) _ = panic "tcLocalBinds"
-tcLocalBinds (XHsLocalBindsLR _) _ = panic "tcLocalBinds"
+tcLocalBinds (HsIPBinds _ (XHsIPBinds nec)) _ = noExtCon nec
+tcLocalBinds (XHsLocalBindsLR nec) _ = noExtCon nec
{- Note [Implicit parameter untouchables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -726,14 +726,14 @@ tcPolyCheck prag_fn
, fun_ext = placeHolderNamesTc
, fun_tick = tick }
- export = ABE { abe_ext = noExt
- , abe_wrap = idHsWrapper
+ export = ABE { abe_ext = noExtField
+ , abe_wrap = idHsWrapper
, abe_poly = poly_id
, abe_mono = mono_id
, abe_prags = SpecPrags spec_prags }
abs_bind = cL loc $
- AbsBinds { abs_ext = noExt
+ AbsBinds { abs_ext = noExtField
, abs_tvs = skol_tvs
, abs_ev_vars = ev_vars
, abs_ev_binds = [ev_binds]
@@ -816,7 +816,7 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
; loc <- getSrcSpanM
; let poly_ids = map abe_poly exports
abs_bind = cL loc $
- AbsBinds { abs_ext = noExt
+ AbsBinds { abs_ext = noExtField
, abs_tvs = qtvs
, abs_ev_vars = givens, abs_ev_binds = [ev_binds]
, abs_exports = exports, abs_binds = binds'
@@ -877,7 +877,7 @@ mkExport prag_fn insoluble qtvs theta
; when warn_missing_sigs $
localSigWarn Opt_WarnMissingLocalSignatures poly_id mb_sig
- ; return (ABE { abe_ext = noExt
+ ; return (ABE { abe_ext = noExtField
, abe_wrap = wrap
-- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty)
, abe_poly = poly_id
diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs
index f085e07f14cb235630eadd19bafb247bca2347e6..f4d89e517e8537f8d641cee3cd7f871db13d65fc 100644
--- a/compiler/typecheck/TcClassDcl.hs
+++ b/compiler/typecheck/TcClassDcl.hs
@@ -284,12 +284,12 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn
tcPolyCheck no_prag_fn local_dm_sig
(L bind_loc lm_bind)
- ; let export = ABE { abe_ext = noExt
+ ; let export = ABE { abe_ext = noExtField
, abe_poly = global_dm_id
, abe_mono = local_dm_id
, abe_wrap = idHsWrapper
, abe_prags = IsDefaultMethod }
- full_bind = AbsBinds { abs_ext = noExt
+ full_bind = AbsBinds { abs_ext = noExtField
, abs_tvs = tyvars
, abs_ev_vars = [this_dict]
, abs_exports = [export]
diff --git a/compiler/typecheck/TcDefaults.hs b/compiler/typecheck/TcDefaults.hs
index d091e9c156ed91d09d6674be6ba3f750c4ceb6ee..926eca1ac0ef2374180b2af7ee758da8ab2bf0c5 100644
--- a/compiler/typecheck/TcDefaults.hs
+++ b/compiler/typecheck/TcDefaults.hs
@@ -66,7 +66,7 @@ tcDefaults [L locn (DefaultDecl _ mono_tys)]
tcDefaults decls@(L locn (DefaultDecl _ _) : _)
= setSrcSpan locn $
failWithTc (dupDefaultDeclErr decls)
-tcDefaults (L _ (XDefaultDecl _):_) = panic "tcDefaults"
+tcDefaults (L _ (XDefaultDecl nec):_) = noExtCon nec
tc_default_ty :: [Class] -> LHsType GhcRn -> TcM Type
@@ -100,8 +100,8 @@ dupDefaultDeclErr (L _ (DefaultDecl _ _) : dup_things)
where
pp (L locn (DefaultDecl _ _))
= text "here was another default declaration" <+> ppr locn
- pp (L _ (XDefaultDecl _)) = panic "dupDefaultDeclErr"
-dupDefaultDeclErr (L _ (XDefaultDecl _) : _) = panic "dupDefaultDeclErr"
+ pp (L _ (XDefaultDecl nec)) = noExtCon nec
+dupDefaultDeclErr (L _ (XDefaultDecl nec) : _) = noExtCon nec
dupDefaultDeclErr [] = panic "dupDefaultDeclErr []"
badDefaultTy :: Type -> [Class] -> SDoc
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 224a6a713a16300aadf559bc33b21e9fe5c31f3e..4ab9fa69d3b04cae580d565933a2a6cda827c851 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -329,7 +329,7 @@ renameDeriv is_boot inst_infos bagBinds
-- before renaming the instances themselves
; traceTc "rnd" (vcat (map (\i -> pprInstInfoDetails i $$ text "") inst_infos))
; (aux_binds, aux_sigs) <- mapAndUnzipBagM return bagBinds
- ; let aux_val_binds = ValBinds noExt aux_binds (bagToList aux_sigs)
+ ; let aux_val_binds = ValBinds noExtField aux_binds (bagToList aux_sigs)
; rn_aux_lhs <- rnTopBindsLHS emptyFsEnv aux_val_binds
; let bndrs = collectHsValBinders rn_aux_lhs
; envs <- extendGlobalRdrEnvRn (map avail bndrs) emptyFsEnv ;
@@ -680,7 +680,7 @@ deriveStandalone (L loc (DerivDecl _ deriv_ty mbl_deriv_strat overlap_mode))
bale_out $
text "The last argument of the instance must be a data or newtype application"
}
-deriveStandalone (L _ (XDerivDecl _)) = panic "deriveStandalone"
+deriveStandalone (L _ (XDerivDecl nec)) = noExtCon nec
-- Typecheck the type in a standalone deriving declaration.
--
@@ -716,7 +716,7 @@ tcStandaloneDerivInstType ctxt
= L (getLoc deriv_ty_body) $
HsForAllTy { hst_fvf = ForallInvis
, hst_bndrs = tvs
- , hst_xforall = noExt
+ , hst_xforall = noExtField
, hst_body = rho }}
let (tvs, _theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
pure (tvs, InferContext (Just wc_span), cls, inst_tys)
@@ -725,10 +725,10 @@ tcStandaloneDerivInstType ctxt
let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty
pure (tvs, SupplyContext theta, cls, inst_tys)
-tcStandaloneDerivInstType _ (HsWC _ (XHsImplicitBndrs _))
- = panic "tcStandaloneDerivInstType"
-tcStandaloneDerivInstType _ (XHsWildCardBndrs _)
- = panic "tcStandaloneDerivInstType"
+tcStandaloneDerivInstType _ (HsWC _ (XHsImplicitBndrs nec))
+ = noExtCon nec
+tcStandaloneDerivInstType _ (XHsWildCardBndrs nec)
+ = noExtCon nec
warnUselessTypeable :: TcM ()
warnUselessTypeable
diff --git a/compiler/typecheck/TcEnv.hs b/compiler/typecheck/TcEnv.hs
index f0be9a83ab1d8fecfc954d3e47142eb39487fdd8..533f13738589727c2ce7fc1baab2ccf6a179996d 100644
--- a/compiler/typecheck/TcEnv.hs
+++ b/compiler/typecheck/TcEnv.hs
@@ -706,18 +706,18 @@ tcAddDataFamConPlaceholders inst_decls thing_inside
get_cons (L _ (DataFamInstD { dfid_inst = fid })) = get_fi_cons fid
get_cons (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fids } }))
= concatMap (get_fi_cons . unLoc) fids
- get_cons (L _ (ClsInstD _ (XClsInstDecl _))) = panic "get_cons"
- get_cons (L _ (XInstDecl _)) = panic "get_cons"
+ get_cons (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec
+ get_cons (L _ (XInstDecl nec)) = noExtCon nec
get_fi_cons :: DataFamInstDecl GhcRn -> [Name]
get_fi_cons (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
FamEqn { feqn_rhs = HsDataDefn { dd_cons = cons } }}})
= map unLoc $ concatMap (getConNames . unLoc) cons
get_fi_cons (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
- FamEqn { feqn_rhs = XHsDataDefn _ }}})
- = panic "get_fi_cons"
- get_fi_cons (DataFamInstDecl (HsIB _ (XFamEqn _))) = panic "get_fi_cons"
- get_fi_cons (DataFamInstDecl (XHsImplicitBndrs _)) = panic "get_fi_cons"
+ FamEqn { feqn_rhs = XHsDataDefn nec }}})
+ = noExtCon nec
+ get_fi_cons (DataFamInstDecl (HsIB _ (XFamEqn nec))) = noExtCon nec
+ get_fi_cons (DataFamInstDecl (XHsImplicitBndrs nec)) = noExtCon nec
tcAddPatSynPlaceholders :: [PatSynBind GhcRn GhcRn] -> TcM a -> TcM a
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 891f3ad8c3c5393f36baaf9036d84785089325f3..e8d5ee6baaa106cce190403f494834275bc2cc06 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -211,7 +211,7 @@ tcExpr e@(HsIPVar _ x) res_ty
; ipClass <- tcLookupClass ipClassName
; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty])
; tcWrapResult e
- (fromDict ipClass ip_name ip_ty (HsVar noExt (noLoc ip_var)))
+ (fromDict ipClass ip_name ip_ty (HsVar noExtField (noLoc ip_var)))
ip_ty res_ty }
where
-- Coerces a dictionary for `IP "x" t` into `t`.
@@ -230,7 +230,7 @@ tcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty
; loc <- getSrcSpanM
; var <- emitWantedEvVar origin pred
; tcWrapResult e
- (fromDict pred (HsVar noExt (L loc var)))
+ (fromDict pred (HsVar noExtField (L loc var)))
alpha res_ty } }
where
-- Coerces a dictionary for `IsLabel "x" t` into `t`,
@@ -240,9 +240,9 @@ tcExpr e@(HsOverLabel _ mb_fromLabel l) res_ty
lbl = mkStrLitTy l
applyFromLabel loc fromLabel =
- HsAppType noExt
- (L loc (HsVar noExt (L loc fromLabel)))
- (mkEmptyWildCardBndrs (L loc (HsTyLit noExt (HsStrTy NoSourceText l))))
+ HsAppType noExtField
+ (L loc (HsVar noExtField (L loc fromLabel)))
+ (mkEmptyWildCardBndrs (L loc (HsTyLit noExtField (HsStrTy NoSourceText l))))
tcExpr (HsLam x match) res_ty
= do { (match', wrap) <- tcMatchLambda herald match_ctxt match res_ty
@@ -271,7 +271,7 @@ tcExpr e@(ExprWithTySig _ expr sig_ty) res_ty
; sig_info <- checkNoErrs $ -- Avoid error cascade
tcUserTypeSig loc sig_ty Nothing
; (expr', poly_ty) <- tcExprSig expr sig_info
- ; let expr'' = ExprWithTySig noExt expr' sig_ty
+ ; let expr'' = ExprWithTySig noExtField expr' sig_ty
; tcWrapResult e expr'' poly_ty res_ty }
{-
@@ -361,7 +361,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
; arg2_ty <- readExpType arg2_exp_ty
; op_id <- tcLookupId op_name
; let op' = L loc (mkHsWrap (mkWpTyApps [arg1_ty, arg2_ty])
- (HsVar noExt (L lv op_id)))
+ (HsVar noExtField (L lv op_id)))
; return $ OpApp fix arg1' op' arg2' }
| (L loc (HsVar _ (L lv op_name))) <- op
@@ -399,7 +399,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
; let op' = L loc (mkHsWrap (mkWpTyApps [ getRuntimeRep op_res_ty
, arg2_sigma
, op_res_ty])
- (HsVar noExt (L lv op_id)))
+ (HsVar noExtField (L lv op_id)))
-- arg1' :: arg1_ty
-- wrap_arg1 :: arg1_ty "->" (arg2_sigma -> op_res_ty)
-- op' :: (a2_ty -> op_res_ty) -> a2_ty -> op_res_ty
@@ -413,7 +413,7 @@ tcExpr expr@(OpApp fix arg1 op arg2) res_ty
-- See Note [Disambiguating record fields]
= do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty
; sel_name <- disambiguateSelector lbl sig_tc_ty
- ; let op' = L loc (HsRecFld noExt (Unambiguous sel_name lbl))
+ ; let op' = L loc (HsRecFld noExtField (Unambiguous sel_name lbl))
; tcExpr (OpApp fix arg1 op' arg2) res_ty
}
@@ -636,7 +636,7 @@ tcExpr (HsStatic fvs expr) res_ty
[p_ty]
; let wrap = mkWpTyApps [expr_ty]
; loc <- getSrcSpanM
- ; return $ mkHsWrapCo co $ HsApp noExt
+ ; return $ mkHsWrapCo co $ HsApp noExtField
(L loc $ mkHsWrap wrap fromStaticPtr)
(L loc (HsStatic fvs expr'))
}
@@ -1096,7 +1096,7 @@ wrapHsArgs :: (NoGhcTc (GhcPass id) ~ GhcRn)
wrapHsArgs f [] = f
wrapHsArgs f (HsValArg a : args) = wrapHsArgs (mkHsApp f a) args
wrapHsArgs f (HsTypeArg _ t : args) = wrapHsArgs (mkHsAppType f t) args
-wrapHsArgs f (HsArgPar sp : args) = wrapHsArgs (L sp $ HsPar noExt f) args
+wrapHsArgs f (HsArgPar sp : args) = wrapHsArgs (L sp $ HsPar noExtField f) args
isHsValArg :: HsArg tm ty -> Bool
isHsValArg (HsValArg {}) = True
@@ -1164,7 +1164,7 @@ tcApp m_herald fun@(L loc (HsVar _ (L _ fun_id))) args res_ty
; let [alpha, beta] = mkTemplateTyVars [liftedTypeKind, tYPE rep]
seq_ty = mkSpecForAllTys [alpha,beta]
(mkTyVarTy alpha `mkVisFunTy` mkTyVarTy beta `mkVisFunTy` mkTyVarTy beta)
- seq_fun = L loc (HsVar noExt (L loc seqId))
+ seq_fun = L loc (HsVar noExtField (L loc seqId))
-- seq_ty = forall (a:*) (b:TYPE r). a -> b -> b
-- where 'r' is a meta type variable
; tcFunApp m_herald fun seq_fun seq_ty args res_ty }
@@ -1419,7 +1419,7 @@ tcTupArgs args tys
go (L l (Missing {}), arg_ty) = return (L l (Missing arg_ty))
go (L l (Present x expr), arg_ty) = do { expr' <- tcPolyExpr expr arg_ty
; return (L l (Present x expr')) }
- go (L _ (XTupArg{}), _) = panic "tcTupArgs"
+ go (L _ (XTupArg nec), _) = noExtCon nec
---------------------------
-- See TcType.SyntaxOpType also for commentary
@@ -1721,14 +1721,14 @@ tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTcId)
tcCheckId name res_ty
= do { (expr, actual_res_ty) <- tcInferId name
; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty])
- ; addFunResCtxt False (HsVar noExt (noLoc name)) actual_res_ty res_ty $
- tcWrapResultO (OccurrenceOf name) (HsVar noExt (noLoc name)) expr
+ ; addFunResCtxt False (HsVar noExtField (noLoc name)) actual_res_ty res_ty $
+ tcWrapResultO (OccurrenceOf name) (HsVar noExtField (noLoc name)) expr
actual_res_ty res_ty }
tcCheckRecSelId :: HsExpr GhcRn -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
tcCheckRecSelId rn_expr f@(Unambiguous _ (L _ lbl)) res_ty
= do { (expr, actual_res_ty) <- tcInferRecSelId f
- ; addFunResCtxt False (HsRecFld noExt f) actual_res_ty res_ty $
+ ; addFunResCtxt False (HsRecFld noExtField f) actual_res_ty res_ty $
tcWrapResultO (OccurrenceOfRecSel lbl) rn_expr expr actual_res_ty res_ty }
tcCheckRecSelId rn_expr (Ambiguous _ lbl) res_ty
= case tcSplitFunTy_maybe =<< checkingExpType_maybe res_ty of
@@ -1736,7 +1736,7 @@ tcCheckRecSelId rn_expr (Ambiguous _ lbl) res_ty
Just (arg, _) -> do { sel_name <- disambiguateSelector lbl arg
; tcCheckRecSelId rn_expr (Unambiguous sel_name lbl)
res_ty }
-tcCheckRecSelId _ (XAmbiguousFieldOcc _) _ = panic "tcCheckRecSelId"
+tcCheckRecSelId _ (XAmbiguousFieldOcc nec) _ = noExtCon nec
------------------------
tcInferRecSelId :: AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTcId, TcRhoType)
@@ -1745,7 +1745,7 @@ tcInferRecSelId (Unambiguous sel (L _ lbl))
; return (expr', ty) }
tcInferRecSelId (Ambiguous _ lbl)
= ambiguousSelector lbl
-tcInferRecSelId (XAmbiguousFieldOcc _) = panic "tcInferRecSelId"
+tcInferRecSelId (XAmbiguousFieldOcc nec) = noExtCon nec
------------------------
tcInferId :: Name -> TcM (HsExpr GhcTcId, TcSigmaType)
@@ -1774,7 +1774,7 @@ tc_infer_assert assert_name
= do { assert_error_id <- tcLookupId assertErrorName
; (wrap, id_rho) <- topInstantiate (OccurrenceOf assert_name)
(idType assert_error_id)
- ; return (mkHsWrap wrap (HsVar noExt (noLoc assert_error_id)), id_rho)
+ ; return (mkHsWrap wrap (HsVar noExtField (noLoc assert_error_id)), id_rho)
}
tc_infer_id :: RdrName -> Name -> TcM (HsExpr GhcTcId, TcSigmaType)
@@ -1800,12 +1800,12 @@ tc_infer_id lbl id_name
_ -> failWithTc $
ppr thing <+> text "used where a value identifier was expected" }
where
- return_id id = return (HsVar noExt (noLoc id), idType id)
+ return_id id = return (HsVar noExtField (noLoc id), idType id)
return_data_con con
-- For data constructors, must perform the stupid-theta check
| null stupid_theta
- = return (HsConLikeOut noExt (RealDataCon con), con_ty)
+ = return (HsConLikeOut noExtField (RealDataCon con), con_ty)
| otherwise
-- See Note [Instantiating stupid theta]
@@ -1816,7 +1816,7 @@ tc_infer_id lbl id_name
rho' = substTy subst rho
; wrap <- instCall (OccurrenceOf id_name) tys' theta'
; addDataConStupidTheta con tys'
- ; return ( mkHsWrap wrap (HsConLikeOut noExt (RealDataCon con))
+ ; return ( mkHsWrap wrap (HsConLikeOut noExtField (RealDataCon con))
, rho') }
where
@@ -1844,8 +1844,8 @@ tcUnboundId rn_expr unbound res_ty
; let ev = mkLocalId name ty
; can <- newHoleCt (ExprHole unbound) ev ty
; emitInsoluble can
- ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar noExt (noLoc ev))
- ty res_ty }
+ ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar noExtField (noLoc ev))
+ ty res_ty }
{-
@@ -1941,7 +1941,7 @@ tcTagToEnum loc fun_name args res_ty
(mk_error ty' doc2)
; arg' <- tcMonoExpr arg (mkCheckExpType intPrimTy)
- ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar noExt (L loc fun)))
+ ; let fun' = L loc (mkHsWrap (WpTyApp rep_ty) (HsVar noExtField (L loc fun)))
rep_ty = mkTyConApp rep_tc rep_args
out_args = concat
[ pars1
@@ -1970,7 +1970,7 @@ too_many_args fun args
where
pp (HsValArg e) = ppr e
pp (HsTypeArg _ (HsWC { hswc_body = L _ t })) = pprHsType t
- pp (HsTypeArg _ (XHsWildCardBndrs _)) = panic "too_many_args"
+ pp (HsTypeArg _ (XHsWildCardBndrs nec)) = noExtCon nec
pp (HsArgPar _) = empty
@@ -2030,7 +2030,7 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var))
; lift <- if isStringTy id_ty then
do { sid <- tcLookupId THNames.liftStringName
-- See Note [Lifting strings]
- ; return (HsVar noExt (noLoc sid)) }
+ ; return (HsVar noExtField (noLoc sid)) }
else
setConstraintVar lie_var $
-- Put the 'lift' constraint into the right LIE
@@ -2446,7 +2446,7 @@ tcRecordField con_like flds_w_tys (L loc (FieldOcc sel_name lbl)) rhs
; return Nothing }
where
field_lbl = occNameFS $ rdrNameOcc (unLoc lbl)
-tcRecordField _ _ (L _ (XFieldOcc _)) _ = panic "tcRecordField"
+tcRecordField _ _ (L _ (XFieldOcc nec)) _ = noExtCon nec
checkMissingFields :: ConLike -> HsRecordBinds GhcRn -> TcM ()
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index b02494b634aa6621edcf591098e4096937457cc5..2ed1483fab7de3d4b1154906bb5ccb800c1867e7 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -448,7 +448,7 @@ gen_Ord_binds loc tycon = do
, mkHsCaseAlt nlWildPat (gtResult op) ]
where
tag = get_tag data_con
- tag_lit = noLoc (HsLit noExt (HsIntPrim NoSourceText (toInteger tag)))
+ tag_lit = noLoc (HsLit noExtField (HsIntPrim NoSourceText (toInteger tag)))
mkInnerEqAlt :: OrdOp -> DataCon -> LMatch GhcPs (LHsExpr GhcPs)
-- First argument 'a' known to be built with K
@@ -615,7 +615,7 @@ gen_Enum_binds loc tycon = do
(nlHsApp (nlHsVar (tag2con_RDR dflags tycon))
(nlHsApps plus_RDR
[ nlHsVarApps intDataCon_RDR [ah_RDR]
- , nlHsLit (HsInt noExt
+ , nlHsLit (HsInt noExtField
(mkIntegralLit (-1 :: Int)))]))
to_enum dflags
@@ -776,7 +776,7 @@ gen_Ix_binds loc tycon = do
enum_index dflags
= mk_easy_FunBind loc unsafeIndex_RDR
- [noLoc (AsPat noExt (noLoc c_RDR)
+ [noLoc (AsPat noExtField (noLoc c_RDR)
(nlTuplePat [a_Pat, nlWildPat] Boxed)),
d_Pat] (
untag_Expr dflags tycon [(a_RDR, ah_RDR)] (
@@ -1148,7 +1148,7 @@ gen_Show_binds get_fixity loc tycon
| otherwise =
([a_Pat, con_pat],
showParen_Expr (genOpApp a_Expr ge_RDR (nlHsLit
- (HsInt noExt (mkIntegralLit con_prec_plus_one))))
+ (HsInt noExtField (mkIntegralLit con_prec_plus_one))))
(nlHsPar (nested_compose_Expr show_thingies)))
where
data_con_RDR = getRdrName data_con
@@ -1241,7 +1241,7 @@ mk_showString_app str = nlHsApp (nlHsVar showString_RDR) (nlHsLit (mkHsString st
-- | showsPrec :: Show a => Int -> a -> ShowS
mk_showsPrec_app :: Integer -> LHsExpr GhcPs -> LHsExpr GhcPs
mk_showsPrec_app p x
- = nlHsApps showsPrec_RDR [nlHsLit (HsInt noExt (mkIntegralLit p)), x]
+ = nlHsApps showsPrec_RDR [nlHsLit (HsInt noExtField (mkIntegralLit p)), x]
-- | shows :: Show a => a -> ShowS
mk_shows_app :: LHsExpr GhcPs -> LHsExpr GhcPs
@@ -1338,7 +1338,7 @@ gen_data dflags data_type_name constr_names loc rep_tc
genDataTyCon :: DerivStuff
genDataTyCon -- $dT
= DerivHsBind (mkHsVarBind loc data_type_name rhs,
- L loc (TypeSig noExt [L loc data_type_name] sig_ty))
+ L loc (TypeSig noExtField [L loc data_type_name] sig_ty))
sig_ty = mkLHsSigWcType (nlHsTyVar dataType_RDR)
rhs = nlHsVar mkDataType_RDR
@@ -1348,7 +1348,7 @@ gen_data dflags data_type_name constr_names loc rep_tc
genDataDataCon :: DataCon -> RdrName -> DerivStuff
genDataDataCon dc constr_name -- $cT1 etc
= DerivHsBind (mkHsVarBind loc constr_name rhs,
- L loc (TypeSig noExt [L loc constr_name] sig_ty))
+ L loc (TypeSig noExtField [L loc constr_name] sig_ty))
where
sig_ty = mkLHsSigWcType (nlHsTyVar constr_RDR)
rhs = nlHsApps mkConstr_RDR constr_args
@@ -1573,8 +1573,8 @@ gen_Lift_binds loc tycon = (listToBag [lift_bind, liftTyped_bind], emptyBag)
liftTyped_bind = mkFunBindEC 1 loc liftTyped_RDR (nlHsApp pure_Expr)
(map (pats_etc mk_texp) data_cons)
- mk_exp = ExpBr NoExt
- mk_texp = TExpBr NoExt
+ mk_exp = ExpBr noExtField
+ mk_texp = TExpBr noExtField
data_cons = tyConDataCons tycon
pats_etc mk_bracket data_con
@@ -1584,7 +1584,7 @@ gen_Lift_binds loc tycon = (listToBag [lift_bind, liftTyped_bind], emptyBag)
data_con_RDR = getRdrName data_con
con_arity = dataConSourceArity data_con
as_needed = take con_arity as_RDRs
- lift_Expr = noLoc (HsBracket NoExt (mk_bracket br_body))
+ lift_Expr = noLoc (HsBracket noExtField (mk_bracket br_body))
br_body = nlHsApps (Exact (dataConName data_con))
(map nlHsVar as_needed)
@@ -1861,12 +1861,12 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty
underlying_inst_tys = changeLast inst_tys rhs_ty
nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
-nlHsAppType e s = noLoc (HsAppType noExt e hs_ty)
+nlHsAppType e s = noLoc (HsAppType noExtField e hs_ty)
where
hs_ty = mkHsWildCardBndrs $ parenthesizeHsType appPrec (typeToLHsType s)
nlExprWithTySig :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
-nlExprWithTySig e s = noLoc $ ExprWithTySig noExt (parenthesizeHsExpr sigPrec e) hs_ty
+nlExprWithTySig e s = noLoc $ ExprWithTySig noExtField (parenthesizeHsExpr sigPrec e) hs_ty
where
hs_ty = mkLHsSigWcType (typeToLHsType s)
@@ -1916,7 +1916,7 @@ genAuxBindSpec :: DynFlags -> SrcSpan -> AuxBindSpec
-> (LHsBind GhcPs, LSig GhcPs)
genAuxBindSpec dflags loc (DerivCon2Tag tycon)
= (mkFunBindSE 0 loc rdr_name eqns,
- L loc (TypeSig noExt [L loc rdr_name] sig_ty))
+ L loc (TypeSig noExtField [L loc rdr_name] sig_ty))
where
rdr_name = con2tag_RDR dflags tycon
@@ -1942,7 +1942,7 @@ genAuxBindSpec dflags loc (DerivTag2Con tycon)
= (mkFunBindSE 0 loc rdr_name
[([nlConVarPat intDataCon_RDR [a_RDR]],
nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)],
- L loc (TypeSig noExt [L loc rdr_name] sig_ty))
+ L loc (TypeSig noExtField [L loc rdr_name] sig_ty))
where
sig_ty = mkLHsSigWcType $ L loc $
XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $
@@ -1952,7 +1952,7 @@ genAuxBindSpec dflags loc (DerivTag2Con tycon)
genAuxBindSpec dflags loc (DerivMaxTag tycon)
= (mkHsVarBind loc rdr_name rhs,
- L loc (TypeSig noExt [L loc rdr_name] sig_ty))
+ L loc (TypeSig noExtField [L loc rdr_name] sig_ty))
where
rdr_name = maxtag_RDR dflags tycon
sig_ty = mkLHsSigWcType (L loc (XHsType (NHsCoreTy intTy)))
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 52783e72102474f68183abe8ff2d33bf2a46118f..7dbd4d9fee4ce761b5f115ab820428c6d005ff40 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -135,15 +135,15 @@ hsLitType (HsInteger _ _ ty) = ty
hsLitType (HsRat _ _ ty) = ty
hsLitType (HsFloatPrim _ _) = floatPrimTy
hsLitType (HsDoublePrim _ _) = doublePrimTy
-hsLitType (XLit p) = pprPanic "hsLitType" (ppr p)
+hsLitType (XLit nec) = noExtCon nec
-- Overloaded literals. Here mainly because it uses isIntTy etc
shortCutLit :: DynFlags -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)
shortCutLit dflags (HsIntegral int@(IL src neg i)) ty
- | isIntTy ty && inIntRange dflags i = Just (HsLit noExt (HsInt noExt int))
+ | isIntTy ty && inIntRange dflags i = Just (HsLit noExtField (HsInt noExtField int))
| isWordTy ty && inWordRange dflags i = Just (mkLit wordDataCon (HsWordPrim src i))
- | isIntegerTy ty = Just (HsLit noExt (HsInteger src i ty))
+ | isIntegerTy ty = Just (HsLit noExtField (HsInteger src i ty))
| otherwise = shortCutLit dflags (HsFractional (integralFractionalLit neg i)) ty
-- The 'otherwise' case is important
-- Consider (3 :: Float). Syntactically it looks like an IntLit,
@@ -152,16 +152,16 @@ shortCutLit dflags (HsIntegral int@(IL src neg i)) ty
-- literals, compiled without -O
shortCutLit _ (HsFractional f) ty
- | isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim noExt f))
- | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim noExt f))
+ | isFloatTy ty = Just (mkLit floatDataCon (HsFloatPrim noExtField f))
+ | isDoubleTy ty = Just (mkLit doubleDataCon (HsDoublePrim noExtField f))
| otherwise = Nothing
shortCutLit _ (HsIsString src s) ty
- | isStringTy ty = Just (HsLit noExt (HsString src s))
+ | isStringTy ty = Just (HsLit noExtField (HsString src s))
| otherwise = Nothing
mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc
-mkLit con lit = HsApp noExt (nlHsDataCon con) (nlHsLit lit)
+mkLit con lit = HsApp noExtField (nlHsDataCon con) (nlHsLit lit)
------------------------------
hsOverLitName :: OverLitVal -> Name
@@ -389,7 +389,7 @@ zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids
zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)
zonkFieldOcc env (FieldOcc sel lbl)
= fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel
-zonkFieldOcc _ (XFieldOcc _) = panic "zonkFieldOcc"
+zonkFieldOcc _ (XFieldOcc nec) = noExtCon nec
zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var])
zonkEvBndrsX = mapAccumLM zonkEvBndrX
@@ -532,12 +532,12 @@ zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do
= do n' <- mapIPNameTc (zonkIdBndr env) n
e' <- zonkLExpr env e
return (IPBind x n' e')
- zonk_ip_bind (XIPBind _) = panic "zonkLocalBinds : XCIPBind"
+ zonk_ip_bind (XIPBind nec) = noExtCon nec
-zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds _))
- = panic "zonkLocalBinds" -- Not in typechecker output
-zonkLocalBinds _ (XHsLocalBindsLR _)
- = panic "zonkLocalBinds" -- Not in typechecker output
+zonkLocalBinds _ (HsIPBinds _ (XHsIPBinds nec))
+ = noExtCon nec
+zonkLocalBinds _ (XHsLocalBindsLR nec)
+ = noExtCon nec
---------------------------------------------
zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (ZonkEnv, LHsBinds GhcTc)
@@ -597,7 +597,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds
; new_exports <- mapM (zonk_export env3) exports
; return (new_val_binds, new_exports) }
- ; return (AbsBinds { abs_ext = noExt
+ ; return (AbsBinds { abs_ext = noExtField
, abs_tvs = new_tyvars, abs_ev_vars = new_evs
, abs_ev_binds = new_ev_binds
, abs_exports = new_exports, abs_binds = new_val_bind
@@ -633,7 +633,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
, abe_poly = new_poly_id
, abe_mono = zonkIdOcc env mono_id
, abe_prags = new_prags })
- zonk_export _ (XABExport _) = panic "zonk_bind: XABExport"
+ zonk_export _ (XABExport nec) = noExtCon nec
zonk_bind env (PatSynBind x bind@(PSB { psb_id = (dL->L loc id)
, psb_args = details
@@ -649,8 +649,8 @@ zonk_bind env (PatSynBind x bind@(PSB { psb_id = (dL->L loc id)
, psb_def = lpat'
, psb_dir = dir' } }
-zonk_bind _ (PatSynBind _ (XPatSynBind _)) = panic "zonk_bind"
-zonk_bind _ (XHsBindsLR _) = panic "zonk_bind"
+zonk_bind _ (PatSynBind _ (XPatSynBind nec)) = noExtCon nec
+zonk_bind _ (XHsBindsLR nec) = noExtCon nec
zonkPatSynDetails :: ZonkEnv
-> HsPatSynDetails (Located TcId)
@@ -704,7 +704,7 @@ zonkMatchGroup env zBody (MG { mg_alts = (dL->L l ms)
; return (MG { mg_alts = cL l ms'
, mg_ext = MatchGroupTc arg_tys' res_ty'
, mg_origin = origin }) }
-zonkMatchGroup _ _ (XMatchGroup {}) = panic "zonkMatchGroup"
+zonkMatchGroup _ _ (XMatchGroup nec) = noExtCon nec
zonkMatch :: ZonkEnv
-> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
@@ -715,7 +715,7 @@ zonkMatch env zBody (dL->L loc match@(Match { m_pats = pats
= do { (env1, new_pats) <- zonkPats env pats
; new_grhss <- zonkGRHSs env1 zBody grhss
; return (cL loc (match { m_pats = new_pats, m_grhss = new_grhss })) }
-zonkMatch _ _ (dL->L _ (XMatch _)) = panic "zonkMatch"
+zonkMatch _ _ (dL->L _ (XMatch nec)) = noExtCon nec
zonkMatch _ _ _ = panic "zonkMatch: Impossible Match"
-- due to #15884
@@ -732,10 +732,10 @@ zonkGRHSs env zBody (GRHSs x grhss (dL->L l binds)) = do
= do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded
new_rhs <- zBody env2 rhs
return (GRHS xx new_guarded new_rhs)
- zonk_grhs (XGRHS _) = panic "zonkGRHSs"
+ zonk_grhs (XGRHS nec) = noExtCon nec
new_grhss <- mapM (wrapLocM zonk_grhs) grhss
return (GRHSs x new_grhss (cL l new_binds))
-zonkGRHSs _ _ (XGRHSs _) = panic "zonkGRHSs"
+zonkGRHSs _ _ (XGRHSs nec) = noExtCon nec
{-
************************************************************************
@@ -841,7 +841,7 @@ zonkExpr env (ExplicitTuple x tup_args boxed)
; return (cL l (Present x e')) }
zonk_tup_arg (dL->L l (Missing t)) = do { t' <- zonkTcTypeToTypeX env t
; return (cL l (Missing t')) }
- zonk_tup_arg (dL->L _ (XTupArg{})) = panic "zonkExpr.XTupArg"
+ zonk_tup_arg (dL->L _ (XTupArg nec)) = noExtCon nec
zonk_tup_arg _ = panic "zonk_tup_arg: Impossible Match"
-- due to #15884
@@ -877,7 +877,7 @@ zonkExpr env (HsMultiIf ty alts)
= do { (env', guard') <- zonkStmts env zonkLExpr guard
; expr' <- zonkLExpr env' expr
; return $ GRHS x guard' expr' }
- zonk_alt (XGRHS _) = panic "zonkExpr.HsMultiIf"
+ zonk_alt (XGRHS nec) = noExtCon nec
zonkExpr env (HsLet x (dL->L l binds) expr)
= do (new_env, new_binds) <- zonkLocalBinds env binds
@@ -921,7 +921,7 @@ zonkExpr env (RecordUpd { rupd_flds = rbinds
zonkExpr env (ExprWithTySig _ e ty)
= do { e' <- zonkLExpr env e
- ; return (ExprWithTySig noExt e' ty) }
+ ; return (ExprWithTySig noExtField e' ty) }
zonkExpr env (ArithSeq expr wit info)
= do (env1, new_wit) <- zonkWit env wit
@@ -1057,7 +1057,7 @@ zonkCmd env (HsCmdDo ty (dL->L l stmts))
new_ty <- zonkTcTypeToTypeX env ty
return (HsCmdDo new_ty (cL l new_stmts))
-zonkCmd _ (XCmd{}) = panic "zonkCmd"
+zonkCmd _ (XCmd nec) = noExtCon nec
@@ -1077,7 +1077,7 @@ zonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd)
-- rules for arrows
return (HsCmdTop (CmdTopTc new_stack_tys new_ty new_ids) new_cmd)
-zonk_cmd_top _ (XCmdTop {}) = panic "zonk_cmd_top"
+zonk_cmd_top _ (XCmdTop nec) = noExtCon nec
-------------------------------------------------------------------------
zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper)
@@ -1110,7 +1110,7 @@ zonkOverLit env lit@(OverLit {ol_ext = OverLitTc r ty, ol_witness = e })
; e' <- zonkExpr env e
; return (lit { ol_witness = e', ol_ext = OverLitTc r ty' }) }
-zonkOverLit _ XOverLit{} = panic "zonkOverLit"
+zonkOverLit _ (XOverLit nec) = noExtCon nec
-------------------------------------------------------------------------
zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTcId -> TcM (ArithSeqInfo GhcTc)
@@ -1166,7 +1166,7 @@ zonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op)
; (env3, new_return) <- zonkSyntaxExpr env2 return_op
; return (ParStmtBlock x new_stmts (zonkIdOccs env3 bndrs)
new_return) }
- zonk_branch _ (XParStmtBlock{}) = panic "zonkStmt"
+ zonk_branch _ (XParStmtBlock nec) = noExtCon nec
zonkStmt env zBody (RecStmt { recS_stmts = segStmts, recS_later_ids = lvs, recS_rec_ids = rvs
, recS_ret_fn = ret_id, recS_mfix_fn = mfix_id
@@ -1264,13 +1264,13 @@ zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join)
get_pat (_, ApplicativeArgOne _ pat _ _) = pat
get_pat (_, ApplicativeArgMany _ _ _ pat) = pat
- get_pat (_, XApplicativeArg _) = panic "zonkStmt"
+ get_pat (_, XApplicativeArg nec) = noExtCon nec
replace_pat pat (op, ApplicativeArgOne x _ a isBody)
= (op, ApplicativeArgOne x pat a isBody)
replace_pat pat (op, ApplicativeArgMany x a b _)
= (op, ApplicativeArgMany x a b pat)
- replace_pat _ (_, XApplicativeArg _) = panic "zonkStmt"
+ replace_pat _ (_, XApplicativeArg nec) = noExtCon nec
zonk_args env args
= do { (env1, new_args_rev) <- zonk_args_rev env (reverse args)
@@ -1294,9 +1294,9 @@ zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join)
= do { (env1, new_stmts) <- zonkStmts env zonkLExpr stmts
; new_ret <- zonkExpr env1 ret
; return (ApplicativeArgMany x new_stmts new_ret pat) }
- zonk_arg _ (XApplicativeArg _) = panic "zonkStmt.XApplicativeArg"
+ zonk_arg _ (XApplicativeArg nec) = noExtCon nec
-zonkStmt _ _ (XStmtLR _) = panic "zonkStmt"
+zonkStmt _ _ (XStmtLR nec) = noExtCon nec
-------------------------------------------------------------------------
zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTcId -> TcM (HsRecordBinds GhcTcId)
@@ -1540,7 +1540,7 @@ zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-}
= do { (env', v') <- zonk_it env v
; return (env', cL l (RuleBndr x (cL loc v'))) }
zonk_tm_bndr _ (dL->L _ (RuleBndrSig {})) = panic "zonk_tm_bndr RuleBndrSig"
- zonk_tm_bndr _ (dL->L _ (XRuleBndr {})) = panic "zonk_tm_bndr XRuleBndr"
+ zonk_tm_bndr _ (dL->L _ (XRuleBndr nec)) = noExtCon nec
zonk_tm_bndr _ _ = panic "zonk_tm_bndr: Impossible Match"
-- due to #15884
@@ -1552,7 +1552,7 @@ zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-}
-- DV: used to be return (env,v) but that is plain
-- wrong because we may need to go inside the kind
-- of v and zonk there!
-zonkRule _ (XRuleDecl _) = panic "zonkRule"
+zonkRule _ (XRuleDecl nec) = noExtCon nec
{-
************************************************************************
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index a7e3cf7945fd7f76b7856a2f06ac84b999511609..c81956d8a71006c19ef727693a2849247ca4fff6 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -271,7 +271,7 @@ tc_hs_sig_type skol_info hs_sig_type ctxt_kind
; return (insolubleWC wanted, mkInvForAllTys kvs ty1) }
-tc_hs_sig_type _ (XHsImplicitBndrs _) _ = panic "tc_hs_sig_type"
+tc_hs_sig_type _ (XHsImplicitBndrs nec) _ = noExtCon nec
tcTopLHsType :: LHsSigType GhcRn -> ContextKind -> TcM Type
-- tcTopLHsType is used for kind-checking top-level HsType where
@@ -296,7 +296,7 @@ tcTopLHsType hs_sig_type ctxt_kind
; traceTc "End tcTopLHsType }" (vcat [ppr hs_ty, ppr final_ty])
; return final_ty}
-tcTopLHsType (XHsImplicitBndrs _) _ = panic "tcTopLHsType"
+tcTopLHsType (XHsImplicitBndrs nec) _ = noExtCon nec
-----------------
tcHsDeriv :: LHsSigType GhcRn -> TcM ([TyVar], (Class, [Type], [Kind]))
@@ -398,7 +398,7 @@ tcHsTypeApp wc_ty kind
; ty <- zonkPromoteType ty
; checkValidType TypeAppCtxt ty
; return ty }
-tcHsTypeApp (XHsWildCardBndrs _) _ = panic "tcHsTypeApp"
+tcHsTypeApp (XHsWildCardBndrs nec) _ = noExtCon nec
{- Note [Wildcards in visible type application]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -841,12 +841,12 @@ tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of
; res_k <- newOpenTypeKind
; ty1' <- tc_lhs_type mode ty1 arg_k
; ty2' <- tc_lhs_type mode ty2 res_k
- ; checkExpectedKind (HsFunTy noExt ty1 ty2) (mkVisFunTy ty1' ty2')
+ ; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2')
liftedTypeKind exp_kind }
KindLevel -> -- no representation polymorphism in kinds. yet.
do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind
; ty2' <- tc_lhs_type mode ty2 liftedTypeKind
- ; checkExpectedKind (HsFunTy noExt ty1 ty2) (mkVisFunTy ty1' ty2')
+ ; checkExpectedKind (HsFunTy noExtField ty1 ty2) (mkVisFunTy ty1' ty2')
liftedTypeKind exp_kind }
---------------------------
@@ -980,7 +980,7 @@ splitHsAppTys hs_ty
go (L _ (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as)
go (L sp (HsParTy _ f)) as = go f (HsArgPar sp : as)
go (L _ (HsOpTy _ l op@(L sp _) r)) as
- = ( L sp (HsTyVar noExt NotPromoted op)
+ = ( L sp (HsTyVar noExtField NotPromoted op)
, HsValArg l : HsValArg r : as )
go f as = (f, as)
@@ -1870,7 +1870,7 @@ kcLHsQTyVars_Cusk name flav
ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind
| otherwise = AnyKind
-kcLHsQTyVars_Cusk _ _ (XLHsQTyVars _) _ = panic "kcLHsQTyVars"
+kcLHsQTyVars_Cusk _ _ (XLHsQTyVars nec) _ = noExtCon nec
------------------------------
kcLHsQTyVars_NonCusk name flav
@@ -1918,7 +1918,7 @@ kcLHsQTyVars_NonCusk name flav
ctxt_kind | tcFlavourIsOpen flav = TheKind liftedTypeKind
| otherwise = AnyKind
-kcLHsQTyVars_NonCusk _ _ (XLHsQTyVars _) _ = panic "kcLHsQTyVars"
+kcLHsQTyVars_NonCusk _ _ (XLHsQTyVars nec) _ = noExtCon nec
{- Note [No polymorphic recursion]
@@ -2161,7 +2161,7 @@ tcHsTyVarBndr new_tv (UserTyVar _ (L _ tv_nm))
tcHsTyVarBndr new_tv (KindedTyVar _ (L _ tv_nm) lhs_kind)
= do { kind <- tcLHsKindSig (TyVarBndrKindCtxt tv_nm) lhs_kind
; new_tv tv_nm kind }
-tcHsTyVarBndr _ (XTyVarBndr _) = panic "tcHsTyVarBndr"
+tcHsTyVarBndr _ (XTyVarBndr nec) = noExtCon nec
-----------------
tcHsQTyVarBndr :: ContextKind
@@ -2191,10 +2191,10 @@ tcHsQTyVarBndr _ new_tv (KindedTyVar _ (L _ tv_nm) lhs_kind)
_ -> new_tv tv_nm kind }
where
- hs_tv = HsTyVar noExt NotPromoted (noLoc tv_nm)
+ hs_tv = HsTyVar noExtField NotPromoted (noLoc tv_nm)
-- Used for error messages only
-tcHsQTyVarBndr _ _ (XTyVarBndr _) = panic "tcHsTyVarBndr"
+tcHsQTyVarBndr _ _ (XTyVarBndr nec) = noExtCon nec
--------------------------------------
@@ -2630,8 +2630,8 @@ tcHsPartialSigType ctxt sig_ty
; traceTc "tcHsPartialSigType" (ppr tv_prs)
; return (wcs, wcx, tv_prs, theta, tau) }
-tcHsPartialSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic "tcHsPartialSigType"
-tcHsPartialSigType _ (XHsWildCardBndrs _) = panic "tcHsPartialSigType"
+tcHsPartialSigType _ (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
+tcHsPartialSigType _ (XHsWildCardBndrs nec) = noExtCon nec
tcPartialContext :: HsContext GhcRn -> TcM (TcThetaType, Maybe TcType)
tcPartialContext hs_theta
@@ -2770,8 +2770,8 @@ tcHsPatSigType ctxt sig_ty
-- NB: tv's Name may be fresh (in the case of newPatSigTyVar)
; return (name, tv) }
-tcHsPatSigType _ (HsWC _ (XHsImplicitBndrs _)) = panic "tcHsPatSigType"
-tcHsPatSigType _ (XHsWildCardBndrs _) = panic "tcHsPatSigType"
+tcHsPatSigType _ (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
+tcHsPatSigType _ (XHsWildCardBndrs nec) = noExtCon nec
tcPatSig :: Bool -- True <=> pattern binding
-> LHsSigWcType GhcRn
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index 716acb69428fbf9355b15c48ee21802f12c97b01..6d63054e641f52410637bbe14e35d750b53db32b 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -458,7 +458,7 @@ tcLocalInstDecl (L loc (ClsInstD { cid_inst = decl }))
= do { (insts, fam_insts, deriv_infos) <- tcClsInstDecl (L loc decl)
; return (insts, fam_insts, deriv_infos) }
-tcLocalInstDecl (L _ (XInstDecl _)) = panic "tcLocalInstDecl"
+tcLocalInstDecl (L _ (XInstDecl nec)) = noExtCon nec
tcClsInstDecl :: LClsInstDecl GhcRn
-> TcM ([InstInfo GhcRn], [FamInst], [DerivInfo])
@@ -535,7 +535,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds
. dfid_eqn
. unLoc) adts)
-tcClsInstDecl (L _ (XClsInstDecl _)) = panic "tcClsInstDecl"
+tcClsInstDecl (L _ (XClsInstDecl nec)) = noExtCon nec
{-
************************************************************************
@@ -1091,14 +1091,14 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
-- con_app_scs = MkD ty1 ty2 sc1 sc2
-- con_app_args = MkD ty1 ty2 sc1 sc2 op1 op2
con_app_tys = mkHsWrap (mkWpTyApps inst_tys)
- (HsConLikeOut noExt (RealDataCon dict_constr))
+ (HsConLikeOut noExtField (RealDataCon dict_constr))
-- NB: We *can* have covars in inst_tys, in the case of
-- promoted GADT constructors.
con_app_args = foldl' app_to_meth con_app_tys sc_meth_ids
app_to_meth :: HsExpr GhcTc -> Id -> HsExpr GhcTc
- app_to_meth fun meth_id = HsApp noExt (L loc fun)
+ app_to_meth fun meth_id = HsApp noExtField (L loc fun)
(L loc (wrapId arg_wrapper meth_id))
inst_tv_tys = mkTyVarTys inst_tyvars
@@ -1112,13 +1112,13 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
-- Newtype dfuns just inline unconditionally,
-- so don't attempt to specialise them
- export = ABE { abe_ext = noExt
+ export = ABE { abe_ext = noExtField
, abe_wrap = idHsWrapper
, abe_poly = dfun_id_w_prags
, abe_mono = self_dict
, abe_prags = dfun_spec_prags }
-- NB: see Note [SPECIALISE instance pragmas]
- main_bind = AbsBinds { abs_ext = noExt
+ main_bind = AbsBinds { abs_ext = noExtField
, abs_tvs = inst_tyvars
, abs_ev_vars = dfun_ev_vars
, abs_exports = [export]
@@ -1165,7 +1165,7 @@ addDFunPrags dfun_id sc_meth_ids
is_newtype = isNewTyCon clas_tc
wrapId :: HsWrapper -> IdP (GhcPass id) -> HsExpr (GhcPass id)
-wrapId wrapper id = mkHsWrap wrapper (HsVar noExt (noLoc id))
+wrapId wrapper id = mkHsWrap wrapper (HsVar noExtField (noLoc id))
{- Note [Typechecking plan for instance declarations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1264,13 +1264,13 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds sc_theta
; let sc_top_ty = mkInvForAllTys tyvars $
mkPhiTy (map idType dfun_evs) sc_pred
sc_top_id = mkLocalId sc_top_name sc_top_ty
- export = ABE { abe_ext = noExt
+ export = ABE { abe_ext = noExtField
, abe_wrap = idHsWrapper
, abe_poly = sc_top_id
, abe_mono = sc_ev_id
, abe_prags = noSpecPrags }
local_ev_binds = TcEvBinds ev_binds_var
- bind = AbsBinds { abs_ext = noExt
+ bind = AbsBinds { abs_ext = noExtField
, abs_tvs = tyvars
, abs_ev_vars = dfun_evs
, abs_exports = [export]
@@ -1563,12 +1563,12 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys
mkLHsWrap lam_wrapper (error_rhs dflags)
; return (meth_id, meth_bind, Nothing) }
where
- error_rhs dflags = L inst_loc $ HsApp noExt error_fun (error_msg dflags)
+ error_rhs dflags = L inst_loc $ HsApp noExtField error_fun (error_msg dflags)
error_fun = L inst_loc $
wrapId (mkWpTyApps
[ getRuntimeRep meth_tau, meth_tau])
nO_METHOD_BINDING_ERROR_ID
- error_msg dflags = L inst_loc (HsLit noExt (HsStringPrim NoSourceText
+ error_msg dflags = L inst_loc (HsLit noExtField (HsStringPrim NoSourceText
(unsafeMkByteString (error_string dflags))))
meth_tau = funResultTy (piResultTys (idType sel_id) inst_tys)
error_string dflags = showSDoc dflags
@@ -1696,14 +1696,14 @@ tcMethodBody clas tyvars dfun_ev_vars inst_tys
; spec_prags <- tcSpecPrags global_meth_id prags
; let specs = mk_meth_spec_prags global_meth_id spec_inst_prags spec_prags
- export = ABE { abe_ext = noExt
+ export = ABE { abe_ext = noExtField
, abe_poly = global_meth_id
, abe_mono = local_meth_id
, abe_wrap = idHsWrapper
, abe_prags = specs }
local_ev_binds = TcEvBinds ev_binds_var
- full_bind = AbsBinds { abs_ext = noExt
+ full_bind = AbsBinds { abs_ext = noExtField
, abs_tvs = tyvars
, abs_ev_vars = dfun_ev_vars
, abs_exports = [export]
@@ -1746,14 +1746,14 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
; (tc_bind, [inner_id]) <- tcPolyCheck no_prag_fn inner_meth_sig meth_bind
- ; let export = ABE { abe_ext = noExt
+ ; let export = ABE { abe_ext = noExtField
, abe_poly = local_meth_id
, abe_mono = inner_id
, abe_wrap = hs_wrap
, abe_prags = noSpecPrags }
; return (unitBag $ L (getLoc meth_bind) $
- AbsBinds { abs_ext = noExt, abs_tvs = [], abs_ev_vars = []
+ AbsBinds { abs_ext = noExtField, abs_tvs = [], abs_ev_vars = []
, abs_exports = [export]
, abs_binds = tc_bind, abs_ev_binds = []
, abs_sig = True }) }
@@ -1899,7 +1899,7 @@ mkDefMethBind clas inst_tys sel_id dm_name
; dm_id <- tcLookupId dm_name
; let inline_prag = idInlinePragma dm_id
inline_prags | isAnyInlinePragma inline_prag
- = [noLoc (InlineSig noExt fn inline_prag)]
+ = [noLoc (InlineSig noExtField fn inline_prag)]
| otherwise
= []
-- Copy the inline pragma (if any) from the default method
@@ -1919,7 +1919,7 @@ mkDefMethBind clas inst_tys sel_id dm_name
; return (bind, inline_prags) }
where
mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn
- mk_vta fun ty = noLoc (HsAppType noExt fun (mkEmptyWildCardBndrs $ nlHsParTy
+ mk_vta fun ty = noLoc (HsAppType noExtField fun (mkEmptyWildCardBndrs $ nlHsParTy
$ noLoc $ XHsType $ NHsCoreTy ty))
-- NB: use visible type application
-- See Note [Default methods in instances]
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index 93e47ac1d92322014d899b15baa03fee902cc3dc..b2233b4964a2c2d7dbb4da3988c01037c8a646d1 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -219,7 +219,7 @@ tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
; return (MG { mg_alts = L l matches'
, mg_ext = MatchGroupTc pat_tys rhs_ty
, mg_origin = origin }) }
-tcMatches _ _ _ (XMatchGroup {}) = panic "tcMatches"
+tcMatches _ _ _ (XMatchGroup nec) = noExtCon nec
-------------
tcMatch :: (Outputable (body GhcRn)) => TcMatchCtxt body
@@ -236,10 +236,10 @@ tcMatch ctxt pat_tys rhs_ty match
= add_match_ctxt match $
do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $
tcGRHSs ctxt grhss rhs_ty
- ; return (Match { m_ext = noExt
+ ; return (Match { m_ext = noExtField
, m_ctxt = mc_what ctxt, m_pats = pats'
, m_grhss = grhss' }) }
- tc_match _ _ _ (XMatch _) = panic "tcMatch"
+ tc_match _ _ _ (XMatch nec) = noExtCon nec
-- For (\x -> e), tcExpr has already said "In the expression \x->e"
-- so we don't want to add "In the lambda abstraction \x->e"
@@ -263,8 +263,8 @@ tcGRHSs ctxt (GRHSs _ grhss (L l binds)) res_ty
<- tcLocalBinds binds $
mapM (wrapLocM (tcGRHS ctxt res_ty)) grhss
- ; return (GRHSs noExt grhss' (L l binds')) }
-tcGRHSs _ (XGRHSs _) _ = panic "tcGRHSs"
+ ; return (GRHSs noExtField grhss' (L l binds')) }
+tcGRHSs _ (XGRHSs nec) _ = noExtCon nec
-------------
tcGRHS :: TcMatchCtxt body -> ExpRhoType -> GRHS GhcRn (Located (body GhcRn))
@@ -274,10 +274,10 @@ tcGRHS ctxt res_ty (GRHS _ guards rhs)
= do { (guards', rhs')
<- tcStmtsAndThen stmt_ctxt tcGuardStmt guards res_ty $
mc_body ctxt rhs
- ; return (GRHS noExt guards' rhs') }
+ ; return (GRHS noExtField guards' rhs') }
where
stmt_ctxt = PatGuard (mc_what ctxt)
-tcGRHS _ _ (XGRHS _) = panic "tcGRHS"
+tcGRHS _ _ (XGRHS nec) = noExtCon nec
{-
************************************************************************
@@ -467,7 +467,7 @@ tcLcStmt m_tc ctxt (ParStmt _ bndr_stmts_s _ _) elt_ty thing_inside
; (pairs', thing) <- loop pairs
; return (ids, pairs', thing) }
; return ( ParStmtBlock x stmts' ids noSyntaxExpr : pairs', thing ) }
- loop (XParStmtBlock{}:_) = panic "tcLcStmt"
+ loop (XParStmtBlock nec:_) = noExtCon nec
tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts
, trS_bndrs = bindersMap
@@ -1034,12 +1034,12 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside
}
; return (ApplicativeArgMany x stmts' ret' pat') }
- goArg (XApplicativeArg _, _, _) = panic "tcApplicativeStmts"
+ goArg (XApplicativeArg nec, _, _) = noExtCon nec
get_arg_bndrs :: ApplicativeArg GhcTcId -> [Id]
get_arg_bndrs (ApplicativeArgOne _ pat _ _) = collectPatBinders pat
get_arg_bndrs (ApplicativeArgMany _ _ _ pat) = collectPatBinders pat
- get_arg_bndrs (XApplicativeArg _) = panic "tcApplicativeStmts"
+ get_arg_bndrs (XApplicativeArg nec) = noExtCon nec
{- Note [ApplicativeDo and constraints]
@@ -1096,5 +1096,5 @@ checkArgs fun (MG { mg_alts = L _ (match1:matches) })
args_in_match :: LMatch GhcRn body -> Int
args_in_match (L _ (Match { m_pats = pats })) = length pats
- args_in_match (L _ (XMatch _)) = panic "checkArgs"
-checkArgs _ (XMatchGroup{}) = panic "checkArgs"
+ args_in_match (L _ (XMatch nec)) = noExtCon nec
+checkArgs _ (XMatchGroup nec) = noExtCon nec
diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs
index 38ca85969ae8513576b93d52e8967494dd9a5bf3..fae16723faf22432ed46ae7a8a987a0bad9b0c7d 100644
--- a/compiler/typecheck/TcPat.hs
+++ b/compiler/typecheck/TcPat.hs
@@ -466,7 +466,7 @@ tc_pat penv (TuplePat _ pats boxity) pat_ty thing_inside
-- pat_ty /= pat_ty iff coi /= IdCo
possibly_mangled_result
| gopt Opt_IrrefutableTuples dflags &&
- isBoxed boxity = LazyPat noExt (noLoc unmangled_result)
+ isBoxed boxity = LazyPat noExtField (noLoc unmangled_result)
| otherwise = unmangled_result
; pat_ty <- readExpType pat_ty
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 5dcee99bfde3f345c982da7fc5db29d04147783b..49f15e28496662b624bb7e28a14b0f655e2e281a 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -102,7 +102,7 @@ recoverPSB (PSB { psb_id = (dL->L _ name)
matcher_id = mkLocalId matcher_name $
mkSpecForAllTys [alphaTyVar] alphaTy
-recoverPSB (XPatSynBind {}) = panic "recoverPSB"
+recoverPSB (XPatSynBind nec) = noExtCon nec
{- Note [Pattern synonym error recovery]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -187,7 +187,7 @@ tcInferPatSynDecl (PSB { psb_id = lname@(dL->L _ name), psb_args = details
, mkTyVarTys ex_tvs, prov_theta, prov_evs)
(map nlHsVar args, map idType args)
pat_ty rec_fields } }
-tcInferPatSynDecl (XPatSynBind _) = panic "tcInferPatSynDecl"
+tcInferPatSynDecl (XPatSynBind nec) = noExtCon nec
mkProvEvidence :: EvId -> Maybe (PredType, EvTerm)
-- See Note [Equality evidence in pattern synonyms]
@@ -434,7 +434,7 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(dL->L _ name), psb_args = details
-- Why do we need tcSubType here?
-- See Note [Pattern synonyms and higher rank types]
; return (mkLHsWrap wrap $ nlHsVar arg_id) }
-tcCheckPatSynDecl (XPatSynBind _) _ = panic "tcCheckPatSynDecl"
+tcCheckPatSynDecl (XPatSynBind nec) _ = noExtCon nec
{- [Pattern synonyms and higher rank types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -726,13 +726,13 @@ tcPatSynMatcher (dL->L loc name) lpat
mkHsCaseAlt lwpat fail']
body = mkLHsWrap (mkWpLet req_ev_binds) $
cL (getLoc lpat) $
- HsCase noExt (nlHsVar scrutinee) $
+ HsCase noExtField (nlHsVar scrutinee) $
MG{ mg_alts = cL (getLoc lpat) cases
, mg_ext = MatchGroupTc [pat_ty] res_ty
, mg_origin = Generated
}
body' = noLoc $
- HsLam noExt $
+ HsLam noExtField $
MG{ mg_alts = noLoc [mkSimpleMatch LambdaExpr
args body]
, mg_ext = MatchGroupTc [pat_ty, cont_ty, fail_ty] res_ty
@@ -741,7 +741,7 @@ tcPatSynMatcher (dL->L loc name) lpat
match = mkMatch (mkPrefixFunRhs (cL loc name)) []
(mkHsLams (rr_tv:res_tv:univ_tvs)
req_dicts body')
- (noLoc (EmptyLocalBinds noExt))
+ (noLoc (EmptyLocalBinds noExtField))
mg :: MatchGroup GhcTc (LHsExpr GhcTc)
mg = MG{ mg_alts = cL (getLoc match) [match]
, mg_ext = MatchGroupTc [] res_ty
@@ -863,11 +863,11 @@ tcPatSynBuilderBind (PSB { psb_id = (dL->L loc name)
mk_mg :: LHsExpr GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn)
mk_mg body = mkMatchGroup Generated [builder_match]
where
- builder_args = [cL loc (VarPat noExt (cL loc n))
+ builder_args = [cL loc (VarPat noExtField (cL loc n))
| (dL->L loc n) <- args]
builder_match = mkMatch (mkPrefixFunRhs (cL loc name))
builder_args body
- (noLoc (EmptyLocalBinds noExt))
+ (noLoc (EmptyLocalBinds noExtField))
args = case details of
PrefixCon args -> args
@@ -882,13 +882,13 @@ tcPatSynBuilderBind (PSB { psb_id = (dL->L loc name)
= mg { mg_alts = cL l [cL loc (match { m_pats = nlWildPatName : pats })] }
add_dummy_arg other_mg = pprPanic "add_dummy_arg" $
pprMatches other_mg
-tcPatSynBuilderBind (XPatSynBind _) = panic "tcPatSynBuilderBind"
+tcPatSynBuilderBind (XPatSynBind nec) = noExtCon nec
tcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTcId, TcSigmaType)
-- monadic only for failure
tcPatSynBuilderOcc ps
| Just (builder_id, add_void_arg) <- builder
- , let builder_expr = HsConLikeOut noExt (PatSynCon ps)
+ , let builder_expr = HsConLikeOut noExtField (PatSynCon ps)
builder_ty = idType builder_id
= return $
if add_void_arg
@@ -927,14 +927,14 @@ tcPatToExpr name args pat = go pat
-> Either MsgDoc (HsExpr GhcRn)
mkPrefixConExpr lcon@(dL->L loc _) pats
= do { exprs <- mapM go pats
- ; return (foldl' (\x y -> HsApp noExt (cL loc x) y)
- (HsVar noExt lcon) exprs) }
+ ; return (foldl' (\x y -> HsApp noExtField (cL loc x) y)
+ (HsVar noExtField lcon) exprs) }
mkRecordConExpr :: Located Name -> HsRecFields GhcRn (LPat GhcRn)
-> Either MsgDoc (HsExpr GhcRn)
mkRecordConExpr con fields
= do { exprFields <- mapM go fields
- ; return (RecordCon noExt con exprFields) }
+ ; return (RecordCon noExtField con exprFields) }
go :: LPat GhcRn -> Either MsgDoc (LHsExpr GhcRn)
go (dL->L loc p) = cL loc <$> go1 p
@@ -951,27 +951,27 @@ tcPatToExpr name args pat = go pat
go1 (VarPat _ (dL->L l var))
| var `elemNameSet` lhsVars
- = return $ HsVar noExt (cL l var)
+ = return $ HsVar noExtField (cL l var)
| otherwise
= Left (quotes (ppr var) <+> text "is not bound by the LHS of the pattern synonym")
- go1 (ParPat _ pat) = fmap (HsPar noExt) $ go pat
+ go1 (ParPat _ pat) = fmap (HsPar noExtField) $ go pat
go1 p@(ListPat reb pats)
| Nothing <- reb = do { exprs <- mapM go pats
- ; return $ ExplicitList noExt Nothing exprs }
+ ; return $ ExplicitList noExtField Nothing exprs }
| otherwise = notInvertibleListPat p
go1 (TuplePat _ pats box) = do { exprs <- mapM go pats
- ; return $ ExplicitTuple noExt
- (map (noLoc . (Present noExt)) exprs)
+ ; return $ ExplicitTuple noExtField
+ (map (noLoc . (Present noExtField)) exprs)
box }
go1 (SumPat _ pat alt arity) = do { expr <- go1 (unLoc pat)
- ; return $ ExplicitSum noExt alt arity
+ ; return $ ExplicitSum noExtField alt arity
(noLoc expr)
}
- go1 (LitPat _ lit) = return $ HsLit noExt lit
+ go1 (LitPat _ lit) = return $ HsLit noExtField lit
go1 (NPat _ (dL->L _ n) mb_neg _)
| Just neg <- mb_neg = return $ unLoc $ nlHsSyntaxApps neg
- [noLoc (HsOverLit noExt n)]
- | otherwise = return $ HsOverLit noExt n
+ [noLoc (HsOverLit noExtField n)]
+ | otherwise = return $ HsOverLit noExtField n
go1 (ConPatOut{}) = panic "ConPatOut in output of renamer"
go1 (CoPat{}) = panic "CoPat in output of renamer"
go1 (SplicePat _ (HsSpliced _ _ (HsSplicedPat pat)))
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 96240e60925e2896aa957cc49a2bec087447d293..ca4f98b98c57cab15b060f3b0a3cbe07ca8d853a 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -554,7 +554,7 @@ tc_rn_src_decls ds
("Declaration splices are not "
++ "permitted inside top-level "
++ "declarations added with addTopDecls"))
- ; Just (XSpliceDecl _, _) -> panic "tc_rn_src_decls"
+ ; Just (XSpliceDecl nec, _) -> noExtCon nec
}
-- Rename TH-generated top-level declarations
; (tcg_env, th_rn_decls) <- setGblEnv tcg_env
@@ -597,7 +597,7 @@ tc_rn_src_decls ds
; return (tcg_env, tcl_env, lie1 `andWC` lie2)
}
- ; Just (XSpliceDecl _, _) -> panic "tc_rn_src_decls"
+ ; Just (XSpliceDecl nec, _) -> noExtCon nec
}
}
@@ -634,8 +634,8 @@ tcRnHsBootDecls hsc_src decls
-- Check for illegal declarations
; case group_tail of
Just (SpliceDecl _ d _, _) -> badBootDecl hsc_src "splice" d
- Just (XSpliceDecl _, _) -> panic "tcRnHsBootDecls"
- Nothing -> return ()
+ Just (XSpliceDecl nec, _) -> noExtCon nec
+ Nothing -> return ()
; mapM_ (badBootDecl hsc_src "foreign") for_decls
; mapM_ (badBootDecl hsc_src "default") def_decls
; mapM_ (badBootDecl hsc_src "rule") rule_decls
@@ -1739,7 +1739,7 @@ check_main dflags tcg_env explicit_mod_hdr
; (ev_binds, main_expr)
<- checkConstraints skol_info [] [] $
addErrCtxt mainCtxt $
- tcMonoExpr (cL loc (HsVar noExt (cL loc main_name)))
+ tcMonoExpr (cL loc (HsVar noExtField (cL loc main_name)))
(mkCheckExpType io_ty)
-- See Note [Root-main Id]
@@ -2068,35 +2068,35 @@ tcUserStmt (dL->L loc (BodyStmt _ expr _ _))
-- (if we are at a breakpoint, say). We must put those free vars
-- [let it = expr]
- let_stmt = cL loc $ LetStmt noExt $ noLoc $ HsValBinds noExt
+ let_stmt = cL loc $ LetStmt noExtField $ noLoc $ HsValBinds noExtField
$ XValBindsLR
(NValBinds [(NonRecursive,unitBag the_bind)] [])
-- [it <- e]
- bind_stmt = cL loc $ BindStmt noExt
- (cL loc (VarPat noExt (cL loc fresh_it)))
+ bind_stmt = cL loc $ BindStmt noExtField
+ (cL loc (VarPat noExtField (cL loc fresh_it)))
(nlHsApp ghciStep rn_expr)
(mkRnSyntaxExpr bindIOName)
noSyntaxExpr
-- [; print it]
- print_it = cL loc $ BodyStmt noExt
+ print_it = cL loc $ BodyStmt noExtField
(nlHsApp (nlHsVar interPrintName)
(nlHsVar fresh_it))
(mkRnSyntaxExpr thenIOName)
noSyntaxExpr
-- NewA
- no_it_a = cL loc $ BodyStmt noExt (nlHsApps bindIOName
+ no_it_a = cL loc $ BodyStmt noExtField (nlHsApps bindIOName
[rn_expr , nlHsVar interPrintName])
(mkRnSyntaxExpr thenIOName)
noSyntaxExpr
- no_it_b = cL loc $ BodyStmt noExt (rn_expr)
+ no_it_b = cL loc $ BodyStmt noExtField (rn_expr)
(mkRnSyntaxExpr thenIOName)
noSyntaxExpr
- no_it_c = cL loc $ BodyStmt noExt
+ no_it_c = cL loc $ BodyStmt noExtField
(nlHsApp (nlHsVar interPrintName) rn_expr)
(mkRnSyntaxExpr thenIOName)
noSyntaxExpr
@@ -2230,7 +2230,7 @@ tcUserStmt rdr_stmt@(dL->L loc _)
; when (isUnitTy v_ty || not (isTauTy v_ty)) failM
; return stuff }
where
- print_v = cL loc $ BodyStmt noExt (nlHsApp (nlHsVar printName)
+ print_v = cL loc $ BodyStmt noExtField (nlHsApp (nlHsVar printName)
(nlHsVar v))
(mkRnSyntaxExpr thenIOName) noSyntaxExpr
@@ -2317,14 +2317,14 @@ getGhciStepIO = do
step_ty = noLoc $ HsForAllTy
{ hst_fvf = ForallInvis
- , hst_bndrs = [noLoc $ UserTyVar noExt (noLoc a_tv)]
- , hst_xforall = noExt
+ , hst_bndrs = [noLoc $ UserTyVar noExtField (noLoc a_tv)]
+ , hst_xforall = noExtField
, hst_body = nlHsFunTy ghciM ioM }
stepTy :: LHsSigWcType GhcRn
stepTy = mkEmptyWildCardBndrs (mkEmptyImplicitBndrs step_ty)
- return (noLoc $ ExprWithTySig noExt (nlHsVar ghciStepIoMName) stepTy)
+ return (noLoc $ ExprWithTySig noExtField (nlHsVar ghciStepIoMName) stepTy)
isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)
isGHCiMonad hsc_env ty
diff --git a/compiler/typecheck/TcRnExports.hs b/compiler/typecheck/TcRnExports.hs
index e4009e6040691564f7618587b9630a6c74e82492..4ac969ffcf833dfa69ce1c1c4705f1546c76599c 100644
--- a/compiler/typecheck/TcRnExports.hs
+++ b/compiler/typecheck/TcRnExports.hs
@@ -183,7 +183,7 @@ tcRnExports explicit_mod exports
; let real_exports
| explicit_mod = exports
| has_main
- = Just (noLoc [noLoc (IEVar noExt
+ = Just (noLoc [noLoc (IEVar noExtField
(noLoc (IEName $ noLoc default_main)))])
-- ToDo: the 'noLoc' here is unhelpful if 'main'
-- turns out to be out of scope
@@ -317,7 +317,7 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod
, ppr new_exports ])
; return (Just ( ExportAccum occs' mods
- , ( cL loc (IEModuleContents noExt lmod)
+ , ( cL loc (IEModuleContents noExtField lmod)
, new_exports))) }
exports_from_item acc@(ExportAccum occs mods) (dL->L loc ie)
@@ -340,18 +340,18 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod
lookup_ie :: IE GhcPs -> RnM (IE GhcRn, AvailInfo)
lookup_ie (IEVar _ (dL->L l rdr))
= do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr
- return (IEVar noExt (cL l (replaceWrappedName rdr name)), avail)
+ return (IEVar noExtField (cL l (replaceWrappedName rdr name)), avail)
lookup_ie (IEThingAbs _ (dL->L l rdr))
= do (name, avail) <- lookupGreAvailRn $ ieWrappedName rdr
- return (IEThingAbs noExt (cL l (replaceWrappedName rdr name))
+ return (IEThingAbs noExtField (cL l (replaceWrappedName rdr name))
, avail)
lookup_ie ie@(IEThingAll _ n')
= do
(n, avail, flds) <- lookup_ie_all ie n'
let name = unLoc n
- return (IEThingAll noExt (replaceLWrappedName n' (unLoc n))
+ return (IEThingAll noExtField (replaceLWrappedName n' (unLoc n))
, AvailTC name (name:avail) flds)
@@ -364,7 +364,7 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod
NoIEWildcard -> return (lname, [], [])
IEWildcard _ -> lookup_ie_all ie l
let name = unLoc lname
- return (IEThingWith noExt (replaceLWrappedName l name) wc subs
+ return (IEThingWith noExtField (replaceLWrappedName l name) wc subs
(flds ++ (map noLoc all_flds)),
AvailTC name (name : avails ++ all_avail)
(map unLoc flds ++ all_flds))
@@ -406,10 +406,10 @@ exports_from_avail (Just (dL->L _ rdr_items)) rdr_env imports this_mod
-------------
lookup_doc_ie :: IE GhcPs -> RnM (IE GhcRn)
lookup_doc_ie (IEGroup _ lev doc) = do rn_doc <- rnHsDoc doc
- return (IEGroup noExt lev rn_doc)
+ return (IEGroup noExtField lev rn_doc)
lookup_doc_ie (IEDoc _ doc) = do rn_doc <- rnHsDoc doc
- return (IEDoc noExt rn_doc)
- lookup_doc_ie (IEDocNamed _ str) = return (IEDocNamed noExt str)
+ return (IEDoc noExtField rn_doc)
+ lookup_doc_ie (IEDocNamed _ str) = return (IEDocNamed noExtField str)
lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier
-- In an export item M.T(A,B,C), we want to treat the uses of
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 8882bbc6c7dca148b802d42af7c80a0188391bdf..7e28359c3601470ea3da7b6778cf994511a26b04 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -3734,7 +3734,7 @@ exprCtOrigin (HsTick _ _ e) = lexprCtOrigin e
exprCtOrigin (HsBinTick _ _ _ e) = lexprCtOrigin e
exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e
exprCtOrigin (HsWrap {}) = panic "exprCtOrigin HsWrap"
-exprCtOrigin (XExpr {}) = panic "exprCtOrigin XExpr"
+exprCtOrigin (XExpr nec) = noExtCon nec
-- | Extract a suitable CtOrigin from a MatchGroup
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
@@ -3745,17 +3745,17 @@ matchesCtOrigin (MG { mg_alts = alts })
| otherwise
= Shouldn'tHappenOrigin "multi-way match"
-matchesCtOrigin (XMatchGroup{}) = panic "matchesCtOrigin"
+matchesCtOrigin (XMatchGroup nec) = noExtCon nec
-- | Extract a suitable CtOrigin from guarded RHSs
grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss
-grhssCtOrigin (XGRHSs _) = panic "grhssCtOrigin"
+grhssCtOrigin (XGRHSs nec) = noExtCon nec
-- | Extract a suitable CtOrigin from a list of guarded RHSs
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e
-lGRHSCtOrigin [L _ (XGRHS _)] = panic "lGRHSCtOrigin"
+lGRHSCtOrigin [L _ (XGRHS nec)] = noExtCon nec
lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS"
pprCtLoc :: CtLoc -> SDoc
diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs
index f1d549568a354fe01214117bf6a2f841b300fe12..b60bbd2e5acc40f07d72b83f7a97b60178d48207 100644
--- a/compiler/typecheck/TcRules.hs
+++ b/compiler/typecheck/TcRules.hs
@@ -66,10 +66,10 @@ tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTcId)
tcRuleDecls (HsRules { rds_src = src
, rds_rules = decls })
= do { tc_decls <- mapM (wrapLocM tcRule) decls
- ; return $ HsRules { rds_ext = noExt
+ ; return $ HsRules { rds_ext = noExtField
, rds_src = src
, rds_rules = tc_decls } }
-tcRuleDecls (XRuleDecls _) = panic "tcRuleDecls"
+tcRuleDecls (XRuleDecls nec) = noExtCon nec
tcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTcId)
tcRule (HsRule { rd_ext = ext
@@ -141,10 +141,11 @@ tcRule (HsRule { rd_ext = ext
, rd_name = rname
, rd_act = act
, rd_tyvs = ty_bndrs -- preserved for ppr-ing
- , rd_tmvs = map (noLoc . RuleBndr noExt . noLoc) (all_qtkvs ++ tpl_ids)
+ , rd_tmvs = map (noLoc . RuleBndr noExtField . noLoc)
+ (all_qtkvs ++ tpl_ids)
, rd_lhs = mkHsDictLet lhs_binds lhs'
, rd_rhs = mkHsDictLet rhs_binds rhs' } }
-tcRule (XRuleDecl _) = panic "tcRule"
+tcRule (XRuleDecl nec) = noExtCon nec
generateRuleConstraints :: Maybe [LHsTyVarBndr GhcRn] -> [LRuleBndr GhcRn]
-> LHsExpr GhcRn -> LHsExpr GhcRn
@@ -203,7 +204,7 @@ tcRuleTmBndrs (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs)
; (tyvars, tmvars) <- tcExtendNameTyVarEnv tvs $
tcRuleTmBndrs rule_bndrs
; return (map snd tvs ++ tyvars, id : tmvars) }
-tcRuleTmBndrs (L _ (XRuleBndr _) : _) = panic "tcRuleTmBndrs"
+tcRuleTmBndrs (L _ (XRuleBndr nec) : _) = noExtCon nec
ruleCtxt :: FastString -> SDoc
ruleCtxt name = text "When checking the transformation rule" <+>
diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs
index da18065b93b9e49371b3ef3a83977c81b6fe8722..a8a3e0dd47631459de429ae2ab5db8595c07d272 100644
--- a/compiler/typecheck/TcSigs.hs
+++ b/compiler/typecheck/TcSigs.hs
@@ -258,8 +258,8 @@ isCompleteHsSig :: LHsSigWcType GhcRn -> Bool
isCompleteHsSig (HsWC { hswc_ext = wcs
, hswc_body = HsIB { hsib_body = hs_ty } })
= null wcs && no_anon_wc hs_ty
-isCompleteHsSig (HsWC _ (XHsImplicitBndrs _)) = panic "isCompleteHsSig"
-isCompleteHsSig (XHsWildCardBndrs _) = panic "isCompleteHsSig"
+isCompleteHsSig (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
+isCompleteHsSig (XHsWildCardBndrs nec) = noExtCon nec
no_anon_wc :: LHsType GhcRn -> Bool
no_anon_wc lty = go lty
@@ -300,7 +300,7 @@ no_anon_wc_bndrs ltvs = all (go . unLoc) ltvs
where
go (UserTyVar _ _) = True
go (KindedTyVar _ _ ki) = no_anon_wc ki
- go (XTyVarBndr{}) = panic "no_anon_wc_bndrs"
+ go (XTyVarBndr nec) = noExtCon nec
{- Note [Fail eagerly on bad signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -465,7 +465,7 @@ tcPatSynSig name sig_ty
mkSpecForAllTys ex $
mkPhiTy prov $
body
-tcPatSynSig _ (XHsImplicitBndrs _) = panic "tcPatSynSig"
+tcPatSynSig _ (XHsImplicitBndrs nec) = noExtCon nec
ppr_tvs :: [TyVar] -> SDoc
ppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv)
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 3434b686151e7c16e9bae3447a03d3e5a372e0dc..bcdc503e56b54265769e348ce2aa5922c42e2cd7 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -185,7 +185,7 @@ tcTypedBracket rn_expr brack@(TExpBr _ expr) res_ty
; tcWrapResultO (Shouldn'tHappenOrigin "TExpBr")
rn_expr
(unLoc (mkHsApp (nlHsTyApp texpco [rep, expr_ty])
- (noLoc (HsTcBracketOut noExt brack ps'))))
+ (noLoc (HsTcBracketOut noExtField brack ps'))))
meta_ty res_ty }
tcTypedBracket _ other_brack _
= pprPanic "tcTypedBracket" (ppr other_brack)
@@ -197,7 +197,7 @@ tcUntypedBracket rn_expr brack ps res_ty
; meta_ty <- tcBrackTy brack
; traceTc "tc_bracket done untyped" (ppr meta_ty)
; tcWrapResultO (Shouldn'tHappenOrigin "untyped bracket")
- rn_expr (HsTcBracketOut noExt brack ps') meta_ty res_ty }
+ rn_expr (HsTcBracketOut noExtField brack ps') meta_ty res_ty }
---------------
tcBrackTy :: HsBracket GhcRn -> TcM TcType
@@ -207,9 +207,9 @@ tcBrackTy (ExpBr {}) = tcMetaTy expQTyConName -- Result type is ExpQ (= Q Exp)
tcBrackTy (TypBr {}) = tcMetaTy typeQTyConName -- Result type is Type (= Q Typ)
tcBrackTy (DecBrG {}) = tcMetaTy decsQTyConName -- Result type is Q [Dec]
tcBrackTy (PatBr {}) = tcMetaTy patQTyConName -- Result type is PatQ (= Q Pat)
-tcBrackTy (DecBrL {}) = panic "tcBrackTy: Unexpected DecBrL"
-tcBrackTy (TExpBr {}) = panic "tcUntypedBracket: Unexpected TExpBr"
-tcBrackTy (XBracket {}) = panic "tcUntypedBracket: Unexpected XBracket"
+tcBrackTy (DecBrL {}) = panic "tcBrackTy: Unexpected DecBrL"
+tcBrackTy (TExpBr {}) = panic "tcUntypedBracket: Unexpected TExpBr"
+tcBrackTy (XBracket nec) = noExtCon nec
---------------
tcPendingSplice :: PendingRnSplice -> TcM PendingTcSplice
@@ -498,7 +498,7 @@ tcTopSplice expr res_ty
; lcl_env <- getLclEnv
; let delayed_splice
= DelayedSplice lcl_env expr res_ty q_expr
- ; return (HsSpliceE noExt (HsSplicedT delayed_splice))
+ ; return (HsSpliceE noExtField (HsSplicedT delayed_splice))
}
@@ -610,8 +610,8 @@ runAnnotation target expr = do
; wrapper <- instCall AnnOrigin [expr_ty] [mkClassPred data_class [expr_ty]]
; let specialised_to_annotation_wrapper_expr
= L loc (mkHsWrap wrapper
- (HsVar noExt (L loc to_annotation_wrapper_id)))
- ; return (L loc (HsApp noExt
+ (HsVar noExtField (L loc to_annotation_wrapper_id)))
+ ; return (L loc (HsApp noExtField
specialised_to_annotation_wrapper_expr expr'))
})
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 67fc558af18ef23c21265df2867d27588afb941c..395c123290177bae25ec5c723c5defcbb1f209a0 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -194,7 +194,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
; return (gbl_env', inst_info, deriv_info) }
-tcTyClGroup (XTyClGroup _) = panic "tcTyClGroup"
+tcTyClGroup (XTyClGroup nec) = noExtCon nec
tcTyClDecls
:: [LTyClDecl GhcRn]
@@ -1079,8 +1079,8 @@ getInitialKind cusk (SynDecl { tcdLName = dL->L _ name
HsKindSig _ _ k -> Just k
_ -> Nothing
-getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn _)) = panic "getInitialKind"
-getInitialKind _ (XTyClDecl _) = panic "getInitialKind"
+getInitialKind _ (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec
+getInitialKind _ (XTyClDecl nec) = noExtCon nec
---------------------------------
getFamDeclInitialKinds
@@ -1121,7 +1121,7 @@ getFamDeclInitialKind parent_cusk mb_parent_tycon
ClosedTypeFamily _ -> ASSERT( isNothing mb_parent_tycon )
ClosedTypeFamilyFlavour
ctxt = TyFamResKindCtxt name
-getFamDeclInitialKind _ _ (XFamilyDecl _) = panic "getFamDeclInitialKind"
+getFamDeclInitialKind _ _ (XFamilyDecl nec) = noExtCon nec
------------------------------------------------------------------------
kcLTyClDecl :: LTyClDecl GhcRn -> TcM ()
@@ -1193,9 +1193,9 @@ kcTyClDecl (FamDecl _ (FamilyDecl { fdLName = (dL->L _ fam_tc_name)
do { fam_tc <- kcLookupTcTyCon fam_tc_name
; mapM_ (kcTyFamInstEqn fam_tc) eqns }
_ -> return ()
-kcTyClDecl (FamDecl _ (XFamilyDecl _)) = panic "kcTyClDecl"
-kcTyClDecl (DataDecl _ _ _ _ (XHsDataDefn _)) = panic "kcTyClDecl"
-kcTyClDecl (XTyClDecl _) = panic "kcTyClDecl"
+kcTyClDecl (FamDecl _ (XFamilyDecl nec)) = noExtCon nec
+kcTyClDecl (DataDecl _ _ _ _ (XHsDataDefn nec)) = noExtCon nec
+kcTyClDecl (XTyClDecl nec) = noExtCon nec
-------------------
@@ -1276,8 +1276,8 @@ kcConDecl new_or_data res_kind (ConDeclGADT
; kcConArgTys new_or_data res_kind (hsConDeclArgTys args)
; _ <- tcHsOpenType res_ty
; return () }
-kcConDecl _ _ (ConDeclGADT _ _ _ (XLHsQTyVars _) _ _ _ _) = panic "kcConDecl"
-kcConDecl _ _ (XConDecl _) = panic "kcConDecl"
+kcConDecl _ _ (ConDeclGADT _ _ _ (XLHsQTyVars nec) _ _ _ _) = noExtCon nec
+kcConDecl _ _ (XConDecl nec) = noExtCon nec
{-
Note [Recursion and promoting data constructors]
@@ -1594,7 +1594,7 @@ tcTyClDecl1 _parent roles_info
meths fundeps sigs ats at_defs
; return (noDerivInfos (classTyCon clas)) }
-tcTyClDecl1 _ _ (XTyClDecl _) = panic "tcTyClDecl1"
+tcTyClDecl1 _ _ (XTyClDecl nec) = noExtCon nec
{- *********************************************************************
@@ -1972,7 +1972,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info
; return fam_tc } }
| otherwise = panic "tcFamInst1" -- Silence pattern-exhaustiveness checker
-tcFamDecl1 _ (XFamilyDecl _) = panic "tcFamDecl1"
+tcFamDecl1 _ (XFamilyDecl nec) = noExtCon nec
-- | Maybe return a list of Bools that say whether a type family was declared
-- injective in the corresponding type arguments. Length of the list is equal to
@@ -2115,7 +2115,7 @@ tcDataDefn err_ctxt
DataType -> return (mkDataTyConRhs data_cons)
NewType -> ASSERT( not (null data_cons) )
mkNewTyConRhs tc_name tycon (head data_cons)
-tcDataDefn _ _ _ _ _ (XHsDataDefn _) = panic "tcDataDefn"
+tcDataDefn _ _ _ _ _ (XHsDataDefn nec) = noExtCon nec
-------------------------
@@ -2153,8 +2153,8 @@ kcTyFamInstEqn tc_fam_tc
where
vis_arity = length (tyConVisibleTyVars tc_fam_tc)
-kcTyFamInstEqn _ (dL->L _ (XHsImplicitBndrs _)) = panic "kcTyFamInstEqn"
-kcTyFamInstEqn _ (dL->L _ (HsIB _ (XFamEqn _))) = panic "kcTyFamInstEqn"
+kcTyFamInstEqn _ (dL->L _ (XHsImplicitBndrs nec)) = noExtCon nec
+kcTyFamInstEqn _ (dL->L _ (HsIB _ (XFamEqn nec))) = noExtCon nec
kcTyFamInstEqn _ _ = panic "kcTyFamInstEqn: Impossible Match" -- due to #15884
@@ -2320,7 +2320,7 @@ tcFamTyPats fam_tc hs_pats
where
fam_name = tyConName fam_tc
fam_arity = tyConArity fam_tc
- lhs_fun = noLoc (HsTyVar noExt NotPromoted (noLoc fam_name))
+ lhs_fun = noLoc (HsTyVar noExtField NotPromoted (noLoc fam_name))
unravelFamInstPats :: TcType -> [TcType]
-- Decompose fam_app to get the argument patterns
@@ -2684,9 +2684,9 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data
; traceTc "tcConDecl 2" (ppr names)
; mapM buildOneDataCon names
}
-tcConDecl _ _ _ _ _ _ (ConDeclGADT _ _ _ (XLHsQTyVars _) _ _ _ _)
- = panic "tcConDecl"
-tcConDecl _ _ _ _ _ _ (XConDecl _) = panic "tcConDecl"
+tcConDecl _ _ _ _ _ _ (ConDeclGADT _ _ _ (XLHsQTyVars nec) _ _ _ _)
+ = noExtCon nec
+tcConDecl _ _ _ _ _ _ (XConDecl nec) = noExtCon nec
tcConIsInfixH98 :: Name
-> HsConDetails (LHsType GhcRn) (Located [LConDeclField GhcRn])
@@ -4006,8 +4006,8 @@ tcMkDataFamInstCtxt decl@(DataFamInstDecl { dfid_eqn =
HsIB { hsib_body = eqn }})
= tcMkFamInstCtxt (pprDataFamInstFlavour decl <+> text "instance")
(unLoc (feqn_tycon eqn))
-tcMkDataFamInstCtxt (DataFamInstDecl (XHsImplicitBndrs _))
- = panic "tcMkDataFamInstCtxt"
+tcMkDataFamInstCtxt (DataFamInstDecl (XHsImplicitBndrs nec))
+ = noExtCon nec
tcAddDataFamInstCtxt :: DataFamInstDecl GhcRn -> TcM a -> TcM a
tcAddDataFamInstCtxt decl
@@ -4199,7 +4199,7 @@ wrongNumberOfRoles tyvars d@(dL->L _ (RoleAnnotDecl _ _ annots))
text "Expected" <+> (ppr $ length tyvars) <> comma <+>
text "got" <+> (ppr $ length annots) <> colon)
2 (ppr d)
-wrongNumberOfRoles _ (dL->L _ (XRoleAnnotDecl _)) = panic "wrongNumberOfRoles"
+wrongNumberOfRoles _ (dL->L _ (XRoleAnnotDecl nec)) = noExtCon nec
wrongNumberOfRoles _ _ = panic "wrongNumberOfRoles: Impossible Match"
-- due to #15884
@@ -4210,7 +4210,7 @@ illegalRoleAnnotDecl (dL->L loc (RoleAnnotDecl _ tycon _))
setSrcSpan loc $
addErrTc (text "Illegal role annotation for" <+> ppr tycon <> char ';' $$
text "they are allowed only for datatypes and classes.")
-illegalRoleAnnotDecl (dL->L _ (XRoleAnnotDecl _)) = panic "illegalRoleAnnotDecl"
+illegalRoleAnnotDecl (dL->L _ (XRoleAnnotDecl nec)) = noExtCon nec
illegalRoleAnnotDecl _ = panic "illegalRoleAnnotDecl: Impossible Match"
-- due to #15884
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 7a68fe11447824dd7d59029ec97988cd35619fb6..94658c241391cb845fe6651ba6625cbd91b2f238 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -832,8 +832,8 @@ tcRecSelBinds sel_bind_prs
tcValBinds TopLevel binds sigs getGblEnv
; return (tcg_env `addTypecheckedBinds` map snd rec_sel_binds) }
where
- sigs = [ cL loc (IdSig noExt sel_id) | (sel_id, _) <- sel_bind_prs
- , let loc = getSrcSpan sel_id ]
+ sigs = [ cL loc (IdSig noExtField sel_id) | (sel_id, _) <- sel_bind_prs
+ , let loc = getSrcSpan sel_id ]
binds = [(NonRecursive, unitBag bind) | (_, bind) <- sel_bind_prs]
mkRecSelBinds :: [TyCon] -> [(Id, LHsBind GhcRn)]
@@ -892,7 +892,7 @@ mkOneRecordSelector all_cons idDetails fl
| otherwise = map mk_match cons_w_field ++ deflt
mk_match con = mkSimpleMatch (mkPrefixFunRhs sel_lname)
[cL loc (mk_sel_pat con)]
- (cL loc (HsVar noExt (cL loc field_var)))
+ (cL loc (HsVar noExtField (cL loc field_var)))
mk_sel_pat con = ConPatIn (cL loc (getName con)) (RecCon rec_fields)
rec_fields = HsRecFields { rec_flds = [rec_field], rec_dotdot = Nothing }
rec_field = noLoc (HsRecField
@@ -900,7 +900,7 @@ mkOneRecordSelector all_cons idDetails fl
= cL loc (FieldOcc sel_name
(cL loc $ mkVarUnqual lbl))
, hsRecFieldArg
- = cL loc (VarPat noExt (cL loc field_var))
+ = cL loc (VarPat noExtField (cL loc field_var))
, hsRecPun = False })
sel_lname = cL loc sel_name
field_var = mkInternalName (mkBuiltinUnique 1) (getOccName sel_name) loc
@@ -910,10 +910,10 @@ mkOneRecordSelector all_cons idDetails fl
-- mentions this particular record selector
deflt | all dealt_with all_cons = []
| otherwise = [mkSimpleMatch CaseAlt
- [cL loc (WildPat noExt)]
- (mkHsApp (cL loc (HsVar noExt
+ [cL loc (WildPat noExtField)]
+ (mkHsApp (cL loc (HsVar noExtField
(cL loc (getName rEC_SEL_ERROR_ID))))
- (cL loc (HsLit noExt msg_lit)))]
+ (cL loc (HsLit noExtField msg_lit)))]
-- Do not add a default case unless there are unmatched
-- constructors. We must take account of GADTs, else we
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 31c6db055d6e3c927f0bad71de9bc73c8b076193..f5cae41578418ee5615ed3e05d7646c46f9f29fe 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1252,7 +1252,7 @@ runStmt input step = do
mk_stmt :: SrcSpan -> HsBind GhcPs -> GhciLStmt GhcPs
mk_stmt loc bind =
let l = L loc
- in l (LetStmt noExt (l (HsValBinds noExt (ValBinds noExt (unitBag (l bind)) []))))
+ in l (LetStmt noExtField (l (HsValBinds noExtField (ValBinds noExtField (unitBag (l bind)) []))))
-- | Clean up the GHCi environment after a statement has run
afterRunStmt :: GhciMonad m
@@ -1662,7 +1662,7 @@ defineMacro overwrite s = do
body = nlHsVar compose_RDR `mkHsApp` (nlHsPar step)
`mkHsApp` (nlHsPar expr)
tySig = mkLHsSigWcType (stringTy `nlHsFunTy` ioM)
- new_expr = L (getLoc expr) $ ExprWithTySig noExt body tySig
+ new_expr = L (getLoc expr) $ ExprWithTySig noExtField body tySig
hv <- GHC.compileParsedExprRemote new_expr
let newCmd = Command { cmdName = macro_name
@@ -1730,7 +1730,7 @@ getGhciStepIO = do
ioM = nlHsTyVar (getRdrName ioTyConName) `nlHsAppTy` stringTy
body = nlHsVar (getRdrName ghciStepIoMName)
tySig = mkLHsSigWcType (ghciM `nlHsFunTy` ioM)
- return $ noLoc $ ExprWithTySig noExt body tySig
+ return $ noLoc $ ExprWithTySig noExtField body tySig
-----------------------------------------------------------------------------
-- :check
diff --git a/testsuite/tests/ghc-api/annotations/parseTree.hs b/testsuite/tests/ghc-api/annotations/parseTree.hs
index b04be775c38ea69597fc172f487d9e97f9cc07fb..badf59150f20f6f58f2f4ea2eba4c7d6ce84f26f 100644
--- a/testsuite/tests/ghc-api/annotations/parseTree.hs
+++ b/testsuite/tests/ghc-api/annotations/parseTree.hs
@@ -52,9 +52,9 @@ testOneFile libdir fileName = do
doLHsTupArg :: LHsTupArg GhcPs -> [(SrcSpan,String,HsExpr GhcPs)]
doLHsTupArg (L l arg@(Present {}))
- = [(l,"p",ExplicitTuple noExt [L l arg] Boxed)]
+ = [(l,"p",ExplicitTuple noExtField [L l arg] Boxed)]
doLHsTupArg (L l arg@(Missing {}))
- = [(l,"m",ExplicitTuple noExt [L l arg] Boxed)]
+ = [(l,"m",ExplicitTuple noExtField [L l arg] Boxed)]
showAnns anns = "[\n" ++ (intercalate "\n"
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index d290e61da1966e3d0cbc36f55b7235bf9b0c21c4..d7996df404319e6e868ab766e444378e5b6be90f 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -9,7 +9,7 @@
(Nothing)
[({ DumpParsedAst.hs:5:1-16 }
(ImportDecl
- (NoExt)
+ (NoExtField)
(NoSourceText)
({ DumpParsedAst.hs:5:8-16 }
{ModuleName: Data.Kind})
@@ -22,18 +22,18 @@
(Nothing)))]
[({ DumpParsedAst.hs:7:1-30 }
(TyClD
- (NoExt)
+ (NoExtField)
(DataDecl
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:7:6-10 }
(Unqual
{OccName: Peano}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[])
(Prefix)
(HsDataDefn
- (NoExt)
+ (NoExtField)
(DataType)
({ <no location info> }
[])
@@ -41,7 +41,7 @@
(Nothing)
[({ DumpParsedAst.hs:7:14-17 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:7:14-17 }
(Unqual
{OccName: Zero}))
@@ -54,7 +54,7 @@
(Nothing)))
,({ DumpParsedAst.hs:7:21-30 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:7:21-24 }
(Unqual
{OccName: Succ}))
@@ -65,7 +65,7 @@
(PrefixCon
[({ DumpParsedAst.hs:7:26-30 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:7:26-30 }
(Unqual
@@ -75,18 +75,18 @@
[])))))
,({ DumpParsedAst.hs:9:1-39 }
(TyClD
- (NoExt)
+ (NoExtField)
(FamDecl
- (NoExt)
+ (NoExtField)
(FamilyDecl
- (NoExt)
+ (NoExtField)
(ClosedTypeFamily
(Just
[({ DumpParsedAst.hs:10:3-36 }
(HsIB
- (NoExt)
+ (NoExtField)
(FamEqn
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:10:3-8 }
(Unqual
{OccName: Length}))
@@ -94,13 +94,13 @@
[(HsValArg
({ DumpParsedAst.hs:10:10-17 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:10:11-16 }
(HsOpTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:10:11 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:10:11 }
(Unqual
@@ -110,7 +110,7 @@
{Name: :}))
({ DumpParsedAst.hs:10:15-16 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:10:15-16 }
(Unqual
@@ -118,39 +118,39 @@
(Prefix)
({ DumpParsedAst.hs:10:21-36 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:10:21-24 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:10:21-24 }
(Unqual
{OccName: Succ}))))
({ DumpParsedAst.hs:10:26-36 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:10:27-35 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:10:27-32 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:10:27-32 }
(Unqual
{OccName: Length}))))
({ DumpParsedAst.hs:10:34-35 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:10:34-35 }
(Unqual
{OccName: as})))))))))))))
,({ DumpParsedAst.hs:11:3-24 }
(HsIB
- (NoExt)
+ (NoExtField)
(FamEqn
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:11:3-8 }
(Unqual
{OccName: Length}))
@@ -158,13 +158,13 @@
[(HsValArg
({ DumpParsedAst.hs:11:10-12 }
(HsExplicitListTy
- (NoExt)
+ (NoExtField)
(IsPromoted)
[])))]
(Prefix)
({ DumpParsedAst.hs:11:21-24 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:11:21-24 }
(Unqual
@@ -173,19 +173,19 @@
(Unqual
{OccName: Length}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ DumpParsedAst.hs:9:21-29 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:9:21-22 }
(Unqual
{OccName: as}))
({ DumpParsedAst.hs:9:27-29 }
(HsListTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:9:28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:9:28 }
(Unqual
@@ -193,10 +193,10 @@
(Prefix)
({ DumpParsedAst.hs:9:32-39 }
(KindSig
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:9:35-39 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:9:35-39 }
(Unqual
@@ -204,36 +204,36 @@
(Nothing)))))
,({ DumpParsedAst.hs:14:1-29 }
(TyClD
- (NoExt)
+ (NoExtField)
(DataDecl
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:14:6 }
(Unqual
{OccName: T}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ DumpParsedAst.hs:14:8 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:14:8 }
(Unqual
{OccName: f}))))
,({ DumpParsedAst.hs:14:11-16 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:14:11 }
(Unqual
{OccName: a}))
({ DumpParsedAst.hs:14:16 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:14:16 }
(Unqual
{OccName: k}))))))])
(Prefix)
(HsDataDefn
- (NoExt)
+ (NoExtField)
(DataType)
({ <no location info> }
[])
@@ -241,7 +241,7 @@
(Nothing)
[({ DumpParsedAst.hs:14:21-29 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:14:21-23 }
(Unqual
{OccName: MkT}))
@@ -252,20 +252,20 @@
(PrefixCon
[({ DumpParsedAst.hs:14:25-29 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:14:26-28 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:14:26 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:14:26 }
(Unqual
{OccName: f}))))
({ DumpParsedAst.hs:14:28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:14:28 }
(Unqual
@@ -275,18 +275,18 @@
[])))))
,({ DumpParsedAst.hs:16:1-48 }
(TyClD
- (NoExt)
+ (NoExtField)
(FamDecl
- (NoExt)
+ (NoExtField)
(FamilyDecl
- (NoExt)
+ (NoExtField)
(ClosedTypeFamily
(Just
[({ DumpParsedAst.hs:17:3-30 }
(HsIB
- (NoExt)
+ (NoExtField)
(FamEqn
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:17:3-4 }
(Unqual
{OccName: F1}))
@@ -295,7 +295,7 @@
{ DumpParsedAst.hs:17:6-11 }
({ DumpParsedAst.hs:17:7-11 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:17:7-11 }
(Unqual
@@ -303,7 +303,7 @@
,(HsValArg
({ DumpParsedAst.hs:17:13 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:17:13 }
(Unqual
@@ -311,7 +311,7 @@
,(HsValArg
({ DumpParsedAst.hs:17:15 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:17:15 }
(Unqual
@@ -319,37 +319,37 @@
(Prefix)
({ DumpParsedAst.hs:17:19-30 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:17:19-28 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:17:19-26 }
(HsAppKindTy
{ DumpParsedAst.hs:17:21-26 }
({ DumpParsedAst.hs:17:19 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:17:19 }
(Unqual
{OccName: T}))))
({ DumpParsedAst.hs:17:22-26 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:17:22-26 }
(Unqual
{OccName: Peano}))))))
({ DumpParsedAst.hs:17:28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:17:28 }
(Unqual
{OccName: f}))))))
({ DumpParsedAst.hs:17:30 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:17:30 }
(Unqual
@@ -358,39 +358,39 @@
(Unqual
{OccName: F1}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ DumpParsedAst.hs:16:17-22 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:16:17 }
(Unqual
{OccName: a}))
({ DumpParsedAst.hs:16:22 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:16:22 }
(Unqual
{OccName: k}))))))
,({ DumpParsedAst.hs:16:26-39 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:16:26 }
(Unqual
{OccName: f}))
({ DumpParsedAst.hs:16:31-39 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:16:31 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:16:31 }
(Unqual
{OccName: k}))))
({ DumpParsedAst.hs:16:36-39 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:16:36-39 }
(Unqual
@@ -398,10 +398,10 @@
(Prefix)
({ DumpParsedAst.hs:16:42-48 }
(KindSig
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:16:45-48 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpParsedAst.hs:16:45-48 }
(Unqual
@@ -409,18 +409,18 @@
(Nothing)))))
,({ DumpParsedAst.hs:19:1-23 }
(ValD
- (NoExt)
+ (NoExtField)
(FunBind
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:19:1-4 }
(Unqual
{OccName: main}))
(MG
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:19:1-23 }
[({ DumpParsedAst.hs:19:1-23 }
(Match
- (NoExt)
+ (NoExtField)
(FunRhs
({ DumpParsedAst.hs:19:1-4 }
(Unqual
@@ -429,32 +429,34 @@
(NoSrcStrict))
[]
(GRHSs
- (NoExt)
+ (NoExtField)
[({ DumpParsedAst.hs:19:6-23 }
(GRHS
- (NoExt)
+ (NoExtField)
[]
({ DumpParsedAst.hs:19:8-23 }
(HsApp
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:19:8-15 }
(HsVar
- (NoExt)
+ (NoExtField)
({ DumpParsedAst.hs:19:8-15 }
(Unqual
{OccName: putStrLn}))))
({ DumpParsedAst.hs:19:17-23 }
(HsLit
- (NoExt)
+ (NoExtField)
(HsString
(SourceText
"\"hello\"")
{FastString: "hello"})))))))]
({ <no location info> }
(EmptyLocalBinds
- (NoExt))))))])
+ (NoExtField))))))])
(FromSource))
(WpHole)
[])))]
(Nothing)
(Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 48b880b16df1647b9834c60f8ec1ba8635089d25..49ec1d111a712b687e6d2502c4903503fcc24b7c 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -4,7 +4,7 @@
(Just
((,,,)
(HsGroup
- (NoExt)
+ (NoExtField)
(XValBindsLR
(NValBinds
[((,)
@@ -17,11 +17,11 @@
({ DumpRenamedAst.hs:26:1-4 }
{Name: DumpRenamedAst.main})
(MG
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:26:1-23 }
[({ DumpRenamedAst.hs:26:1-23 }
(Match
- (NoExt)
+ (NoExtField)
(FunRhs
({ DumpRenamedAst.hs:26:1-4 }
{Name: DumpRenamedAst.main})
@@ -29,36 +29,36 @@
(NoSrcStrict))
[]
(GRHSs
- (NoExt)
+ (NoExtField)
[({ DumpRenamedAst.hs:26:6-23 }
(GRHS
- (NoExt)
+ (NoExtField)
[]
({ DumpRenamedAst.hs:26:8-23 }
(HsApp
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:26:8-15 }
(HsVar
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:26:8-15 }
{Name: System.IO.putStrLn})))
({ DumpRenamedAst.hs:26:17-23 }
(HsLit
- (NoExt)
+ (NoExtField)
(HsString
(SourceText
"\"hello\"")
{FastString: "hello"})))))))]
({ <no location info> }
(EmptyLocalBinds
- (NoExt))))))])
+ (NoExtField))))))])
(FromSource))
(WpHole)
[]))]})]
[]))
[]
[(TyClGroup
- (NoExt)
+ (NoExtField)
[({ DumpRenamedAst.hs:9:1-30 }
(DataDecl
(DataDeclRn
@@ -72,7 +72,7 @@
[])
(Prefix)
(HsDataDefn
- (NoExt)
+ (NoExtField)
(DataType)
({ <no location info> }
[])
@@ -80,7 +80,7 @@
(Nothing)
[({ DumpRenamedAst.hs:9:14-17 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:9:14-17 }
{Name: DumpRenamedAst.Zero})
({ <no location info> }
@@ -92,7 +92,7 @@
(Nothing)))
,({ DumpRenamedAst.hs:9:21-30 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:9:21-24 }
{Name: DumpRenamedAst.Succ})
({ <no location info> }
@@ -102,7 +102,7 @@
(PrefixCon
[({ DumpRenamedAst.hs:9:26-30 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:9:26-30 }
{Name: DumpRenamedAst.Peano})))])
@@ -112,12 +112,12 @@
[]
[])
,(TyClGroup
- (NoExt)
+ (NoExtField)
[({ DumpRenamedAst.hs:11:1-39 }
(FamDecl
- (NoExt)
+ (NoExtField)
(FamilyDecl
- (NoExt)
+ (NoExtField)
(ClosedTypeFamily
(Just
[({ DumpRenamedAst.hs:12:3-36 }
@@ -125,20 +125,20 @@
[{Name: a}
,{Name: as}]
(FamEqn
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:12:3-8 }
{Name: DumpRenamedAst.Length})
(Nothing)
[(HsValArg
({ DumpRenamedAst.hs:12:10-17 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:12:11-16 }
(HsOpTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:12:11 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:12:11 }
{Name: a})))
@@ -146,35 +146,35 @@
{Name: :})
({ DumpRenamedAst.hs:12:15-16 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:12:15-16 }
{Name: as}))))))))]
(Prefix)
({ DumpRenamedAst.hs:12:21-36 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:12:21-24 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:12:21-24 }
{Name: DumpRenamedAst.Succ})))
({ DumpRenamedAst.hs:12:26-36 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:12:27-35 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:12:27-32 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:12:27-32 }
{Name: DumpRenamedAst.Length})))
({ DumpRenamedAst.hs:12:34-35 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:12:34-35 }
{Name: as}))))))))))))
@@ -182,20 +182,20 @@
(HsIB
[]
(FamEqn
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:13:3-8 }
{Name: DumpRenamedAst.Length})
(Nothing)
[(HsValArg
({ DumpRenamedAst.hs:13:10-12 }
(HsExplicitListTy
- (NoExt)
+ (NoExtField)
(IsPromoted)
[])))]
(Prefix)
({ DumpRenamedAst.hs:13:21-24 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:13:21-24 }
{Name: DumpRenamedAst.Zero}))))))]))
@@ -205,25 +205,25 @@
[{Name: k}]
[({ DumpRenamedAst.hs:11:21-29 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:11:21-22 }
{Name: as})
({ DumpRenamedAst.hs:11:27-29 }
(HsListTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:11:28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:11:28 }
{Name: k})))))))])
(Prefix)
({ DumpRenamedAst.hs:11:32-39 }
(KindSig
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:11:35-39 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:11:35-39 }
{Name: DumpRenamedAst.Peano})))))
@@ -231,12 +231,12 @@
[]
[])
,(TyClGroup
- (NoExt)
+ (NoExtField)
[({ DumpRenamedAst.hs:15:1-33 }
(FamDecl
- (NoExt)
+ (NoExtField)
(FamilyDecl
- (NoExt)
+ (NoExtField)
(DataFamily)
({ DumpRenamedAst.hs:15:13-15 }
{Name: DumpRenamedAst.Nat})
@@ -246,28 +246,28 @@
(Prefix)
({ DumpRenamedAst.hs:15:17-33 }
(KindSig
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:15:20-33 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:15:20 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:15:20 }
{Name: k})))
({ DumpRenamedAst.hs:15:25-33 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:15:25 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:15:25 }
{Name: k})))
({ DumpRenamedAst.hs:15:30-33 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:15:30-33 }
{Name: GHC.Types.Type})))))))))
@@ -275,47 +275,47 @@
[]
[({ DumpRenamedAst.hs:(18,1)-(19,45) }
(DataFamInstD
- (NoExt)
+ (NoExtField)
(DataFamInstDecl
(HsIB
[{Name: a}
,{Name: k}]
(FamEqn
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:18:18-20 }
{Name: DumpRenamedAst.Nat})
(Nothing)
[(HsValArg
({ DumpRenamedAst.hs:18:22-37 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:18:23-36 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:18:23 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:18:23 }
{Name: a})))
({ DumpRenamedAst.hs:18:28-36 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:18:28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:18:28 }
{Name: k})))
({ DumpRenamedAst.hs:18:33-36 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:18:33-36 }
{Name: GHC.Types.Type}))))))))))]
(Prefix)
(HsDataDefn
- (NoExt)
+ (NoExtField)
(NewType)
({ <no location info> }
[])
@@ -323,34 +323,34 @@
(Just
({ DumpRenamedAst.hs:18:42-60 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:18:42-52 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:18:43-51 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:18:43 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:18:43 }
{Name: k})))
({ DumpRenamedAst.hs:18:48-51 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:18:48-51 }
{Name: GHC.Types.Type})))))))
({ DumpRenamedAst.hs:18:57-60 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:18:57-60 }
{Name: GHC.Types.Type}))))))
[({ DumpRenamedAst.hs:19:3-45 }
(ConDeclGADT
- (NoExt)
+ (NoExtField)
[({ DumpRenamedAst.hs:19:3-5 }
{Name: DumpRenamedAst.Nat})]
({ DumpRenamedAst.hs:19:10-45 }
@@ -363,70 +363,70 @@
(PrefixCon
[({ DumpRenamedAst.hs:19:10-34 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:19:11-33 }
(HsForAllTy
- (NoExt)
+ (NoExtField)
(ForallInvis)
[({ DumpRenamedAst.hs:19:18-19 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:19:18-19 }
{Name: xx})))]
({ DumpRenamedAst.hs:19:22-33 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:19:22-25 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:19:22 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:19:22 }
{Name: f})))
({ DumpRenamedAst.hs:19:24-25 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:19:24-25 }
{Name: xx})))))
({ DumpRenamedAst.hs:19:30-33 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:19:30 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:19:30 }
{Name: g})))
({ DumpRenamedAst.hs:19:32-33 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:19:32-33 }
{Name: xx})))))))))))])
({ DumpRenamedAst.hs:19:39-45 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:19:39-43 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:19:39-41 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:19:39-41 }
{Name: DumpRenamedAst.Nat})))
({ DumpRenamedAst.hs:19:43 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:19:43 }
{Name: f})))))
({ DumpRenamedAst.hs:19:45 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:19:45 }
{Name: g})))))
@@ -434,7 +434,7 @@
({ <no location info> }
[])))))))])
,(TyClGroup
- (NoExt)
+ (NoExtField)
[({ DumpRenamedAst.hs:21:1-29 }
(DataDecl
(DataDeclRn
@@ -448,23 +448,23 @@
[{Name: k}]
[({ DumpRenamedAst.hs:21:8 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:21:8 }
{Name: f})))
,({ DumpRenamedAst.hs:21:11-16 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:21:11 }
{Name: a})
({ DumpRenamedAst.hs:21:16 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:21:16 }
{Name: k})))))])
(Prefix)
(HsDataDefn
- (NoExt)
+ (NoExtField)
(DataType)
({ <no location info> }
[])
@@ -472,7 +472,7 @@
(Nothing)
[({ DumpRenamedAst.hs:21:21-29 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:21:21-23 }
{Name: DumpRenamedAst.MkT})
({ <no location info> }
@@ -482,19 +482,19 @@
(PrefixCon
[({ DumpRenamedAst.hs:21:25-29 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:21:26-28 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:21:26 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:21:26 }
{Name: f})))
({ DumpRenamedAst.hs:21:28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:21:28 }
{Name: a})))))))])
@@ -504,12 +504,12 @@
[]
[])
,(TyClGroup
- (NoExt)
+ (NoExtField)
[({ DumpRenamedAst.hs:23:1-48 }
(FamDecl
- (NoExt)
+ (NoExtField)
(FamilyDecl
- (NoExt)
+ (NoExtField)
(ClosedTypeFamily
(Just
[({ DumpRenamedAst.hs:24:3-30 }
@@ -517,7 +517,7 @@
[{Name: a}
,{Name: f}]
(FamEqn
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:24:3-4 }
{Name: DumpRenamedAst.F1})
(Nothing)
@@ -525,55 +525,55 @@
{ DumpRenamedAst.hs:24:6-11 }
({ DumpRenamedAst.hs:24:7-11 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:24:7-11 }
{Name: DumpRenamedAst.Peano}))))
,(HsValArg
({ DumpRenamedAst.hs:24:13 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:24:13 }
{Name: a}))))
,(HsValArg
({ DumpRenamedAst.hs:24:15 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:24:15 }
{Name: f}))))]
(Prefix)
({ DumpRenamedAst.hs:24:19-30 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:24:19-28 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:24:19-26 }
(HsAppKindTy
{ DumpRenamedAst.hs:24:21-26 }
({ DumpRenamedAst.hs:24:19 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:24:19 }
{Name: DumpRenamedAst.T})))
({ DumpRenamedAst.hs:24:22-26 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:24:22-26 }
{Name: DumpRenamedAst.Peano})))))
({ DumpRenamedAst.hs:24:28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:24:28 }
{Name: f})))))
({ DumpRenamedAst.hs:24:30 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:24:30 }
{Name: a}))))))))]))
@@ -583,42 +583,42 @@
[{Name: k}]
[({ DumpRenamedAst.hs:23:17-22 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:23:17 }
{Name: a})
({ DumpRenamedAst.hs:23:22 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:23:22 }
{Name: k})))))
,({ DumpRenamedAst.hs:23:26-39 }
(KindedTyVar
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:23:26 }
{Name: f})
({ DumpRenamedAst.hs:23:31-39 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:23:31 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:23:31 }
{Name: k})))
({ DumpRenamedAst.hs:23:36-39 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:23:36-39 }
{Name: GHC.Types.Type})))))))])
(Prefix)
({ DumpRenamedAst.hs:23:42-48 }
(KindSig
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:23:45-48 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ DumpRenamedAst.hs:23:45-48 }
{Name: GHC.Types.Type})))))
@@ -635,7 +635,7 @@
[])
[({ DumpRenamedAst.hs:4:8-21 }
(ImportDecl
- (NoExt)
+ (NoExtField)
(NoSourceText)
({ DumpRenamedAst.hs:4:8-21 }
{ModuleName: Prelude})
@@ -648,7 +648,7 @@
(Nothing)))
,({ DumpRenamedAst.hs:5:1-16 }
(ImportDecl
- (NoExt)
+ (NoExtField)
(NoSourceText)
({ DumpRenamedAst.hs:5:8-16 }
{ModuleName: Data.Kind})
@@ -661,7 +661,7 @@
(Nothing)))
,({ DumpRenamedAst.hs:7:1-23 }
(ImportDecl
- (NoExt)
+ (NoExtField)
(NoSourceText)
({ DumpRenamedAst.hs:7:8-16 }
{ModuleName: Data.Kind})
@@ -677,10 +677,12 @@
({ DumpRenamedAst.hs:7:18-23 }
[({ DumpRenamedAst.hs:7:19-22 }
(IEThingAbs
- (NoExt)
+ (NoExtField)
({ DumpRenamedAst.hs:7:19-22 }
(IEName
({ DumpRenamedAst.hs:7:19-22 }
{Name: GHC.Types.Type})))))])))))]
(Nothing)
(Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
index 7c6bfd72d0049c8353816c1c0d1786b303194ab9..6aa8aa45780b79ae91fe578b3615f51c43355a61 100644
--- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
@@ -4,350 +4,350 @@
{Bag(Located (HsBind Var)):
[({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: DumpTypecheckedAst.$tcT}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (1374752024144278257) (NoSourceText)}))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (13654949607623281177) (NoSourceText)}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: DumpTypecheckedAst.$trModule})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsStringPrim
(NoSourceText)
"T")))))))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsInt{64}Prim (1) (SourceText
"1")}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: DumpTypecheckedAst.$tc'MkT}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (10715337633704422415) (NoSourceText)}))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (12411373583424111944) (NoSourceText)}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: DumpTypecheckedAst.$trModule})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsStringPrim
(NoSourceText)
"'MkT")))))))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsInt{64}Prim (3) (SourceText
"3")}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: DumpTypecheckedAst.$tcPeano}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (14073232900889011755) (NoSourceText)}))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (2739668351064589274) (NoSourceText)}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: DumpTypecheckedAst.$trModule})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsStringPrim
(NoSourceText)
"Peano")))))))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsInt{64}Prim (0) (SourceText
"0")}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: GHC.Types.krep$*})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: DumpTypecheckedAst.$tc'Zero}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (13760111476013868540) (NoSourceText)}))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (12314848029315386153) (NoSourceText)}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: DumpTypecheckedAst.$trModule})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsStringPrim
(NoSourceText)
"'Zero")))))))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsInt{64}Prim (0) (SourceText
"0")}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: DumpTypecheckedAst.$tc'Succ}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (1143980031331647856) (NoSourceText)}))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsWord{64}Prim (14802086722010293686) (NoSourceText)}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: DumpTypecheckedAst.$trModule})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsStringPrim
(NoSourceText)
"'Succ")))))))))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
{HsInt{64}Prim (0) (SourceText
"0")}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsInt
- (NoExt)
+ (NoExtField)
(IL
(SourceText
"2")
@@ -356,20 +356,20 @@
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsInt
- (NoExt)
+ (NoExtField)
(IL
(SourceText
"1")
@@ -378,20 +378,20 @@
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsInt
- (NoExt)
+ (NoExtField)
(IL
(SourceText
"0")
@@ -400,315 +400,315 @@
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: GHC.Types.krep$*})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: DumpTypecheckedAst.$tcT})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsWrap
- (NoExt)
+ (NoExtField)
(WpTyApp
(TyConApp
({abstract:TyCon})
[]))
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsWrap
- (NoExt)
+ (NoExtField)
(WpTyApp
(TyConApp
({abstract:TyCon})
[]))
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsWrap
- (NoExt)
+ (NoExtField)
(WpTyApp
(TyConApp
({abstract:TyCon})
[]))
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike}))))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: $krep})))))
({ <no location info> }
(HsWrap
- (NoExt)
+ (NoExtField)
(WpTyApp
(TyConApp
({abstract:TyCon})
[]))
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike}))))))))))))))))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: $krep}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: DumpTypecheckedAst.$tcPeano})))))
({ <no location info> }
(HsWrap
- (NoExt)
+ (NoExtField)
(WpTyApp
(TyConApp
({abstract:TyCon})
[]))
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike}))))))
(False)))
,({ <no location info> }
(VarBind
- (NoExt)
+ (NoExtField)
{Var: DumpTypecheckedAst.$trModule}
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsStringPrim
(NoSourceText)
"main")))))))))
({ <no location info> }
(HsPar
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsApp
- (NoExt)
+ (NoExtField)
({ <no location info> }
(HsConLikeOut
- (NoExt)
+ (NoExtField)
({abstract:ConLike})))
({ <no location info> }
(HsLit
- (NoExt)
+ (NoExtField)
(HsStringPrim
(NoSourceText)
"DumpTypecheckedAst")))))))))
(False)))
,({ DumpTypecheckedAst.hs:18:1-23 }
(AbsBinds
- (NoExt)
+ (NoExtField)
[]
[]
[(ABE
- (NoExt)
+ (NoExtField)
{Var: main}
{Var: main}
(WpHole)
@@ -733,7 +733,7 @@
({ DumpTypecheckedAst.hs:18:1-23 }
[({ DumpTypecheckedAst.hs:18:1-23 }
(Match
- (NoExt)
+ (NoExtField)
(FunRhs
({ DumpTypecheckedAst.hs:18:1-4 }
{Name: main})
@@ -741,29 +741,29 @@
(NoSrcStrict))
[]
(GRHSs
- (NoExt)
+ (NoExtField)
[({ DumpTypecheckedAst.hs:18:6-23 }
(GRHS
- (NoExt)
+ (NoExtField)
[]
({ DumpTypecheckedAst.hs:18:8-23 }
(HsApp
- (NoExt)
+ (NoExtField)
({ DumpTypecheckedAst.hs:18:8-15 }
(HsVar
- (NoExt)
+ (NoExtField)
({ <no location info> }
{Var: putStrLn})))
({ DumpTypecheckedAst.hs:18:17-23 }
(HsLit
- (NoExt)
+ (NoExtField)
(HsString
(SourceText
"\"hello\"")
{FastString: "hello"})))))))]
({ <no location info> }
(EmptyLocalBinds
- (NoExt))))))])
+ (NoExtField))))))])
(FromSource))
(WpHole)
[]))]}
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index 6c7ef797a160b84e6a05d1f8ef3586f3339f6591..4612d87cad124bac80eee8ea95ca8f9cabed5aa1 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -9,7 +9,7 @@
(Nothing)
[({ KindSigs.hs:8:1-16 }
(ImportDecl
- (NoExt)
+ (NoExtField)
(NoSourceText)
({ KindSigs.hs:8:8-16 }
{ModuleName: Data.Kind})
@@ -22,18 +22,18 @@
(Nothing)))]
[({ KindSigs.hs:11:1-17 }
(TyClD
- (NoExt)
+ (NoExtField)
(FamDecl
- (NoExt)
+ (NoExtField)
(FamilyDecl
- (NoExt)
+ (NoExtField)
(ClosedTypeFamily
(Just
[({ KindSigs.hs:12:3-21 }
(HsIB
- (NoExt)
+ (NoExtField)
(FamEqn
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:12:3-5 }
(Unqual
{OccName: Foo}))
@@ -41,7 +41,7 @@
[(HsValArg
({ KindSigs.hs:12:7 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:12:7 }
(Unqual
@@ -49,17 +49,17 @@
(Prefix)
({ KindSigs.hs:12:11-21 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:12:11-13 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:12:11-13 }
(Unqual
{OccName: Int}))))
({ KindSigs.hs:12:18-21 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:12:18-21 }
(Unqual
@@ -68,271 +68,271 @@
(Unqual
{OccName: Foo}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:11:17 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:11:17 }
(Unqual
{OccName: a}))))])
(Prefix)
({ <no location info> }
(NoSig
- (NoExt)))
+ (NoExtField)))
(Nothing)))))
,({ KindSigs.hs:15:1-51 }
(TyClD
- (NoExt)
+ (NoExtField)
(SynDecl
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:15:6-8 }
(Unqual
{OccName: Bar}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:15:10 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:15:10 }
(Unqual
{OccName: a}))))])
(Prefix)
({ KindSigs.hs:15:14-51 }
(HsTupleTy
- (NoExt)
+ (NoExtField)
(HsBoxedOrConstraintTuple)
[({ KindSigs.hs:15:16-26 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:15:16-18 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:15:16-18 }
(Unqual
{OccName: Int}))))
({ KindSigs.hs:15:23-26 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:15:23-26 }
(Unqual
{OccName: Type}))))))
,({ KindSigs.hs:15:29-32 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:15:29-32 }
(Unqual
{OccName: Bool}))))
,({ KindSigs.hs:15:35-49 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:15:35-41 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:15:35-39 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:15:35-39 }
(Unqual
{OccName: Maybe}))))
({ KindSigs.hs:15:41 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:15:41 }
(Unqual
{OccName: a}))))))
({ KindSigs.hs:15:46-49 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:15:46-49 }
(Unqual
{OccName: Type}))))))])))))
,({ KindSigs.hs:16:1-54 }
(TyClD
- (NoExt)
+ (NoExtField)
(SynDecl
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:16:6-9 }
(Unqual
{OccName: Bar'}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:16:11 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:16:11 }
(Unqual
{OccName: a}))))])
(Prefix)
({ KindSigs.hs:16:15-54 }
(HsTupleTy
- (NoExt)
+ (NoExtField)
(HsUnboxedTuple)
[({ KindSigs.hs:16:18-28 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:16:18-20 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:16:18-20 }
(Unqual
{OccName: Int}))))
({ KindSigs.hs:16:25-28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:16:25-28 }
(Unqual
{OccName: Type}))))))
,({ KindSigs.hs:16:31-34 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:16:31-34 }
(Unqual
{OccName: Bool}))))
,({ KindSigs.hs:16:37-51 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:16:37-43 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:16:37-41 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:16:37-41 }
(Unqual
{OccName: Maybe}))))
({ KindSigs.hs:16:43 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:16:43 }
(Unqual
{OccName: a}))))))
({ KindSigs.hs:16:48-51 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:16:48-51 }
(Unqual
{OccName: Type}))))))])))))
,({ KindSigs.hs:19:1-26 }
(TyClD
- (NoExt)
+ (NoExtField)
(SynDecl
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:19:6-8 }
(Unqual
{OccName: Baz}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[])
(Prefix)
({ KindSigs.hs:19:12-26 }
(HsListTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:19:14-24 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:19:14-16 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:19:14-16 }
(Unqual
{OccName: Int}))))
({ KindSigs.hs:19:21-24 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:19:21-24 }
(Unqual
{OccName: Type})))))))))))
,({ KindSigs.hs:22:1-44 }
(SigD
- (NoExt)
+ (NoExtField)
(TypeSig
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:22:1-3 }
(Unqual
{OccName: qux}))]
(HsWC
- (NoExt)
+ (NoExtField)
(HsIB
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:22:8-44 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:22:8-20 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:22:9-19 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:22:9-11 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:22:9-11 }
(Unqual
{OccName: Int}))))
({ KindSigs.hs:22:16-19 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:22:16-19 }
(Unqual
{OccName: Type}))))))))
({ KindSigs.hs:22:25-44 }
(HsFunTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:22:25-28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:22:25-28 }
(Unqual
{OccName: Bool}))))
({ KindSigs.hs:22:33-44 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:22:34-43 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:22:34-35 }
(HsTupleTy
- (NoExt)
+ (NoExtField)
(HsBoxedOrConstraintTuple)
[]))
({ KindSigs.hs:22:40-43 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:22:40-43 }
(Unqual
{OccName: Type})))))))))))))))))
,({ KindSigs.hs:23:1-12 }
(ValD
- (NoExt)
+ (NoExtField)
(FunBind
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:23:1-3 }
(Unqual
{OccName: qux}))
(MG
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:23:1-12 }
[({ KindSigs.hs:23:1-12 }
(Match
- (NoExt)
+ (NoExtField)
(FunRhs
({ KindSigs.hs:23:1-3 }
(Unqual
@@ -341,246 +341,246 @@
(NoSrcStrict))
[(XPat
({ KindSigs.hs:23:5 }
- (WildPat
- (NoExt))))
+ (WildPat
+ (NoExtField))))
,(XPat
({ KindSigs.hs:23:7 }
- (WildPat
- (NoExt))))]
+ (WildPat
+ (NoExtField))))]
(GRHSs
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:23:9-12 }
(GRHS
- (NoExt)
+ (NoExtField)
[]
({ KindSigs.hs:23:11-12 }
(HsVar
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:23:11-12 }
(Exact
{Name: ()}))))))]
({ <no location info> }
(EmptyLocalBinds
- (NoExt))))))])
+ (NoExtField))))))])
(FromSource))
(WpHole)
[])))
,({ KindSigs.hs:26:1-29 }
(TyClD
- (NoExt)
+ (NoExtField)
(SynDecl
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:26:6-9 }
(Unqual
{OccName: Quux}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[])
(Prefix)
({ KindSigs.hs:26:13-29 }
(HsExplicitListTy
- (NoExt)
+ (NoExtField)
(IsPromoted)
[({ KindSigs.hs:26:16-27 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:26:16-19 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:26:16-19 }
(Unqual
{OccName: True}))))
({ KindSigs.hs:26:24-27 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:26:24-27 }
(Unqual
{OccName: Bool}))))))])))))
,({ KindSigs.hs:27:1-45 }
(TyClD
- (NoExt)
+ (NoExtField)
(SynDecl
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:27:6-10 }
(Unqual
{OccName: Quux'}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[])
(Prefix)
({ KindSigs.hs:27:14-45 }
(HsExplicitListTy
- (NoExt)
+ (NoExtField)
(NotPromoted)
[({ KindSigs.hs:27:16-27 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:27:16-19 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:27:16-19 }
(Unqual
{OccName: True}))))
({ KindSigs.hs:27:24-27 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:27:24-27 }
(Unqual
{OccName: Bool}))))))
,({ KindSigs.hs:27:30-42 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:27:30-34 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:27:30-34 }
(Unqual
{OccName: False}))))
({ KindSigs.hs:27:39-42 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:27:39-42 }
(Unqual
{OccName: Bool}))))))])))))
,({ KindSigs.hs:28:1-44 }
(TyClD
- (NoExt)
+ (NoExtField)
(SynDecl
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:28:6-10 }
(Unqual
{OccName: Quuux}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:28:12 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:28:12 }
(Unqual
{OccName: b}))))])
(Prefix)
({ KindSigs.hs:28:16-44 }
(HsExplicitTupleTy
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:28:19-39 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:28:19-29 }
(HsExplicitListTy
- (NoExt)
+ (NoExtField)
(NotPromoted)
[({ KindSigs.hs:28:20-22 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:28:20-22 }
(Unqual
{OccName: Int}))))
,({ KindSigs.hs:28:25-28 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:28:25-28 }
(Unqual
{OccName: Bool}))))]))
({ KindSigs.hs:28:34-39 }
(HsListTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:28:35-38 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:28:35-38 }
(Unqual
{OccName: Type}))))))))
,({ KindSigs.hs:28:42 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:28:42 }
(Unqual
{OccName: b}))))])))))
,({ KindSigs.hs:31:1-31 }
(TyClD
- (NoExt)
+ (NoExtField)
(SynDecl
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:31:6-17 }
(Unqual
{OccName: Sarsaparilla}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[])
(Prefix)
({ KindSigs.hs:31:21-31 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:31:21-23 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:31:21-23 }
(Unqual
{OccName: Int}))))
({ KindSigs.hs:31:28-31 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:31:28-31 }
(Unqual
{OccName: Type})))))))))
,({ KindSigs.hs:34:1-22 }
(SigD
- (NoExt)
+ (NoExtField)
(TypeSig
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:34:1-4 }
(Unqual
{OccName: true}))]
(HsWC
- (NoExt)
+ (NoExtField)
(HsIB
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:34:9-22 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:34:10-21 }
(HsKindSig
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:34:10-13 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:34:10-13 }
(Unqual
{OccName: Bool}))))
({ KindSigs.hs:34:18-21 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ KindSigs.hs:34:18-21 }
(Unqual
{OccName: Type})))))))))))))
,({ KindSigs.hs:35:1-11 }
(ValD
- (NoExt)
+ (NoExtField)
(FunBind
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:35:1-4 }
(Unqual
{OccName: true}))
(MG
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:35:1-11 }
[({ KindSigs.hs:35:1-11 }
(Match
- (NoExt)
+ (NoExtField)
(FunRhs
({ KindSigs.hs:35:1-4 }
(Unqual
@@ -589,22 +589,24 @@
(NoSrcStrict))
[]
(GRHSs
- (NoExt)
+ (NoExtField)
[({ KindSigs.hs:35:6-11 }
(GRHS
- (NoExt)
+ (NoExtField)
[]
({ KindSigs.hs:35:8-11 }
(HsVar
- (NoExt)
+ (NoExtField)
({ KindSigs.hs:35:8-11 }
(Unqual
{OccName: True}))))))]
({ <no location info> }
(EmptyLocalBinds
- (NoExt))))))])
+ (NoExtField))))))])
(FromSource))
(WpHole)
[])))]
(Nothing)
(Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index e405262c5c565c6f1240d0a9938f64f0f547ebab..9e6b981bb8784c1d856535a84172a88a5f6aed1f 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -4,14 +4,14 @@
(Just
((,,,)
(HsGroup
- (NoExt)
+ (NoExtField)
(XValBindsLR
(NValBinds
[]
[]))
[]
[(TyClGroup
- (NoExt)
+ (NoExtField)
[({ T14189.hs:6:1-42 }
(DataDecl
(DataDeclRn
@@ -25,7 +25,7 @@
[])
(Prefix)
(HsDataDefn
- (NoExt)
+ (NoExtField)
(DataType)
({ <no location info> }
[])
@@ -33,7 +33,7 @@
(Nothing)
[({ T14189.hs:6:15-20 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ T14189.hs:6:15-16 }
{Name: T14189.MT})
({ <no location info> }
@@ -43,14 +43,14 @@
(PrefixCon
[({ T14189.hs:6:18-20 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ T14189.hs:6:18-20 }
{Name: GHC.Types.Int})))])
(Nothing)))
,({ T14189.hs:6:24-25 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ T14189.hs:6:24-25 }
{Name: T14189.NT})
({ <no location info> }
@@ -62,7 +62,7 @@
(Nothing)))
,({ T14189.hs:6:29-42 }
(ConDeclH98
- (NoExt)
+ (NoExtField)
({ T14189.hs:6:29 }
{Name: T14189.F})
({ <no location info> }
@@ -73,7 +73,7 @@
({ T14189.hs:6:31-42 }
[({ T14189.hs:6:33-40 }
(ConDeclField
- (NoExt)
+ (NoExtField)
[({ T14189.hs:6:33 }
(FieldOcc
{Name: T14189.f}
@@ -82,7 +82,7 @@
{OccName: f}))))]
({ T14189.hs:6:38-40 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ T14189.hs:6:38-40 }
{Name: GHC.Types.Int})))
@@ -102,7 +102,7 @@
[])
[({ T14189.hs:1:8-13 }
(ImportDecl
- (NoExt)
+ (NoExtField)
(NoSourceText)
({ T14189.hs:1:8-13 }
{ModuleName: Prelude})
@@ -117,7 +117,7 @@
[((,)
({ T14189.hs:3:3-15 }
(IEThingWith
- (NoExt)
+ (NoExtField)
({ T14189.hs:3:3-8 }
(IEName
({ T14189.hs:3:3-8 }
@@ -141,3 +141,5 @@
(False)
{Name: T14189.f})])])])
(Nothing)))
+
+
diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr
index 93b254bf3213131508a37859ebd58ff792cd47b2..25b0ed002dcf7a09aa6339597dffa576ec3668f2 100644
--- a/testsuite/tests/parser/should_compile/T15323.stderr
+++ b/testsuite/tests/parser/should_compile/T15323.stderr
@@ -10,23 +10,23 @@
[]
[({ T15323.hs:(5,1)-(6,56) }
(TyClD
- (NoExt)
+ (NoExtField)
(DataDecl
- (NoExt)
+ (NoExtField)
({ T15323.hs:5:6-17 }
(Unqual
{OccName: MaybeDefault}))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ T15323.hs:5:19 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ T15323.hs:5:19 }
(Unqual
{OccName: v}))))])
(Prefix)
(HsDataDefn
- (NoExt)
+ (NoExtField)
(DataType)
({ <no location info> }
[])
@@ -34,17 +34,17 @@
(Nothing)
[({ T15323.hs:6:5-56 }
(ConDeclGADT
- (NoExt)
+ (NoExtField)
[({ T15323.hs:6:5-14 }
(Unqual
{OccName: TestParens}))]
({ T15323.hs:6:21-55 }
(True))
(HsQTvs
- (NoExt)
+ (NoExtField)
[({ T15323.hs:6:28 }
(UserTyVar
- (NoExt)
+ (NoExtField)
({ T15323.hs:6:28 }
(Unqual
{OccName: v}))))])
@@ -52,20 +52,20 @@
({ T15323.hs:6:32-37 }
[({ T15323.hs:6:32-37 }
(HsParTy
- (NoExt)
+ (NoExtField)
({ T15323.hs:6:33-36 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ T15323.hs:6:33-34 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ T15323.hs:6:33-34 }
(Unqual
{OccName: Eq}))))
({ T15323.hs:6:36 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ T15323.hs:6:36 }
(Unqual
@@ -74,17 +74,17 @@
[])
({ T15323.hs:6:42-55 }
(HsAppTy
- (NoExt)
+ (NoExtField)
({ T15323.hs:6:42-53 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ T15323.hs:6:42-53 }
(Unqual
{OccName: MaybeDefault}))))
({ T15323.hs:6:55 }
(HsTyVar
- (NoExt)
+ (NoExtField)
(NotPromoted)
({ T15323.hs:6:55 }
(Unqual
@@ -94,3 +94,5 @@
[])))))]
(Nothing)
(Nothing)))
+
+
diff --git a/utils/haddock b/utils/haddock
index 5e333bad752b9c048ad5400b7159e32f4d3d65bd..658ad4af237f3da196cca083ad525375260e38a7 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 5e333bad752b9c048ad5400b7159e32f4d3d65bd
+Subproject commit 658ad4af237f3da196cca083ad525375260e38a7