From f292cce21eb71ef844c9067c66f56d871488cab9 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 27 Jul 1999 09:25:50 +0000
Subject: [PATCH] [project @ 1999-07-27 09:25:49 by simonmar] Back out
yesterday's change to Parser.y, and throw out illegal do expressions in the
renamer instead. It turned out to be hard to get the optional semicolons
right in the grammar at the same time as checking that the last statement is
an expression.
---
ghc/compiler/parser/Parser.y | 27 ++++++++++++++++-----------
ghc/compiler/rename/RnExpr.lhs | 12 +++++++++++-
2 files changed, 27 insertions(+), 12 deletions(-)
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 066bc1c15068..0a44b9420d04 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,10 @@
{-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.12 1999/07/27 07:31:18 simonpj Exp $
+<<<<<<< Parser.y
+$Id: Parser.y,v 1.13 1999/07/27 09:25:49 simonmar Exp $
+=======
+$Id: Parser.y,v 1.13 1999/07/27 09:25:49 simonmar Exp $
+>>>>>>> 1.10
Haskell grammar.
@@ -759,20 +763,21 @@ gdpat :: { RdrNameGRHS }
-- Statement sequences
stmtlist :: { [RdrNameStmt] }
- : '{' stmts '}' { $2 }
- | layout_on_for_do stmts close { $2 }
+ : '{' stmts '}' { reverse $2 }
+ | layout_on_for_do stmts close { reverse $2 }
+
+-- Stmt list should really end in an expression, but it's not
+-- convenient to enforce this here, so we throw out erroneous
+-- statement sequences in the renamer instead.
--- Stmt list must end in an expression
--- thought the H98 report doesn't currently say so in the syntax
stmts :: { [RdrNameStmt] }
- : stmts1 srcloc exp { reverse (ExprStmt $3 $2 : $1) }
+ : ';' stmts1 { $2 }
+ | stmts1 { $1 }
--- A list of zero or more stmts, ending in semicolon
--- Returned in *reverse* order
stmts1 :: { [RdrNameStmt] }
- : stmts1 stmt ';' { $2 : $1 }
- | stmts1 ';' { $1 }
- | { [] }
+ : stmts1 ';' stmt { $3 : $1 }
+ | stmts1 ';' { $1 }
+ | stmt { [$1] }
stmt :: { RdrNameStmt }
: srcloc infixexp '<-' exp {% checkPattern $2 `thenP` \p ->
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index ad4a4085901d..b9621e79fcc8 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -365,10 +365,16 @@ rnExpr (HsLet binds expr)
rnExpr expr `thenRn` \ (expr',fvExpr) ->
returnRn (HsLet binds' expr', fvExpr)
-rnExpr (HsDo do_or_lc stmts src_loc)
+rnExpr e@(HsDo do_or_lc stmts src_loc)
= pushSrcLocRn src_loc $
lookupImplicitOccRn monadClass_RDR `thenRn` \ monad ->
rnStmts rnExpr stmts `thenRn` \ (stmts', fvs) ->
+ -- check the statement list ends in an expression
+ case last stmts' of {
+ ExprStmt _ _ -> returnRn () ;
+ ReturnStmt _ -> returnRn () ; -- for list comprehensions
+ _ -> addErrRn (doStmtListErr e)
+ } `thenRn_`
returnRn (HsDo do_or_lc stmts' src_loc, fvs `addOneFV` monad)
rnExpr (ExplicitList exps)
@@ -865,4 +871,8 @@ pp_op (op, fix) = hcat [quotes (ppr op), space, parens (ppr fix)]
patSynErr e
= sep [ptext SLIT("Pattern syntax in expression context:"),
nest 4 (ppr e)]
+
+doStmtListErr e
+ = sep [ptext SLIT("`do' statements must end in expression:"),
+ nest 4 (ppr e)]
\end{code}
--
GitLab