Commit 6a03d77b authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

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.
parent 5af815f2
......@@ -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
......
......@@ -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)
......
......@@ -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 ()
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
{-
************************************************************************
......
......@@ -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@
......
......@@ -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
......
......@@ -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