From: simonmar Date: Wed, 30 Jun 1999 11:29:53 +0000 (+0000) Subject: [project @ 1999-06-30 11:29:53 by simonmar] X-Git-Tag: Approximately_9120_patches~6049 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=cc02bb851921a07a83006988c5bc19b72a3f9049 [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. --- diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs index d705043..efcda1b 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 3348da9..ef83b5e 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)