[project @ 1999-06-30 11:29:53 by simonmar]

Allow the following (not strictly H98) construct:

    do
	blah
	e $ do
	blah

This doesn't break any existing code, just allows more programs
through.  Only the semantics for layout after a 'do' have changed.

2 files changed, 20 insertions, 7 deletions

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index d705043da6..efcda1b6d4 100644
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -1198,13 +1198,25 @@ h = h
 	- we still need to insert another '}' followed by a ';',
 	  hence the atbol trick.
 
+There's also a special hack in here to deal with
+
+	do
+	   ....
+	   e $ do
+	   blah
+
+i.e. the inner context is at the same indentation level as the outer
+context.  This is strictly illegal according to Haskell 98, but
+there's a lot of existing code using this style and it doesn't make
+any sense to disallow it, since empty 'do' lists don't make sense.
 -}
 
-layoutOn :: P ()
-layoutOn buf s@(PState{ bol = bol, context = ctx }) =
+layoutOn :: Bool -> P ()
+layoutOn strict buf s@(PState{ bol = bol, context = ctx }) =
     let offset = lexemeIndex buf -# bol in
     case ctx of
-	Layout prev_off : _ | prev_off >=# offset ->
+	Layout prev_off : _ 
+	   | if strict then prev_off >=# offset else prev_off ># offset ->
 		--trace ("layout on, column: " ++  show (I# offset)) $
 		POk s{ context = Layout (offset +# 1#) : ctx, atbol = 1# } ()
 	other -> 
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 3348da9d3c..ef83b5e295 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.9 1999/06/28 16:42:23 simonmar Exp $
+$Id: Parser.y,v 1.10 1999/06/30 11:29:53 simonmar Exp $
 
 Haskell grammar.
 
@@ -760,8 +760,8 @@ gdpat	:: { RdrNameGRHS }
 -- Statement sequences
 
 stmtlist :: { [RdrNameStmt] }
-	: '{'            stmts '}'	{ reverse $2 }
-	|     layout_on  stmts close	{ reverse $2 }
+	: '{'            	stmts '}'	{ reverse $2 }
+	|     layout_on_for_do  stmts close	{ reverse $2 }
 
 stmts :: { [RdrNameStmt] }
 	: ';' stmts1			{ $2 }
@@ -949,7 +949,8 @@ close :: { () }
 	: vccurly		{ () } -- context popped in lexer.
 	| error			{% popContext }
 
-layout_on  :: { () }	:	{% layoutOn  }
+layout_on  	  :: { () }	: {% layoutOn True{-strict-} }
+layout_on_for_do  :: { () }	: {% layoutOn False }
 
 -----------------------------------------------------------------------------
 -- Miscellaneous (mostly renamings)