Commit 234093cf authored by Michael Sloan's avatar Michael Sloan Committed by Ben Gamari

Fix handling of ApplicativeDo in TH AST quotes

See https://ghc.haskell.org/trac/ghc/ticket/14471

Also fixes a parenthesization bug in pprStmt when ret_stripped is True

Test Plan: tests added to testsuite

Trac issues: #14471

Reviewers: goldfire, bgamari

Reviewed By: goldfire

Subscribers: rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4912
parent c4d98341
......@@ -26,6 +26,7 @@ import GhcPrelude
import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import HsSyn
import TcEnv ( isBrackStage )
import TcRnMonad
import Module ( getModule )
import RnEnv
......@@ -731,7 +732,10 @@ postProcessStmtsForApplicativeDo ctxt stmts
ado_is_on <- xoptM LangExt.ApplicativeDo
; let is_do_expr | DoExpr <- ctxt = True
| otherwise = False
; if ado_is_on && is_do_expr
-- don't apply the transformation inside TH brackets, because
-- DsMeta does not handle ApplicativeDo.
; in_th_bracket <- isBrackStage <$> getStage
; if ado_is_on && is_do_expr && not in_th_bracket
then do { traceRn "ppsfa" (ppr stmts)
; rearrangeForApplicativeDo ctxt stmts }
else noPostProcessStmts ctxt stmts }
......
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import Prelude
main = putStrLn $(do
expr <- [|
do x <- getLine
y <- getLine
pure (x, y)
|]
stringE (pprint expr))
do {x_0 <- System.IO.getLine;
y_1 <- System.IO.getLine;
GHC.Base.return (x_0, y_1)}
-- Same as T14471 but also enables RebindableSyntax, since that's a
-- tricky case.
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import Prelude
main = putStrLn $(do
expr <- [|
do x <- getLine
y <- getLine
pure (x, y)
|]
stringE (pprint expr))
do {x_0 <- System.IO.getLine;
y_1 <- System.IO.getLine;
GHC.Base.pure (x_0, y_1)}
......@@ -420,3 +420,5 @@ test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
# Note: T9693 should be only_ways(['ghci']) once it's fixed.
test('T9693', expect_broken(9693), ghci_script, ['T9693.script'])
test('T14471', normal, compile, [''])
test('TH_rebindableAdo', normal, compile, [''])
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