From: simonmar <unknown>
Date: Tue, 27 Jul 1999 09:25:50 +0000 (+0000)
Subject: [project @ 1999-07-27 09:25:49 by simonmar]
X-Git-Tag: Approximately_9120_patches~5952
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f292cce21eb71ef844c9067c66f56d871488cab9

[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.
---

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 066bc1c..0a44b94 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 ad4a408..b9621e7 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}