Fix #15307 by making nlHsFunTy parenthesize more
authorRyan Scott <ryan.gl.scott@gmail.com>
Thu, 5 Jul 2018 12:29:59 +0000 (08:29 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 12 Jul 2018 21:06:12 +0000 (17:06 -0400)
Summary:
`nlHsFunTy` wasn't parenthesizing its arguments at all,
which led to `-ddump-deriv` producing incorrectly parenthesized
types (since it uses `nlHsFunTy` to construct those types), as
demonstrated in #15307. Fix this by changing `nlHsFunTy` to add
parentheses à la `ppr_ty`: always parenthesizing the argument type
with function precedence, and recursively processing the result type,
adding parentheses for each function type it encounters.

Test Plan: make test TEST=T14578

Reviewers: bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #15307

Differential Revision: https://phabricator.haskell.org/D4890

(cherry picked from commit 59a15a56e180b59656e45df04f7df61de8298881)

compiler/hsSyn/HsUtils.hs
testsuite/tests/deriving/should_compile/T14578.stderr

index 22dbc1e..388ffdc 100644 (file)
@@ -500,7 +500,13 @@ nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
 
 nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t))
 nlHsTyVar x   = noLoc (HsTyVar noExt NotPromoted (noLoc x))
-nlHsFunTy a b = noLoc (HsFunTy noExt a b)
+nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a)
+                                     (parenthesize_fun_tail b))
+  where
+    parenthesize_fun_tail (L loc (HsFunTy ext ty1 ty2))
+      = L loc (HsFunTy ext (parenthesizeHsType funPrec ty1)
+                           (parenthesize_fun_tail ty2))
+    parenthesize_fun_tail lty = lty
 nlHsParTy t   = noLoc (HsParTy noExt t)
 
 nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p)
index bdb6ca5..acbbdd6 100644 (file)
@@ -7,10 +7,10 @@ Derived class instances:
       = GHC.Prim.coerce
           @(forall (a :: TYPE GHC.Types.LiftedRep)
                    (b :: TYPE GHC.Types.LiftedRep).
-            a -> b -> f a -> f b)
+            (a -> b) -> f a -> f b)
           @(forall (a :: TYPE GHC.Types.LiftedRep)
                    (b :: TYPE GHC.Types.LiftedRep).
-            a -> b -> T14578.App f a -> T14578.App f b)
+            (a -> b) -> T14578.App f a -> T14578.App f b)
           GHC.Base.fmap
     (GHC.Base.<$)
       = GHC.Prim.coerce
@@ -43,11 +43,12 @@ Derived class instances:
           @(forall (a :: TYPE GHC.Types.LiftedRep)
                    (b :: TYPE GHC.Types.LiftedRep)
                    (c :: TYPE GHC.Types.LiftedRep).
-            a -> b -> c -> f a -> f b -> f c)
+            (a -> b -> c) -> f a -> f b -> f c)
           @(forall (a :: TYPE GHC.Types.LiftedRep)
                    (b :: TYPE GHC.Types.LiftedRep)
                    (c :: TYPE GHC.Types.LiftedRep).
-            a -> b -> c -> T14578.App f a -> T14578.App f b -> T14578.App f c)
+            (a -> b -> c)
+            -> T14578.App f a -> T14578.App f b -> T14578.App f c)
           GHC.Base.liftA2
     (GHC.Base.*>)
       = GHC.Prim.coerce