diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-12-20 19:25:53 -0500 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-12-20 19:25:54 -0500 |
| commit | 4d41e9212d1fdf109f2d0174d204644446f5874c (patch) | |
| tree | 50982afd40fe890533aef721a2ae4c756bf16ff4 /compiler | |
| parent | b6304f8fd9b845466116874db4224f42acbc597d (diff) | |
| download | haskell-4d41e9212d1fdf109f2d0174d204644446f5874c.tar.gz | |
Improve treatment of sectioned holes
Summary:
Previously, GHC was pretty-printing left-section holes
incorrectly and not parsing right-sectioned holes at all. This patch
fixes both problems.
Test Plan: make test TEST=T14590
Reviewers: bgamari, simonpj
Reviewed By: simonpj
Subscribers: simonpj, rwbarton, thomie, mpickering, carter
GHC Trac Issues: #14590
Differential Revision: https://phabricator.haskell.org/D4273
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/hsSyn/HsExpr.hs | 4 | ||||
| -rw-r--r-- | compiler/parser/Parser.y | 10 |
2 files changed, 11 insertions, 3 deletions
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index de0e473ba4..1c7340d216 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -883,6 +883,8 @@ ppr_expr (SectionL expr op) = case unLoc op of HsVar (L _ v) -> pp_infixly v HsConLikeOut c -> pp_infixly (conLikeName c) + HsUnboundVar h@TrueExprHole{} + -> pp_infixly (unboundVarOcc h) _ -> pp_prefixly where pp_expr = pprDebugParendExpr expr @@ -895,6 +897,8 @@ ppr_expr (SectionR op expr) = case unLoc op of HsVar (L _ v) -> pp_infixly v HsConLikeOut c -> pp_infixly (conLikeName c) + HsUnboundVar h@TrueExprHole{} + -> pp_infixly (unboundVarOcc h) _ -> pp_prefixly where pp_expr = pprDebugParendExpr expr diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 1b593900a7..c920f0c6e4 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -3178,13 +3178,17 @@ varop :: { Located RdrName } qop :: { LHsExpr GhcPs } -- used in sections : qvarop { sL1 $1 $ HsVar $1 } | qconop { sL1 $1 $ HsVar $1 } - | '`' '_' '`' {% ams (sLL $1 $> EWildPat) - [mj AnnBackquote $1,mj AnnVal $2 - ,mj AnnBackquote $3] } + | hole_op { $1 } qopm :: { LHsExpr GhcPs } -- used in sections : qvaropm { sL1 $1 $ HsVar $1 } | qconop { sL1 $1 $ HsVar $1 } + | hole_op { $1 } + +hole_op :: { LHsExpr GhcPs } -- used in sections +hole_op : '`' '_' '`' {% ams (sLL $1 $> EWildPat) + [mj AnnBackquote $1,mj AnnVal $2 + ,mj AnnBackquote $3] } qvarop :: { Located RdrName } : qvarsym { $1 } |