HsParser fails on any of these 6 examples:
data Data = A {
x :: Int
}
f1 x = let {
s = x
} in s
f2 x = do {
x
}
f3 x = case x of {
_ -> 12
}
f4 x = s where {
s = 12
}
f5 y = A {
x = 45
}
The problem seems to be the production (copied from HsParser.ly)
> layout_off :: { () } : {% pushContext NoLayout }
This production is supposed to make the parser enter a NoLayout
context every time the lexer reaches an open brace '{'. It is used in
other productions such as
> decllist :: { [HsDecl] }
> : '{' layout_off decls '}' { $3 }
> | layout_on decls close { $2 }
For some reason the use of layout_off only takes effect _after_ the
lexer has produced the next token. When the lexer reaches the second x
in
f2 x = do {
x
}
the NoLayout hasn't been pushed yet. Since x is indented to the same
column as f2, the lexer therefore inserts a ';'. The '{' followed by a ';'
causes the parser to fail. In code with a more normal indentation
f2 x = do {
x
}
the parser works fine, because the lexer in this case doesn't insert
an extra ';' or '}'.
One way of fixing this is to remove all uses of layout_off, and
instead delegate the pushing of NoLayouts to the lexer. I have
attached a patch of HsParser.ly and HsLexer.lhs to show what I had in
mind.
Anders
233c233
< '{' -> special LeftCurly
---
> '{' -> \ctxt -> special LeftCurly (NoLayout : ctxt)
130c130
< > : '{' layout_off bodyaux '}' { $3 }
---
> > : '{' bodyaux '}' { $2 }
286c286
< > : '{' layout_off decls '}' { $3 }
---
> > : '{' decls '}' { $2 }
370,371c370,371
< > | srcloc con '{' layout_off fielddecls '}'
< > { HsRecDecl $1 $2 (reverse $5) }
---
> > | srcloc con '{' fielddecls '}'
> > { HsRecDecl $1 $2 (reverse $4) }
417c417
< > : 'where' '{' layout_off cbody '}' { $4 }
---
> > : 'where' '{' cbody '}' { $3 }
438c438
< > : 'where' '{' layout_off valdefs '}' { $4 }
---
> > : 'where' '{' valdefs '}' { $3 }
506c506
< > : aexp '{' layout_off fbinds '}' {% mkRecConstrOrUpdate $1 (reverse $4) }
---
> > : aexp '{' fbinds '}' {% mkRecConstrOrUpdate $1 (reverse $3) }
571c571
< > : '{' layout_off alts optsemi '}' { reverse $3 }
---
> > : '{' alts optsemi '}' { reverse $2 }
601c601
< > : '{' layout_off stmts '}' { $3 }
---
> > : '{' stmts '}' { $2 }
738d737
< > layout_off :: { () } : {% pushContext NoLayout }
