diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-10-15 13:49:11 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-10-15 17:59:20 -0400 |
| commit | 02b2116e458357e87718e7378a80579a7021e2a7 (patch) | |
| tree | 1849ba48aa90364997602ea5e8a175ef819bc9fa /compiler/hsSyn | |
| parent | c5b477c29127d8375b3f23d37f877278b52547f6 (diff) | |
| download | haskell-02b2116e458357e87718e7378a80579a7021e2a7.tar.gz | |
Fix #15738 by defining (and using) parenthesizeHsContext
With `QuantifiedConstraints`, `forall`s can appear in more
nested positions than they could before, but `Convert` and the TH
pretty-printer were failing to take this into account. On the
`Convert` side, this is fixed by using a `parenthesizeHsContext`
to parenthesize singleton quantified constraints that appear to the
left of a `=>`. (A similar fix is applied to the TH pretty-printer.)
Test Plan: make test TEST=T15738
Reviewers: goldfire, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, carter
GHC Trac Issues: #15738
Differential Revision: https://phabricator.haskell.org/D5222
Diffstat (limited to 'compiler/hsSyn')
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 3 | ||||
| -rw-r--r-- | compiler/hsSyn/HsTypes.hs | 14 |
2 files changed, 15 insertions, 2 deletions
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index d094e17a14..af2c6034a9 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -1341,10 +1341,11 @@ cvtTypeKind ty_str ty | null tys' -> do { tvs' <- cvtTvs tvs ; cxt' <- cvtContext cxt + ; let pcxt = parenthesizeHsContext funPrec cxt' ; ty' <- cvtType ty ; loc <- getL ; let hs_ty = mkHsForAllTy tvs loc tvs' rho_ty - rho_ty = mkHsQualTy cxt loc cxt' ty' + rho_ty = mkHsQualTy cxt loc pcxt ty' ; return hs_ty } diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs index 3d853db32d..c36a54f66d 100644 --- a/compiler/hsSyn/HsTypes.hs +++ b/compiler/hsSyn/HsTypes.hs @@ -65,7 +65,7 @@ module HsTypes ( -- Printing pprHsType, pprHsForAll, pprHsForAllTvs, pprHsForAllExtra, pprHsContext, pprHsContextNoArrow, pprHsContextMaybe, - hsTypeNeedsParens, parenthesizeHsType + hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext ) where import GhcPrelude @@ -1495,3 +1495,15 @@ parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p) parenthesizeHsType p lty@(L loc ty) | hsTypeNeedsParens p ty = L loc (HsParTy NoExt lty) | otherwise = lty + +-- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint +-- @c@ such that @'hsTypeNeedsParens' p c@ is true, and if so, surrounds @c@ +-- with an 'HsParTy' to form a parenthesized @ctxt@. Otherwise, it simply +-- returns @ctxt@ unchanged. +parenthesizeHsContext :: PprPrec + -> LHsContext (GhcPass p) -> LHsContext (GhcPass p) +parenthesizeHsContext p lctxt@(L loc ctxt) = + case ctxt of + [c] -> L loc [parenthesizeHsType p c] + _ -> lctxt -- Other contexts are already "parenthesized" by virtue of + -- being tuples. |