diff options
Diffstat (limited to 'compiler/GHC/Rename/Expr.hs')
| -rw-r--r-- | compiler/GHC/Rename/Expr.hs | 22 |
1 files changed, 7 insertions, 15 deletions
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index 6316ecea63..6b2551faf1 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -943,7 +943,7 @@ methodNamesStmt (RecStmt { recS_stmts = L _ stmts }) = methodNamesStmt (LetStmt {}) = emptyFVs methodNamesStmt (ParStmt {}) = emptyFVs methodNamesStmt (TransStmt {}) = emptyFVs -methodNamesStmt ApplicativeStmt{} = emptyFVs +methodNamesStmt (XStmtLR ApplicativeStmt{}) = emptyFVs -- ParStmt and TransStmt can't occur in commands, but it's not -- convenient to error here so we just do what's convenient @@ -1265,9 +1265,6 @@ rnStmt ctxt _ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = for , trS_ret = return_op, trS_bind = bind_op , trS_fmap = fmap_op }), fvs2)], thing), all_fvs) } -rnStmt _ _ (L _ ApplicativeStmt{}) _ = - panic "rnStmt: ApplicativeStmt" - rnParallelStmts :: forall thing. HsStmtContext GhcRn -> SyntaxExpr GhcRn -> [ParStmtBlock GhcPs GhcPs] @@ -1473,9 +1470,6 @@ rn_rec_stmt_lhs _ stmt@(L _ (ParStmt {})) -- Syntactically illegal in mdo rn_rec_stmt_lhs _ stmt@(L _ (TransStmt {})) -- Syntactically illegal in mdo = pprPanic "rn_rec_stmt" (ppr stmt) -rn_rec_stmt_lhs _ stmt@(L _ (ApplicativeStmt {})) -- Shouldn't appear yet - = pprPanic "rn_rec_stmt" (ppr stmt) - rn_rec_stmt_lhs _ (L _ (LetStmt _ (EmptyLocalBinds _))) = panic "rn_rec_stmt LetStmt EmptyLocalBinds" @@ -1550,9 +1544,6 @@ rn_rec_stmt _ _ _ stmt@(L _ (TransStmt {}), _) -- Syntactically illegal in m rn_rec_stmt _ _ _ (L _ (LetStmt _ (EmptyLocalBinds _)), _) = panic "rn_rec_stmt: LetStmt EmptyLocalBinds" -rn_rec_stmt _ _ _ stmt@(L _ (ApplicativeStmt {}), _) - = pprPanic "rn_rec_stmt: ApplicativeStmt" (ppr stmt) - rn_rec_stmts :: AnnoBody body => HsStmtContext GhcRn -> (body GhcPs -> RnM (body GhcRn, FreeVars)) @@ -2148,7 +2139,7 @@ stmtTreeToStmts monad_names ctxt (StmtTreeApplicative trees) tail tail_fvs = do tup = mkBigLHsVarTup pvars noExtField (stmts',fvs2) <- stmtTreeToStmts monad_names ctxt tree [] pvarset (mb_ret, fvs1) <- - if | L _ ApplicativeStmt{} <- last stmts' -> + if | L _ (XStmtLR ApplicativeStmt{}) <- last stmts' -> return (unLoc tup, emptyNameSet) | otherwise -> do -- Need 'pureAName' and not 'returnMName' here, so that it requires @@ -2371,7 +2362,7 @@ mkApplicativeStmt ctxt args need_join body_stmts ; return (Just join_op, fvs) } else return (Nothing, emptyNameSet) - ; let applicative_stmt = noLocA $ ApplicativeStmt noExtField + ; let applicative_stmt = noLocA $ XStmtLR $ ApplicativeStmt noExtField (zip (fmap_op : repeat ap_op) args) mb_join ; return ( applicative_stmt : body_stmts @@ -2505,7 +2496,7 @@ checkStmt ctxt (L _ stmt) msg = sep [ text "Unexpected" <+> pprStmtCat stmt <+> text "statement" , text "in" <+> pprAStmtContext ctxt ] -pprStmtCat :: Stmt (GhcPass a) body -> SDoc +pprStmtCat :: forall a body. IsPass a => Stmt (GhcPass a) body -> SDoc pprStmtCat (TransStmt {}) = text "transform" pprStmtCat (LastStmt {}) = text "return expression" pprStmtCat (BodyStmt {}) = text "body" @@ -2513,7 +2504,9 @@ pprStmtCat (BindStmt {}) = text "binding" pprStmtCat (LetStmt {}) = text "let" pprStmtCat (RecStmt {}) = text "rec" pprStmtCat (ParStmt {}) = text "parallel" -pprStmtCat (ApplicativeStmt {}) = panic "pprStmtCat: ApplicativeStmt" +pprStmtCat (XStmtLR _) = case ghcPass @a of + GhcRn -> panic "pprStmtCat: ApplicativeStmt" + GhcTc -> panic "pprStmtCat: ApplicativeStmt" ------------ emptyInvalid :: Validity -- Payload is the empty document @@ -2584,7 +2577,6 @@ okCompStmt dflags _ stmt | otherwise -> NotValid (text "Use TransformListComp") RecStmt {} -> emptyInvalid LastStmt {} -> emptyInvalid -- Should not happen (dealt with by checkLastStmt) - ApplicativeStmt {} -> emptyInvalid --------- checkTupleSection :: [HsTupArg GhcPs] -> RnM () |