summaryrefslogtreecommitdiff
path: root/compiler/GHC/HsToCore
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/HsToCore')
-rw-r--r--compiler/GHC/HsToCore/Arrows.hs6
-rw-r--r--compiler/GHC/HsToCore/Binds.hs3
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs28
-rw-r--r--compiler/GHC/HsToCore/Docs.hs8
-rw-r--r--compiler/GHC/HsToCore/Expr.hs7
-rw-r--r--compiler/GHC/HsToCore/Foreign/Decl.hs2
-rw-r--r--compiler/GHC/HsToCore/GuardedRHSs.hs4
-rw-r--r--compiler/GHC/HsToCore/ListComp.hs8
-rw-r--r--compiler/GHC/HsToCore/Match.hs3
-rw-r--r--compiler/GHC/HsToCore/Match/Literal.hs2
-rw-r--r--compiler/GHC/HsToCore/PmCheck.hs5
-rw-r--r--compiler/GHC/HsToCore/Quote.hs71
12 files changed, 7 insertions, 140 deletions
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 479e804ecf..0371d37e31 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -333,7 +333,6 @@ dsProcExpr pat (L _ (HsCmdTop (CmdTopTc _unitTy cmd_ty ids) cmd)) = do
(Lam var match_code)
core_cmd
return (mkLets meth_binds proc_code)
-dsProcExpr _ _ = panic "dsProcExpr"
{-
Translation of a command judgement of the form
@@ -721,7 +720,6 @@ dsTrimCmdArg local_vars env_ids
arg_code = if env_ids' == env_ids then core_cmd else
do_premap meth_ids in_ty in_ty' cmd_ty trim_code core_cmd
return (mkLets meth_binds arg_code, free_vars)
-dsTrimCmdArg _ _ _ = panic "dsTrimCmdArg"
-- Given D; xs |-a c : stk --> t, builds c with xs fed back.
-- Typically needs to be prefixed with arr (\(p, stk) -> ((xs),stk))
@@ -1151,7 +1149,6 @@ leavesMatch (L _ (Match { m_pats = pats
mkVarSet (collectLStmtsBinders stmts)
`unionVarSet` defined_vars)
| L _ (GRHS _ stmts body) <- grhss]
-leavesMatch _ = panic "leavesMatch"
-- Replace the leaf commands in a match
@@ -1168,7 +1165,6 @@ replaceLeavesMatch _res_ty leaves
(leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
in
(leaves', L loc (match { m_ext = noExtField, m_grhss = GRHSs x grhss' binds }))
-replaceLeavesMatch _ _ _ = panic "replaceLeavesMatch"
replaceLeavesGRHS
:: [Located (body' GhcTc)] -- replacement leaf expressions of that type
@@ -1178,7 +1174,6 @@ replaceLeavesGRHS
replaceLeavesGRHS (leaf:leaves) (L loc (GRHS x stmts _))
= (leaves, L loc (GRHS x stmts leaf))
replaceLeavesGRHS [] _ = panic "replaceLeavesGRHS []"
-replaceLeavesGRHS _ _ = panic "replaceLeavesGRHS"
-- Balanced fold of a non-empty list.
@@ -1248,7 +1243,6 @@ collectl (L _ pat) bndrs
go (CoPat _ _ pat _) = collectl (noLoc pat) bndrs
go (ViewPat _ _ pat) = collectl pat bndrs
go p@(SplicePat {}) = pprPanic "collectl/go" (ppr p)
- go (XPat nec) = noExtCon nec
collectEvBinders :: TcEvBinds -> [Id]
collectEvBinders (EvBinds bs) = foldr add_ev_bndr [] bs
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index e5e7838834..cdd73c9171 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -205,7 +205,6 @@ 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 nec) = noExtCon nec
-----------------------
@@ -265,7 +264,6 @@ dsAbsBinds dflags tyvars dicts exports
; return (makeCorePair dflags global
(isDefaultMethod prags)
0 (core_wrap (Var local))) }
- mk_bind (XABExport nec) = noExtCon nec
; main_binds <- mapM mk_bind exports
; return (force_vars, flattenBinds ds_ev_binds ++ bind_prs ++ main_binds) }
@@ -310,7 +308,6 @@ 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 nec) = noExtCon nec
; export_binds_s <- mapM mk_bind (exports ++ extra_exports)
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index ba15a8b8e6..3b6da2c5bb 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -304,10 +304,6 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = L _ id }))) = do
addPathEntry name $
addTickMatchGroup False (fun_matches funBind)
- case mg of
- MG {} -> return ()
- _ -> panic "addTickLHsBind"
-
blackListed <- isBlackListed pos
exported_names <- liftM exports getEnv
@@ -378,7 +374,6 @@ addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
-- Only internal stuff, not from source, uses VarBind, so we ignore it.
addTickLHsBind var_bind@(L _ (VarBind {})) = return var_bind
addTickLHsBind patsyn_bind@(L _ (PatSynBind {})) = return patsyn_bind
-addTickLHsBind bind@(L _ (XHsBindsLR {})) = return bind
bindTick
:: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
@@ -647,7 +642,6 @@ addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
addTickTupArg (L l (Present x e)) = do { e' <- addTickLHsExpr e
; return (L l (Present x e')) }
addTickTupArg (L l (Missing ty)) = return (L l (Missing ty))
-addTickTupArg (L _ (XTupArg nec)) = noExtCon nec
addTickMatchGroup :: Bool{-is lambda-} -> MatchGroup GhcTc (LHsExpr GhcTc)
@@ -656,7 +650,6 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches }) = do
let isOneOfMany = matchesOneOfMany matches
matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches
return $ mg { mg_alts = L l matches' }
-addTickMatchGroup _ (XMatchGroup nec) = noExtCon nec
addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
-> TM (Match GhcTc (LHsExpr GhcTc))
@@ -665,7 +658,6 @@ addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats
bindLocals (collectPatsBinders pats) $ do
gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
return $ match { m_grhss = gRHSs' }
-addTickMatch _ _ (XMatch nec) = noExtCon nec
addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
-> TM (GRHSs GhcTc (LHsExpr GhcTc))
@@ -676,7 +668,6 @@ addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (L l local_binds)) = do
return $ GRHSs x guarded' (L l local_binds')
where
binders = collectLocalBinders local_binds
-addTickGRHSs _ _ (XGRHSs nec) = noExtCon nec
addTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
-> TM (GRHS GhcTc (LHsExpr GhcTc))
@@ -684,7 +675,6 @@ 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 nec) = noExtCon nec
addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
addTickGRHSBody isOneOfMany isLambda expr@(L pos e0) = do
@@ -763,8 +753,6 @@ addTickStmt isGuard stmt@(RecStmt {})
; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
, recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
-addTickStmt _ (XStmtLR nec) = noExtCon nec
-
addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
| otherwise = addTickLHsExprRHS e
@@ -786,7 +774,6 @@ addTickApplicativeArg isGuard (op, arg) =
<$> addTickLStmts isGuard stmts
<*> (unLoc <$> addTickLHsExpr (L hpcSrcSpan ret))
<*> addTickLPat pat
- addTickArg (XApplicativeArg nec) = noExtCon nec
addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
-> TM (ParStmtBlock GhcTc GhcTc)
@@ -795,7 +782,6 @@ addTickStmtAndBinders isGuard (ParStmtBlock x stmts ids returnExpr) =
(addTickLStmts isGuard stmts)
(return ids)
(addTickSyntaxExpr hpcSrcSpan returnExpr)
-addTickStmtAndBinders _ (XParStmtBlock nec) = noExtCon nec
addTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
addTickHsLocalBinds (HsValBinds x binds) =
@@ -805,7 +791,6 @@ addTickHsLocalBinds (HsIPBinds x binds) =
liftM (HsIPBinds x)
(addTickHsIPBinds binds)
addTickHsLocalBinds (EmptyLocalBinds x) = return (EmptyLocalBinds x)
-addTickHsLocalBinds (XHsLocalBindsLR x) = return (XHsLocalBindsLR x)
addTickHsValBinds :: HsValBindsLR GhcTc (GhcPass a)
-> TM (HsValBindsLR GhcTc (GhcPass b))
@@ -825,14 +810,12 @@ addTickHsIPBinds (IPBinds dictbinds ipbinds) =
liftM2 IPBinds
(return dictbinds)
(mapM (liftL (addTickIPBind)) ipbinds)
-addTickHsIPBinds (XHsIPBinds x) = return (XHsIPBinds x)
addTickIPBind :: IPBind GhcTc -> TM (IPBind GhcTc)
addTickIPBind (IPBind x nm e) =
liftM2 (IPBind x)
(return nm)
(addTickLHsExpr e)
-addTickIPBind (XIPBind x) = return (XIPBind x)
-- There is no location here, so we might need to use a context location??
addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
@@ -850,7 +833,6 @@ addTickHsCmdTop (HsCmdTop x cmd) =
liftM2 HsCmdTop
(return x)
(addTickLHsCmd cmd)
-addTickHsCmdTop (XCmdTop nec) = noExtCon nec
addTickLHsCmd :: LHsCmd GhcTc -> TM (LHsCmd GhcTc)
addTickLHsCmd (L pos c0) = do
@@ -915,14 +897,12 @@ addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)
addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do
matches' <- mapM (liftL addTickCmdMatch) matches
return $ mg { mg_alts = L l matches' }
-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 nec) = noExtCon nec
addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
addTickCmdGRHSs (GRHSs x guarded (L l local_binds)) = do
@@ -932,7 +912,6 @@ addTickCmdGRHSs (GRHSs x guarded (L l local_binds)) = do
return $ GRHSs x guarded' (L l local_binds')
where
binders = collectLocalBinders local_binds
-addTickCmdGRHSs (XGRHSs nec) = noExtCon nec
addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
-- The *guards* are *not* Cmds, although the body is
@@ -941,7 +920,6 @@ addTickCmdGRHS (GRHS x stmts cmd)
= do { (stmts',expr') <- addTickLStmts' (Just $ BinBox $ GuardBinBox)
stmts (addTickLHsCmd cmd)
; return $ GRHS x stmts' expr' }
-addTickCmdGRHS (XGRHS nec) = noExtCon nec
addTickLCmdStmts :: [LStmt GhcTc (LHsCmd GhcTc)]
-> TM [LStmt GhcTc (LHsCmd GhcTc)]
@@ -988,8 +966,6 @@ addTickCmdStmt stmt@(RecStmt {})
, recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
addTickCmdStmt ApplicativeStmt{} =
panic "ToDo: addTickCmdStmt ApplicativeLastStmt"
-addTickCmdStmt (XStmtLR nec) =
- noExtCon nec
-- Others should never happen in a command context.
addTickCmdStmt stmt = pprPanic "addTickHsCmd" (ppr stmt)
@@ -1296,11 +1272,9 @@ hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
matchesOneOfMany :: [LMatch GhcTc body] -> Bool
matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
where
+ matchCount :: LMatch GhcTc body -> Int
matchCount (L _ (Match { m_grhss = GRHSs _ grhss _ }))
= length grhss
- matchCount (L _ (Match { m_grhss = XGRHSs nec }))
- = noExtCon nec
- matchCount (L _ (XMatch nec)) = noExtCon nec
type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 967e4c3185..48a8ef6f20 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -151,12 +151,6 @@ getInstLoc = \case
-- equation. This does not happen for data family instances, for some
-- reason.
{ tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = L l _ }}}) -> l
- ClsInstD _ (XClsInstDecl _) -> error "getInstLoc"
- DataFamInstD _ (DataFamInstDecl (HsIB _ (XFamEqn _))) -> error "getInstLoc"
- TyFamInstD _ (TyFamInstDecl (HsIB _ (XFamEqn _))) -> error "getInstLoc"
- XInstDecl _ -> error "getInstLoc"
- DataFamInstD _ (DataFamInstDecl (XHsImplicitBndrs _)) -> error "getInstLoc"
- TyFamInstD _ (TyFamInstDecl (XHsImplicitBndrs _)) -> error "getInstLoc"
-- | Get all subordinate declarations inside a declaration, and their docs.
-- A subordinate declaration is something like the associate type or data
@@ -292,9 +286,11 @@ ungroup group_ =
mkDecls (typesigs . hs_valds) (SigD noExtField) group_ ++
mkDecls (valbinds . hs_valds) (ValD noExtField) group_
where
+ typesigs :: HsValBinds GhcRn -> [LSig GhcRn]
typesigs (XValBindsLR (NValBinds _ sig)) = filter (isUserSig . unLoc) sig
typesigs ValBinds{} = error "expected XValBindsLR"
+ valbinds :: HsValBinds GhcRn -> [LHsBind GhcRn]
valbinds (XValBindsLR (NValBinds binds _)) =
concatMap bagToList . snd . unzip $ binds
valbinds ValBinds{} = error "expected XValBindsLR"
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 8b518cb988..a1727659af 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -84,7 +84,6 @@ dsLocalBinds (L _ (EmptyLocalBinds _)) body = return body
dsLocalBinds (L loc (HsValBinds _ binds)) body = putSrcSpanDs loc $
dsValBinds binds body
dsLocalBinds (L _ (HsIPBinds _ binds)) body = dsIPBinds binds body
-dsLocalBinds _ _ = panic "dsLocalBinds"
-------------------------
-- caller sets location
@@ -105,8 +104,6 @@ dsIPBinds (IPBinds ev_binds ip_binds) body
ds_ip_bind (L _ (IPBind _ ~(Right n) e)) body
= do e' <- dsLExpr e
return (Let (NonRec n e') body)
- ds_ip_bind _ _ = panic "dsIPBinds"
-dsIPBinds (XHsIPBinds nec) _ = noExtCon nec
-------------------------
-- caller sets location
@@ -396,7 +393,6 @@ dsExpr (ExplicitTuple _ tup_args boxity)
-- lambdas, just arguments.
= do { core_expr <- dsLExprNoLP expr
; return (lam_vars, core_expr : args) }
- go _ _ = panic "dsExpr"
; dsWhenNoErrs (foldM go ([], []) (reverse tup_args))
-- The reverse is because foldM goes left-to-right
@@ -786,7 +782,6 @@ ds_prag_expr (HsPragTick _ _ _ _) expr = do
if gopt Opt_Hpc dflags
then panic "dsExpr:HsPragTick"
else dsLExpr expr
-ds_prag_expr (XHsPragE x) _ = noExtCon x
------------------------------
dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
@@ -960,7 +955,6 @@ dsDo stmts
((pat, fail_op), dsLExpr expr)
do_arg (ApplicativeArgMany _ stmts ret pat) =
((pat, noSyntaxExpr), dsDo (stmts ++ [noLoc $ mkLastStmt (noLoc ret)]))
- do_arg (XApplicativeArg nec) = noExtCon nec
; rhss' <- sequence rhss
@@ -1018,7 +1012,6 @@ dsDo stmts
go _ (ParStmt {}) _ = panic "dsDo ParStmt"
go _ (TransStmt {}) _ = panic "dsDo TransStmt"
- go _ (XStmtLR nec) _ = noExtCon nec
dsHandleMonadicFailure :: LPat GhcTc -> MatchResult -> SyntaxExpr GhcTc -> DsM CoreExpr
-- In a do expression, pattern-match failure just calls
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index 49cfe5779a..f30e1bab1d 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -100,6 +100,7 @@ dsForeigns' fos = do
where
do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl)
+ do_decl :: ForeignDecl GhcTc -> DsM (SDoc, SDoc, [Id], [Binding])
do_decl (ForeignImport { fd_name = id, fd_i_ext = co, fd_fi = spec }) = do
traceIf (text "fi start" <+> ppr id)
let id' = unLoc id
@@ -113,7 +114,6 @@ dsForeigns' fos = do
(L _ (CExportStatic _ ext_nm cconv)) _ }) = do
(h, c, _, _) <- dsFExport id co ext_nm cconv False
return (h, c, [id], [])
- do_decl (XForeignDecl nec) = noExtCon nec
{-
************************************************************************
diff --git a/compiler/GHC/HsToCore/GuardedRHSs.hs b/compiler/GHC/HsToCore/GuardedRHSs.hs
index 6a8bc53313..5763fac71b 100644
--- a/compiler/GHC/HsToCore/GuardedRHSs.hs
+++ b/compiler/GHC/HsToCore/GuardedRHSs.hs
@@ -71,13 +71,11 @@ dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty mb_rhss_deltas
match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1
-- NB: nested dsLet inside matchResult
; return match_result2 }
-dsGRHSs _ (XGRHSs nec) _ _ = noExtCon nec
dsGRHS :: HsMatchContext GhcRn -> Type -> Deltas -> LGRHS GhcTc (LHsExpr GhcTc)
-> DsM MatchResult
dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs))
= updPmDeltas rhs_deltas (matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs rhs_ty)
-dsGRHS _ _ _ (L _ (XGRHS nec)) = noExtCon nec
{-
************************************************************************
@@ -140,8 +138,6 @@ matchGuards (TransStmt {} : _) _ _ _ = panic "matchGuards TransStmt"
matchGuards (RecStmt {} : _) _ _ _ = panic "matchGuards RecStmt"
matchGuards (ApplicativeStmt {} : _) _ _ _ =
panic "matchGuards ApplicativeLastStmt"
-matchGuards (XStmtLR nec : _) _ _ _ =
- noExtCon nec
{-
Should {\em fail} if @e@ returns @D@
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index 8c27321824..3341427ef0 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -91,7 +91,6 @@ dsInnerListComp (ParStmtBlock _ stmts bndrs _)
; expr <- dsListComp (stmts ++ [noLoc $ mkLastStmt (mkBigLHsVarTupId bndrs)]) list_ty
; return (expr, bndrs_tuple_type) }
-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
@@ -267,9 +266,6 @@ deListComp (RecStmt {} : _) _ = panic "deListComp RecStmt"
deListComp (ApplicativeStmt {} : _) _ =
panic "deListComp ApplicativeStmt"
-deListComp (XStmtLR nec : _) _ =
- noExtCon nec
-
deBindComp :: OutPat GhcTc
-> CoreExpr
-> [ExprStmt GhcTc]
@@ -364,8 +360,6 @@ dfListComp _ _ (ParStmt {} : _) = panic "dfListComp ParStmt"
dfListComp _ _ (RecStmt {} : _) = panic "dfListComp RecStmt"
dfListComp _ _ (ApplicativeStmt {} : _) =
panic "dfListComp ApplicativeStmt"
-dfListComp _ _ (XStmtLR nec : _) =
- noExtCon nec
dfBindComp :: Id -> Id -- 'c' and 'n'
-> (LPat GhcTc, CoreExpr)
@@ -593,10 +587,10 @@ dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest
; dsMcBindStmt pat rhs bind_op noSyntaxExpr bind_ty stmts_rest }
where
+ ds_inner :: ParStmtBlock GhcTc GhcTc -> DsM (CoreExpr, Type)
ds_inner (ParStmtBlock _ stmts bndrs return_op)
= do { exp <- dsInnerMonadComp stmts bndrs return_op
; return (exp, mkBigCoreVarTupTy bndrs) }
- ds_inner (XParStmtBlock nec) = noExtCon nec
dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 54d90ee284..c479586b76 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -770,7 +770,6 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
mk_eqn_infos [] _ = return []
-- Called once per equation in the match, or alternative in the case
mk_eqn_info (Match { m_pats = pats, m_grhss = grhss }) rhss_deltas
- | XGRHSs nec <- grhss = noExtCon nec
| GRHSs _ grhss' _ <- grhss, let n_grhss = length grhss'
= do { dflags <- getDynFlags
; let upats = map (unLoc . decideBangHood dflags) pats
@@ -786,12 +785,10 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
, eqn_orig = FromSource
, eqn_rhs = match_result }
, rhss_deltas' ) }
- mk_eqn_info (XMatch nec) _ = noExtCon nec
handleWarnings = if isGenerated origin
then discardWarningsDs
else id
-matchWrapper _ _ (XMatchGroup nec) = noExtCon nec
matchEquations :: HsMatchContext GhcRn
-> [MatchId] -> [EquationInfo] -> Type
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index 3afc455e99..17bf1484b2 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -103,7 +103,6 @@ dsLit l = do
HsString _ str -> mkStringExprFS str
HsInteger _ i _ -> mkIntegerExpr i
HsInt _ i -> return (mkIntExpr platform (il_value i))
- XLit nec -> noExtCon nec
HsRat _ (FL _ _ val) ty -> do
num <- mkIntegerExpr (numerator val)
denom <- mkIntegerExpr (denominator val)
@@ -125,7 +124,6 @@ dsOverLit (OverLit { ol_val = val, ol_ext = OverLitTc rebindable ty
case shortCutLit platform val ty of
Just expr | not rebindable -> dsExpr expr -- Note [Literal short cut]
_ -> dsExpr witness
-dsOverLit (XOverLit nec) = noExtCon nec
{-
Note [Literal short cut]
~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index 37fef0fc03..b22ef27d85 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -286,7 +286,6 @@ checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do
, m_pats = []
, m_grhss = guards }
checkMatches dsMatchContext [] [match]
-checkGuardMatches _ (XGRHSs nec) = noExtCon nec
-- | Check a list of syntactic /match/es (part of case, functions, etc.), each
-- with a /pat/ and one or more /grhss/:
@@ -547,7 +546,6 @@ translatePat fam_insts x pat = case pat of
-- Not supposed to happen
ConPatIn {} -> panic "Check.translatePat: ConPatIn"
SplicePat {} -> panic "Check.translatePat: SplicePat"
- XPat n -> noExtCon n
-- | 'translatePat', but also select and return a new match var.
translatePatV :: FamInstEnvs -> Pat GhcTc -> DsM (Id, GrdVec)
@@ -642,7 +640,6 @@ translateMatch fam_insts vars (L match_loc (Match { m_pats = pats, m_grhss = grh
grhss' <- mapM (translateLGRHS fam_insts match_loc pats) (grhssGRHSs grhss)
-- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr grhss, ppr grhss'])
return (mkGrdTreeMany pats' grhss')
-translateMatch _ _ (L _ (XMatch nec)) = noExtCon nec
-- -----------------------------------------------------------------------
-- * Transform source guards (GuardStmt Id) to simpler PmGrds
@@ -657,7 +654,6 @@ translateLGRHS fam_insts match_loc pats (L _loc (GRHS _ gs _)) =
| null gs = L match_loc (sep (map ppr pats))
| otherwise = L grd_loc (sep (map ppr pats) <+> vbar <+> interpp'SP gs)
L grd_loc _ = head gs
-translateLGRHS _ _ _ (L _ (XGRHS nec)) = noExtCon nec
-- | Translate a guard statement to a 'GrdVec'
translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM GrdVec
@@ -670,7 +666,6 @@ translateGuard fam_insts guard = case guard of
TransStmt {} -> panic "translateGuard TransStmt"
RecStmt {} -> panic "translateGuard RecStmt"
ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt"
- XStmtLR nec -> noExtCon nec
-- | Translate let-bindings
translateLet :: HsLocalBinds GhcTc -> DsM GrdVec
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index d73b288d07..d047170feb 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -169,7 +169,6 @@ dsBracket wrap brack splices
do_brack (DecBrG _ gp) = runOverloaded $ do { MkC ds1 <- repTopDs gp ; return ds1 }
do_brack (DecBrL {}) = panic "dsBracket: unexpected DecBrL"
do_brack (TExpBr _ e) = runOverloaded $ do { MkC e1 <- repLE e ; return e1 }
- do_brack (XBracket nec) = noExtCon nec
{-
Note [Desugaring Brackets]
@@ -317,13 +316,12 @@ repTopDs group@(HsGroup { hs_valds = valds
= notHandledL loc "Splices within declaration brackets" empty
no_default_decl (L loc decl)
= notHandledL loc "Default declarations" (ppr decl)
+ no_warn :: LWarnDecl GhcRn -> MetaM a
no_warn (L loc (Warning _ thing _))
= notHandledL loc "WARNING and DEPRECATION pragmas" $
text "Pragma for declaration of" <+> ppr thing
- no_warn (L _ (XWarnDecl nec)) = noExtCon nec
no_doc (L loc _)
= notHandledL loc "Haddock documentation" empty
-repTopDs (XHsGroup nec) = noExtCon nec
hsScopedTvBinders :: HsValBinds GhcRn -> [Name]
-- See Note [Scoped type variables in bindings]
@@ -345,6 +343,7 @@ get_scoped_tvs (L _ signature)
| otherwise
= []
where
+ get_scoped_tvs_from_sig :: LHsSigType GhcRn -> [Name]
get_scoped_tvs_from_sig sig
-- Both implicit and explicit quantified variables
-- We need the implicit ones for f :: forall (a::k). blah
@@ -353,8 +352,6 @@ get_scoped_tvs (L _ signature)
, hsib_body = hs_ty } <- sig
, (explicit_vars, _) <- splitLHsForAllTyInvis hs_ty
= implicit_vars ++ hsLTyVarNames explicit_vars
- get_scoped_tvs_from_sig (XHsImplicitBndrs nec)
- = noExtCon nec
{- Notes
@@ -480,8 +477,6 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
; return $ Just (loc, dec)
}
-repTyClD (L _ (XTyClDecl nec)) = noExtCon nec
-
-------------------------
repRoleD :: LRoleAnnotDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRoleD (L loc (RoleAnnotDecl _ tycon roles))
@@ -490,14 +485,12 @@ repRoleD (L loc (RoleAnnotDecl _ tycon roles))
; roles2 <- coreList roleTyConName roles1
; dec <- repRoleAnnotD tycon1 roles2
; return (loc, dec) }
-repRoleD (L _ (XRoleAnnotDecl nec)) = noExtCon nec
-------------------------
repKiSigD :: LStandaloneKindSig GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repKiSigD (L loc kisig) =
case kisig of
StandaloneKindSig _ v ki -> rep_ty_sig kiSigDName loc ki v
- XStandaloneKindSig nec -> noExtCon nec
-------------------------
repDataDefn :: Core TH.Name
@@ -526,7 +519,6 @@ repDataDefn tc opts
; repData cxt1 tc opts ksig' cons1
derivs1 }
}
-repDataDefn _ _ (XHsDataDefn nec) = noExtCon nec
repSynDecl :: Core TH.Name -> Core [(M TH.TyVarBndr)]
-> LHsType GhcRn
@@ -568,7 +560,6 @@ repFamilyDecl decl@(L loc (FamilyDecl { fdInfo = info
; repDataFamilyD tc1 bndrs kind }
; return (loc, dec)
}
-repFamilyDecl (L _ (XFamilyDecl nec)) = noExtCon nec
-- | Represent result signature of a type family
repFamilyResultSig :: FamilyResultSig GhcRn -> MetaM (Core (M TH.FamilyResultSig))
@@ -577,7 +568,6 @@ repFamilyResultSig (KindSig _ ki) = do { ki' <- repLTy ki
; repKindSig ki' }
repFamilyResultSig (TyVarSig _ bndr) = do { bndr' <- repTyVarBndr bndr
; repTyVarSig bndr' }
-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
@@ -590,7 +580,6 @@ repFamilyResultSigToMaybeKind (KindSig _ ki) =
do { coreJustM kindTyConName =<< repLTy ki }
repFamilyResultSigToMaybeKind TyVarSig{} =
panic "repFamilyResultSigToMaybeKind: unexpected TyVarSig"
-repFamilyResultSigToMaybeKind (XFamilyResultSig nec) = noExtCon nec
-- | Represent injectivity annotation of a type family
repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
@@ -634,7 +623,6 @@ repInstD (L loc (DataFamInstD { dfid_inst = fi_decl }))
repInstD (L loc (ClsInstD { cid_inst = cls_decl }))
= do { dec <- repClsInstD cls_decl
; return (loc, dec) }
-repInstD (L _ (XInstDecl nec)) = noExtCon nec
repClsInstD :: ClsInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
@@ -664,7 +652,6 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
; wrapGenSyms ss decls2 }
where
(tvs, cxt, inst_ty) = splitLHsInstDeclTy ty
-repClsInstD (XClsInstDecl nec) = noExtCon nec
repStandaloneDerivD :: LDerivDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
@@ -677,7 +664,6 @@ repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat
; return (loc, dec) }
where
(tvs, cxt, inst_ty) = splitLHsInstDeclTy (dropWildCards ty)
-repStandaloneDerivD (L _ (XDerivDecl nec)) = noExtCon nec
repTyFamInstD :: TyFamInstDecl GhcRn -> MetaM (Core (M TH.Dec))
repTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })
@@ -709,8 +695,6 @@ repTyFamEqn (HsIB { hsib_ext = var_names
where checkTys :: [LHsTypeArg GhcRn] -> MetaM [LHsTypeArg GhcRn]
checkTys tys@(HsValArg _:HsValArg _:_) = return tys
checkTys _ = panic "repTyFamEqn:checkTys"
-repTyFamEqn (XHsImplicitBndrs nec) = noExtCon nec
-repTyFamEqn (HsIB _ (XFamEqn nec)) = noExtCon nec
repTyArgs :: MetaM (Core (M TH.Type)) -> [LHsTypeArg GhcRn] -> MetaM (Core (M TH.Type))
repTyArgs f [] = f
@@ -749,11 +733,6 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn =
checkTys tys@(HsValArg _: HsValArg _: _) = return tys
checkTys _ = panic "repDataFamInstD:checkTys"
-repDataFamInstD (DataFamInstDecl (XHsImplicitBndrs nec))
- = noExtCon nec
-repDataFamInstD (DataFamInstDecl (HsIB _ (XFamEqn nec)))
- = noExtCon nec
-
repForD :: Located (ForeignDecl GhcRn) -> MetaM (SrcSpan, Core (M TH.Dec))
repForD (L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
, fd_fi = CImport (L _ cc)
@@ -784,7 +763,6 @@ repForD (L loc (ForeignImport { fd_name = name, fd_sig_ty = typ
Just (Header _ h) | not raw_cconv -> unpackFS h ++ " "
_ -> ""
repForD decl@(L _ ForeignExport{}) = notHandled "Foreign export" (ppr decl)
-repForD (L _ (XForeignDecl nec)) = noExtCon nec
repCCallConv :: CCallConv -> MetaM (Core TH.Callconv)
repCCallConv CCallConv = rep2_nw cCallName []
@@ -813,7 +791,6 @@ rep_fix_d loc (FixitySig _ names (Fixity _ prec dir))
; dec <- rep2 rep_fn [prec', name']
; return (loc,dec) }
; mapM do_one names }
-rep_fix_d _ (XFixitySig nec) = noExtCon nec
repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRuleD (L loc (HsRule { rd_name = n
@@ -840,18 +817,12 @@ repRuleD (L loc (HsRule { rd_name = n
; repPragRule n' ty_bndrs' tm_bndrs' lhs' rhs' act' }
; wrapGenSyms ss rule }
; return (loc, rule) }
-repRuleD (L _ (XRuleDecl nec)) = noExtCon nec
ruleBndrNames :: LRuleBndr GhcRn -> [Name]
ruleBndrNames (L _ (RuleBndr _ n)) = [unLoc n]
ruleBndrNames (L _ (RuleBndrSig _ n sig))
| HsWC { hswc_body = HsIB { hsib_ext = vars }} <- sig
= unLoc n : vars
-ruleBndrNames (L _ (RuleBndrSig _ _ (HsWC _ (XHsImplicitBndrs nec))))
- = noExtCon nec
-ruleBndrNames (L _ (RuleBndrSig _ _ (XHsWildCardBndrs nec)))
- = noExtCon nec
-ruleBndrNames (L _ (XRuleBndr nec)) = noExtCon nec
repRuleBndr :: LRuleBndr GhcRn -> MetaM (Core (M TH.RuleBndr))
repRuleBndr (L _ (RuleBndr _ n))
@@ -861,7 +832,6 @@ repRuleBndr (L _ (RuleBndrSig _ n sig))
= do { MkC n' <- lookupLBinder n
; MkC ty' <- repLTy (hsSigWcType sig)
; rep2 typedRuleVarName [n', ty'] }
-repRuleBndr (L _ (XRuleBndr nec)) = noExtCon nec
repAnnD :: LAnnDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repAnnD (L loc (HsAnnotation _ _ ann_prov (L _ exp)))
@@ -869,7 +839,6 @@ repAnnD (L loc (HsAnnotation _ _ ann_prov (L _ exp)))
; exp' <- repE exp
; dec <- repPragAnn target exp'
; return (loc, dec) }
-repAnnD (L _ (XAnnDecl nec)) = noExtCon nec
repAnnProv :: AnnProvenance Name -> MetaM (Core TH.AnnTarget)
repAnnProv (ValueAnnProvenance (L _ n))
@@ -925,8 +894,6 @@ repC (L _ (ConDeclGADT { con_names = cons
then return c'
else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c']) }
-repC (L _ (XConDecl nec)) = noExtCon nec
-
repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt))
repMbContext Nothing = repContext []
@@ -973,7 +940,6 @@ repDerivClause (L _ (HsDerivingClause
where
rep_deriv_ty :: LHsType GhcRn -> MetaM (Core (M TH.Type))
rep_deriv_ty ty = repLTy ty
-repDerivClause (L _ (XHsDerivingClause nec)) = noExtCon nec
rep_sigs_binds :: [LSig GhcRn] -> LHsBinds GhcRn
-> MetaM ([GenSymBind], [Core (M TH.Dec)])
@@ -1017,7 +983,6 @@ rep_sig (L _ (MinimalSig {})) = notHandled "MINIMAL pragmas" empty
rep_sig (L _ (SCCFunSig {})) = notHandled "SCC pragmas" empty
rep_sig (L loc (CompleteMatchSig _ _st cls mty))
= rep_complete_sig cls mty loc
-rep_sig (L _ (XSig nec)) = noExtCon nec
rep_ty_sig :: Name -> SrcSpan -> LHsSigType GhcRn -> Located Name
-> MetaM (SrcSpan, Core (M TH.Dec))
@@ -1043,7 +1008,6 @@ 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 nec) _ = noExtCon nec
rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name
-> MetaM (SrcSpan, Core (M TH.Dec))
@@ -1072,7 +1036,6 @@ 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 nec) _ = noExtCon nec
rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name
-> MetaM (SrcSpan, Core (M TH.Dec))
@@ -1180,7 +1143,6 @@ addTyVarBinds (HsQTvs { hsq_ext = imp_tvs
= addSimpleTyVarBinds imp_tvs $
addHsTyVarBinds exp_tvs $
thing_inside
-addTyVarBinds (XLHsQTyVars nec) _ = noExtCon nec
addTyClTyVarBinds :: LHsQTyVars GhcRn
-> (Core [(M TH.TyVarBndr)] -> MetaM (Core (M a)))
@@ -1217,7 +1179,6 @@ repTyVarBndrWithKind (L _ (UserTyVar _ _)) nm
= repPlainTV nm
repTyVarBndrWithKind (L _ (KindedTyVar _ _ ki)) nm
= repLTy ki >>= repKindedTV nm
-repTyVarBndrWithKind (L _ (XTyVarBndr nec)) _ = noExtCon nec
-- | Represent a type variable binder
repTyVarBndr :: LHsTyVarBndr GhcRn -> MetaM (Core (M TH.TyVarBndr))
@@ -1228,7 +1189,6 @@ repTyVarBndr (L _ (KindedTyVar _ (L _ nm) ki))
= do { nm' <- lookupBinder nm
; ki' <- repLTy ki
; repKindedTV nm' ki' }
-repTyVarBndr (L _ (XTyVarBndr nec)) = noExtCon nec
-- represent a type context
--
@@ -1251,12 +1211,10 @@ 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 nec) = noExtCon nec
repHsSigWcType :: LHsSigWcType GhcRn -> MetaM (Core (M TH.Type))
repHsSigWcType (HsWC { hswc_body = sig1 })
= repHsSigType sig1
-repHsSigWcType (XHsWildCardBndrs nec) = noExtCon nec
-- yield the representation of a list of types
repLTys :: [LHsType GhcRn] -> MetaM [Core (M TH.Type)]
@@ -1389,7 +1347,6 @@ repSplice (HsTypedSplice _ _ n _) = rep_splice n
repSplice (HsUntypedSplice _ _ n _) = rep_splice n
repSplice (HsQuasiQuote _ n _ _ _) = rep_splice n
repSplice e@(HsSpliced {}) = pprPanic "repSplice" (ppr e)
-repSplice (XSplice nec) = noExtCon nec
rep_splice :: Name -> MetaM (Core a)
rep_splice splice_name
@@ -1428,7 +1385,6 @@ repE (HsOverLabel _ _ s) = repOverLabel s
repE e@(HsRecFld _ f) = case f of
Unambiguous x _ -> repE (HsVar noExtField (noLoc x))
Ambiguous{} -> notHandled "Ambiguous record selectors" (ppr e)
- XAmbiguousFieldOcc nec -> noExtCon nec
-- Remember, we're desugaring renamer output here, so
-- HsOverlit can definitely occur
@@ -1556,7 +1512,6 @@ repE (HsUnboundVar _ uv) = do
repE e@(HsPragE _ HsPragCore {} _) = notHandled "Core annotations" (ppr e)
repE e@(HsPragE _ HsPragSCC {} _) = notHandled "Cost centres" (ppr e)
repE e@(HsPragE _ HsPragTick {} _) = notHandled "Tick Pragma" (ppr e)
-repE (XExpr nec) = noExtCon nec
repE e = notHandled "Expression form" (ppr e)
-----------------------------------------------------------------------------
@@ -1586,8 +1541,6 @@ repClauseTup (L _ (Match { m_pats = ps
gs <- repGuards guards
; clause <- repClause ps1 gs ds
; wrapGenSyms (ss1++ss2) clause }}}
-repClauseTup (L _ (Match _ _ _ (XGRHSs nec))) = noExtCon nec
-repClauseTup (L _ (XMatch nec)) = noExtCon nec
repGuards :: [LGRHS GhcRn (LHsExpr GhcRn)] -> MetaM (Core (M TH.Body))
repGuards [L _ (GRHS _ [] e)]
@@ -1608,7 +1561,6 @@ repLGRHS (L _ (GRHS _ ss rhs))
; rhs' <- addBinds gs $ repLE rhs
; guarded <- repPatGE (nonEmptyCoreList ss') rhs'
; return (gs, guarded) }
-repLGRHS (L _ (XGRHS nec)) = noExtCon nec
repFields :: HsRecordBinds GhcRn -> MetaM (Core [M TH.FieldExp])
repFields (HsRecFields { rec_flds = flds })
@@ -1629,7 +1581,6 @@ repUpdFields = repListM fieldExpTyConName rep_fld
; e <- repLE (hsRecFieldArg fld)
; repFieldExp fn e }
Ambiguous{} -> notHandled "Ambiguous record updates" (ppr fld)
- XAmbiguousFieldOcc nec -> noExtCon nec
@@ -1694,7 +1645,6 @@ repSts (ParStmt _ stmt_blocks _ _ : ss) =
do { (ss1, zs) <- repSts (map unLoc stmts)
; zs1 <- coreListM stmtTyConName zs
; return (ss1, zs1) }
- rep_stmt_block (XParStmtBlock nec) = noExtCon nec
repSts [LastStmt _ e _ _]
= do { e2 <- repLE e
; z <- repNoBindSt e2
@@ -1709,7 +1659,6 @@ repSts (stmt@RecStmt{} : ss)
; z <- repRecSt (nonEmptyCoreList rss)
; (ss2,zs) <- addBinds ss1 (repSts ss)
; return (ss1++ss2, z : zs) }
-repSts (XStmtLR nec : _) = noExtCon nec
repSts [] = return ([],[])
repSts other = notHandled "Exotic statement" (ppr other)
@@ -1730,8 +1679,6 @@ repBinds (HsIPBinds _ (IPBinds _ decs))
; return ([], core_list)
}
-repBinds (HsIPBinds _ (XHsIPBinds nec)) = noExtCon nec
-
repBinds (HsValBinds _ decs)
= do { let { bndrs = hsScopedTvBinders decs ++ collectHsValBinders decs }
-- No need to worry about detailed scopes within
@@ -1744,7 +1691,6 @@ repBinds (HsValBinds _ decs)
; core_list <- coreListM decTyConName
(de_loc (sort_by_loc prs))
; return (ss, core_list) }
-repBinds (XHsLocalBindsLR nec) = noExtCon nec
rep_implicit_param_bind :: LIPBind GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
rep_implicit_param_bind (L loc (IPBind _ ename (L _ rhs)))
@@ -1755,7 +1701,6 @@ rep_implicit_param_bind (L loc (IPBind _ ename (L _ rhs)))
; rhs' <- repE rhs
; ipb <- repImplicitParamBind name rhs'
; return (loc, ipb) }
-rep_implicit_param_bind (L _ (XIPBind nec)) = noExtCon nec
rep_implicit_param_name :: HsIPName -> MetaM (Core String)
rep_implicit_param_name (HsIPName name) = coreStringLit (unpackFS name)
@@ -1800,8 +1745,6 @@ rep_bind (L loc (FunBind { fun_id = fn
; ans <- repFun fn' (nonEmptyCoreList ms1)
; return (loc, ans) }
-rep_bind (L _ (FunBind { fun_matches = XMatchGroup nec })) = noExtCon nec
-
rep_bind (L loc (PatBind { pat_lhs = pat
, pat_rhs = GRHSs _ guards (L _ wheres) }))
= do { patcore <- repLP pat
@@ -1810,7 +1753,6 @@ rep_bind (L loc (PatBind { pat_lhs = pat
; ans <- repVal patcore guardcore wherecore
; ans' <- wrapGenSyms ss ans
; return (loc, ans') }
-rep_bind (L _ (PatBind _ _ (XGRHSs nec) _)) = noExtCon nec
rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
= do { v' <- lookupBinder v
@@ -1860,9 +1802,6 @@ rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn
wrapGenArgSyms (RecCon _) _ dec = return dec
wrapGenArgSyms _ ss dec = wrapGenSyms ss dec
-rep_bind (L _ (PatSynBind _ (XPatSynBind nec))) = noExtCon nec
-rep_bind (L _ (XHsBindsLR nec)) = noExtCon nec
-
repPatSynD :: Core TH.Name
-> Core (M TH.PatSynArgs)
-> Core (M TH.PatSynDir)
@@ -1900,7 +1839,6 @@ repPatSynDir ImplicitBidirectional = rep2 implBidirPatSynName []
repPatSynDir (ExplicitBidirectional (MG { mg_alts = (L _ clauses) }))
= do { clauses' <- mapM repClauseTup clauses
; repExplBidirPatSynDir (nonEmptyCoreList clauses') }
-repPatSynDir (ExplicitBidirectional (XMatchGroup nec)) = noExtCon nec
repExplBidirPatSynDir :: Core [(M TH.Clause)] -> MetaM (Core (M TH.PatSynDir))
repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]
@@ -1939,9 +1877,6 @@ repLambda (L _ (Match { m_pats = ps
; lam <- addBinds ss (
do { xs <- repLPs ps; body <- repLE e; repLam xs body })
; wrapGenSyms ss lam }
-repLambda (L _ (Match { m_grhss = GRHSs _ [L _ (GRHS _ [] _)]
- (L _ (XHsLocalBindsLR nec)) } ))
- = noExtCon nec
repLambda (L _ m) = notHandled "Guarded lambdas" (pprMatch m)
@@ -2003,7 +1938,6 @@ repP (SigPat _ p t) = do { p' <- repLP p
; t' <- repLTy (hsSigWcType t)
; repPsig p' t' }
repP (SplicePat _ splice) = repSplice splice
-repP (XPat nec) = noExtCon nec
repP other = notHandled "Exotic pattern" (ppr other)
----------------------------------------------------------
@@ -2797,7 +2731,6 @@ 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 nec) = noExtCon nec
mk_lit :: OverLitVal -> MetaM (HsLit GhcRn)
mk_lit (HsIntegral i) = mk_integer (il_value i)
View Lorry Controller Status