summaryrefslogtreecommitdiff
path: root/compiler/deSugar
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2019-03-19 17:47:55 -0400
committerBen Gamari <ben@well-typed.com>2019-07-09 11:52:45 -0400
commit6a03d77b9a9915e4b37fe1ea6688c135e7b00654 (patch)
tree4154abaa768adbfadc4eb17db620c3ed08b82c5f /compiler/deSugar
parent5af815f2e43e9f1b5ca9ec0803f9fccabb49e2fe (diff)
downloadhaskell-6a03d77b9a9915e4b37fe1ea6688c135e7b00654.tar.gz
Use an empty data type in TTG extension constructors (#15247)
To avoid having to `panic` any time a TTG extension constructor is consumed, this MR introduces an uninhabited 'NoExtCon' type and uses that in every extension constructor's type family instance where it is appropriate. This also introduces a 'noExtCon' function which eliminates a 'NoExtCon', much like 'Data.Void.absurd' eliminates a 'Void'. I also renamed the existing `NoExt` type to `NoExtField` to better distinguish it from `NoExtCon`. Unsurprisingly, there is a lot of code churn resulting from this. Bumps the Haddock submodule. Fixes #15247.
Diffstat (limited to 'compiler/deSugar')
-rw-r--r--compiler/deSugar/Check.hs14
-rw-r--r--compiler/deSugar/Coverage.hs46
-rw-r--r--compiler/deSugar/Desugar.hs2
-rw-r--r--compiler/deSugar/DsArrows.hs12
-rw-r--r--compiler/deSugar/DsBinds.hs8
-rw-r--r--compiler/deSugar/DsExpr.hs18
-rw-r--r--compiler/deSugar/DsForeign.hs2
-rw-r--r--compiler/deSugar/DsGRHSs.hs8
-rw-r--r--compiler/deSugar/DsListComp.hs16
-rw-r--r--compiler/deSugar/DsMeta.hs62
-rw-r--r--compiler/deSugar/DsUtils.hs6
-rw-r--r--compiler/deSugar/ExtractDocs.hs26
-rw-r--r--compiler/deSugar/Match.hs16
-rw-r--r--compiler/deSugar/MatchLit.hs8
14 files changed, 122 insertions, 122 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index d30cb95515..4a5d978370 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 59b8bcfc78..ce902f4970 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 128722d5b5..2c0b4139a6 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 f86f364cb2..956eb1d098 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 a87a4bbcbb..96855a61b7 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 9516fbbe82..73edf8c2de 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 3ecd9bfead..545f26c3f6 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 277ea00044..5adc661388 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 f376ef0b4b..9755bf695b 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 25f5ec0ab1..a8d2b7de0f 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 d4ceb523df..c4abd16737 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 d2b191349d..ce5299443b 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 c057298420..921b829fb9 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 d99ae7e443..3bab8cf000 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
View Lorry Controller Status