[GHC] #9022: TH pretty printer and GHC parser semicolon placement mismatch

#9022: TH pretty printer and GHC parser semicolon placement mismatch ----------------------------+---------------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 7.8.2 (Parser) | Operating System: Unknown/Multiple Keywords: | Type of failure: GHC rejects valid program Architecture: | Test Case: Unknown/Multiple | Blocking: Difficulty: Unknown | Blocked By: | Related Tickets: | ----------------------------+---------------------------------------------- In GHC 7.8 TemplateHaskell pretty printer started inserting explicit braces and semicolons. It puts semicolons at the end of the line as opposed to the beginning of the next line. This causes GHC to fail parsing if we try to compile the pretty printed code. {{{ $ cat Foo.hs module Main where import Language.Haskell.TH main = putStrLn $ pprint foo foo :: Dec foo = barD where barD = FunD ( mkName "bar" ) [ Clause manyArgs (NormalB barBody) [] ] barBody = DoE [letxStmt, retxStmt] letxStmt = LetS [ ValD (VarP xName) (NormalB $ LitE $ IntegerL 5) [] ] retxStmt = NoBindS $ AppE returnVarE xVarE xName = mkName "x" returnVarE = VarE $ mkName "return" xVarE = VarE xName manyArgs = map argP [0..9] argP n = VarP $ mkName $ "arg" ++ show n $ ghc-7.8.2 Foo.hs [1 of 1] Compiling Main ( Foo.hs, Foo.o ) Linking Foo ... $ ./Foo | tee Bar.hs bar arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 = do {let x = 5; return x} $ ghc Bar.hs [1 of 1] Compiling Main ( Bar.hs, Bar.o ) Bar.hs:2:61: parse error on input `return' }}} I don't know if this is a problem with TH pretty printer or if GHC is supposed to parse semicolons wherever they are.. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.1 Component: Test Suite | Version: 7.8.2 Resolution: | Keywords: Operating System: | Architecture: Unknown/Multiple Unknown/Multiple | Difficulty: Unknown Type of failure: GHC | Blocked By: rejects valid program | Related Tickets: Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Changes (by thomie): * component: Compiler (Parser) => Test Suite * milestone: => 7.10.1 Comment: Thank you for the report. I confirm this problem does not occur in 7.6.3, and does occur with 7.8.1 and HEAD. I can not find anything about this in the 7.8.1 changelog. I did find a related change, but then for the GHC Api pretty printer. {{{ commit 6f32f9b429814499cfde1367e59d3e46bffc4925 Author: simonpj@microsoft.com <unknown> Date: Thu Jul 23 15:24:11 2009 +0000 Print explicit braces and semicolons in do-notation By printing explicit braces we make it more likely that pretty-printed code will be acceptable if fed back into GHC. See http://www.haskell.org/pipermail/glasgow-haskell- users/2009-July/017554.html }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:1 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.1 Component: Template | Version: 7.8.1 Haskell | Keywords: Resolution: | Architecture: Unknown/Multiple Operating System: | Difficulty: Unknown Unknown/Multiple | Blocked By: Type of failure: GHC | Related Tickets: rejects valid program | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Changes (by thomie): * version: 7.8.2 => 7.8.1 * component: Test Suite => Template Haskell -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:2 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.1 Component: Template | Version: 7.8.1 Haskell | Keywords: Resolution: | Architecture: Unknown/Multiple Operating System: | Difficulty: Unknown Unknown/Multiple | Blocked By: Type of failure: GHC | Related Tickets: rejects valid program | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by simonpj): I think the solution is not to be very delicate about how to place the semicolons for the do-notation. Rather, we should just use braces and semicolons for let-notation too. At least for lets in do-notation but perhaps for all. Then you'd get {{{ bar arg0 arg1 arg2 arg3 arg4 arg5 arg6 arg7 arg8 arg9 = do {let { x = 5 }; return x} }}} which should work fine. Anyone want to do this? It would be consistent with the story for do- notation. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:3 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.1 Component: Template | Version: 7.8.1 Haskell | Keywords: Resolution: | Architecture: Unknown/Multiple Operating System: | Difficulty: Unknown Unknown/Multiple | Blocked By: Type of failure: GHC | Related Tickets: rejects valid program | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by roldugin): There was a discussion in the mailing list and I fixed it based on advice I got there. The fix worked for me but I haven't validated it. I no longer have write access to the repo, so I've attached it above. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:4 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.1 Component: Template | Version: 7.8.1 Haskell | Keywords: Resolution: | Architecture: Unknown/Multiple Operating System: | Difficulty: Unknown Unknown/Multiple | Blocked By: Type of failure: GHC | Related Tickets: rejects valid program | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by simonpj): Did you test your fix? {{{ let {x = 3} ; {y = 4} in x+y }}} is not valid Haskell, but is (I believe) what your patch will generate. Simon -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:5 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.1 Component: Template | Version: 7.8.1 Haskell | Keywords: Resolution: | Architecture: Unknown/Multiple Operating System: | Difficulty: Unknown Unknown/Multiple | Blocked By: Type of failure: GHC | Related Tickets: rejects valid program | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Comment (by roldugin): You're right! `let` expressions should be fine: {{{
pprint <$> runQ [| let { x = 3; y = 4 } in x + y |] "let {x_0 = 3; y_1 = 4}\n in x_0 GHC.Num.+ y_1" }}}
But there is indeed a problem with `let` statements: {{{
pprint <$> runQ [| do let { x = 3; y = 4 } ; return (x + y) |] "do {let {x_0 = 3}; {y_1 = 4}; GHC.Base.return (x_0 GHC.Num.+ y_1)}" }}}
I think pretty printing `LetS` will need to use custom `pprDecs` like `LetE` does around line 149. Unfortunately, I can't do it right now but I will when I get a minute. George -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:6 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 7.10.1 Component: Template | Version: 7.8.1 Haskell | Keywords: newcomer Resolution: | Architecture: Unknown/Multiple Operating System: | Difficulty: Unknown Unknown/Multiple | Blocked By: Type of failure: GHC | Related Tickets: rejects valid program | Test Case: | Blocking: | Differential Revisions: | -------------------------------------+------------------------------------- Changes (by goldfire): * keywords: => newcomer -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:7 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: roldugin Type: bug | Status: new Priority: normal | Milestone: 7.12.1 Component: Template Haskell | Version: 7.8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Changes (by thomie): * owner: => roldugin Comment: roldugin: assigning to you, since you were working on this. -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:9 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: 8.0.1 Component: Template Haskell | Version: 7.8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Revisions: -------------------------------------+------------------------------------- Changes (by thomie): * owner: roldugin => -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:11 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by bollmann): It seems that this issue was already fixed in ticket #10734. I just added the above test locally and it passes in the current head: https://git.haskell.org/ghc.git/commitdiff/00cbbab3362578df44851442408a8b91a.... Shall I add the above testcase as part of the TH testsuite and then close the ticket? Or shall we just close this ticket right away? -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:13 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: bollmann Type: bug | Status: new Priority: normal | Milestone: Component: Template Haskell | Version: 7.8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Changes (by bollmann): * owner: => bollmann -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:14 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: bollmann Type: bug | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): D1898 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bollmann): * status: new => patch * differential: => D1898 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: bollmann Type: bug | Status: patch Priority: normal | Milestone: Component: Template Haskell | Version: 7.8.1 Resolution: | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1898 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bollmann): * differential: D1898 => Phab:D1898 -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:16 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler

#9022: TH pretty printer and GHC parser semicolon placement mismatch
-------------------------------------+-------------------------------------
Reporter: roldugin | Owner: bollmann
Type: bug | Status: patch
Priority: normal | Milestone:
Component: Template Haskell | Version: 7.8.1
Resolution: | Keywords: newcomer
Operating System: Unknown/Multiple | Architecture:
Type of failure: GHC rejects | Unknown/Multiple
valid program | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s): Phab:D1898
Wiki Page: |
-------------------------------------+-------------------------------------
Comment (by Ben Gamari

#9022: TH pretty printer and GHC parser semicolon placement mismatch -------------------------------------+------------------------------------- Reporter: roldugin | Owner: bollmann Type: bug | Status: closed Priority: normal | Milestone: Component: Template Haskell | Version: 7.8.1 Resolution: fixed | Keywords: newcomer Operating System: Unknown/Multiple | Architecture: Type of failure: GHC rejects | Unknown/Multiple valid program | Test Case: Blocked By: | Blocking: Related Tickets: | Differential Rev(s): Phab:D1898 Wiki Page: | -------------------------------------+------------------------------------- Changes (by bollmann): * status: patch => closed * resolution: => fixed -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/9022#comment:18 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler
participants (1)
-
GHC