Commit aab65608 authored by Simon Marlow's avatar Simon Marlow

Add layout to MultiWayIf (#7783)

This makes it possible to write

x = if | False -> if | False -> 1
                     | False -> 2
       | True -> 3

Layout normally inserts semicolons between declarations at the same
indentation level, so I added optional semicolons to the syntax for
guards in MultiWayIf syntax.  This is a bit of a hack, but the
alternative (a special kind of layout that doesn't insert semicolons)
seemed worse, or at least equally bad.
parent c0f89a1b
......@@ -219,16 +219,22 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") }
-- after a layout keyword (let, where, do, of), we begin a new layout
-- context if the curly brace is missing.
-- Careful! This stuff is quite delicate.
<layout, layout_do> {
<layout, layout_do, layout_if> {
\{ / { notFollowedBy '-' } { hopefully_open_brace }
-- we might encounter {-# here, but {- has been handled already
\n ;
^\# (line)? { begin line_prag1 }
}
-- after an 'if', a vertical bar starts a layout context for MultiWayIf
<layout_if> {
\| / { notFollowedBySymbol } { new_layout_context True ITvbar }
() { pop }
}
-- do is treated in a subtly different way, see new_layout_context
<layout> () { new_layout_context True }
<layout_do> () { new_layout_context False }
<layout> () { new_layout_context True ITvocurly }
<layout_do> () { new_layout_context False ITvocurly }
-- after a new layout context which was found to be to the left of the
-- previous context, we have generated a '{' token, and we now need to
......@@ -1143,6 +1149,7 @@ maybe_layout t = do -- If the alternative layout rule is enabled then
f ITlet = pushLexState layout
f ITwhere = pushLexState layout
f ITrec = pushLexState layout
f ITif = pushLexState layout_if
f _ = return ()
-- Pushing a new implicit layout context. If the indentation of the
......@@ -1154,11 +1161,11 @@ maybe_layout t = do -- If the alternative layout rule is enabled then
-- by a 'do', then we allow the new context to be at the same indentation as
-- the previous context. This is what the 'strict' argument is for.
--
new_layout_context :: Bool -> Action
new_layout_context strict span _buf _len = do
new_layout_context :: Bool -> Token -> Action
new_layout_context strict tok span _buf len = do
_ <- popLexState
(AI l _) <- getInput
let offset = srcLocCol l
let offset = srcLocCol l - len
ctx <- getContext
nondecreasing <- extension nondecreasingIndentation
let strict' = strict || not nondecreasing
......@@ -1169,10 +1176,10 @@ new_layout_context strict span _buf _len = do
-- token is indented to the left of the previous context.
-- we must generate a {} sequence now.
pushLexState layout_left
return (L span ITvocurly)
return (L span tok)
_ -> do
setContext (Layout offset : ctx)
return (L span ITvocurly)
return (L span tok)
do_layout_left :: Action
do_layout_left span _buf _len = do
......
......@@ -1459,7 +1459,7 @@ exp10 :: { LHsExpr RdrName }
| 'if' exp optSemi 'then' exp optSemi 'else' exp
{% checkDoAndIfThenElse $2 $3 $5 $6 $8 >>
return (LL $ mkHsIf $2 $5 $8) }
| 'if' gdpats {% hintMultiWayIf (getLoc $1) >>
| 'if' ifgdpats {% hintMultiWayIf (getLoc $1) >>
return (LL $ HsMultiIf placeHolderType (reverse $ unLoc $2)) }
| 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
| '-' fexp { LL $ NegApp $2 noSyntaxExpr }
......@@ -1754,6 +1754,19 @@ gdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
: gdpats gdpat { LL ($2 : unLoc $1) }
| gdpat { L1 [$1] }
-- optional semi-colons between the guards of a MultiWayIf, because we use
-- layout here, but we don't need (or want) the semicolon as a separator (#7783).
gdpatssemi :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
: gdpatssemi gdpat optSemi { sL (comb2 $1 $2) ($2 : unLoc $1) }
| gdpat optSemi { L1 [$1] }
-- layout for MultiWayIf doesn't begin with an open brace, because it's hard to
-- generate the open brace in addition to the vertical bar in the lexer, and
-- we don't need it.
ifgdpats :: { Located [LGRHS RdrName (LHsExpr RdrName)] }
: '{' gdpatssemi '}' { LL (unLoc $2) }
| gdpatssemi close { $1 }
gdpat :: { LGRHS RdrName (LHsExpr RdrName) }
: '|' guardquals '->' exp { sL (comb2 $1 $>) $ GRHS (unLoc $2) $4 }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment