mirror of
https://github.com/google/ghc-source-gen.git
synced 2024-10-26 22:37:41 +03:00
Parenthesize let-expressions inside of do-expressions. (#38)
The following syntax is not valid, but can be generated by GHC; ``` do let ... in ... ``` It's not always a problem, if GHC manages to wrap it like ``` do let ... in ... ``` But for consistency, and since this ought to be an uncommon case, always wrap `let`s in parentheses when they're inside of a `do` statement.
This commit is contained in:
parent
b2a6ff551b
commit
15df48689e
@ -27,7 +27,7 @@ import HsExpr
|
||||
import HsPat (HsRecField'(..), HsRecFields(..))
|
||||
import HsTypes (FieldOcc(..), AmbiguousFieldOcc(..))
|
||||
import Data.String (fromString)
|
||||
import SrcLoc (unLoc, Located)
|
||||
import SrcLoc (unLoc, GenLocated(..), Located)
|
||||
|
||||
import GHC.SourceGen.Binds.Internal
|
||||
import GHC.SourceGen.Binds
|
||||
@ -88,7 +88,21 @@ multiIf = noExtOrPlaceHolder HsMultiIf . map builtLoc
|
||||
-- > =====
|
||||
-- > do' [var "x" <-- var "act", stmt $ var "return" @@ var "x"]
|
||||
do' :: [Stmt'] -> HsExpr'
|
||||
do' = withPlaceHolder . noExt HsDo DoExpr . builtLoc . map builtLoc
|
||||
do' = withPlaceHolder . noExt HsDo DoExpr
|
||||
. builtLoc . map (builtLoc . parenthesizeIfLet)
|
||||
where
|
||||
-- Put parentheses around a "let" in a do-binding, to avoid:
|
||||
-- do let x = ...
|
||||
-- in x
|
||||
-- which is not valid Haskell.
|
||||
#if MIN_VERSION_ghc(8,6,0)
|
||||
parenthesizeIfLet (BodyStmt ext e@(L _ HsLet{}) x y)
|
||||
= BodyStmt ext (parExpr e) x y
|
||||
#else
|
||||
parenthesizeIfLet (BodyStmt e@(L _ HsLet{}) x y tc)
|
||||
= BodyStmt (parExpr e) x y tc
|
||||
#endif
|
||||
parenthesizeIfLet s = s
|
||||
|
||||
-- | A type constraint on an expression.
|
||||
--
|
||||
|
@ -181,6 +181,10 @@ exprsTest dflags = testGroup "Expr"
|
||||
, "let f (A x) = 1 in f" :~
|
||||
let' [ funBind "f" $ match [conP "A" [var "x"]] $ int 1] (var "f")
|
||||
]
|
||||
, test "do"
|
||||
-- TODO: add more tests.
|
||||
[ "do (let x = 1 in x)" :~ do' [stmt $ let' [valBind "x" (int 1)] (var "x")]
|
||||
]
|
||||
]
|
||||
where
|
||||
test = testExprs dflags
|
||||
|
Loading…
Reference in New Issue
Block a user