[commit: ghc] ghc-8.6: Fix #15307 by making nlHsFunTy parenthesize more (92925b3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/92925b3dce6631a829e7f61c85da47842472f955/ghc

>---------------------------------------------------------------

commit 92925b3dce6631a829e7f61c85da47842472f955
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Jul 5 08:29:59 2018 -0400

    Fix #15307 by making nlHsFunTy parenthesize more
    
    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)


>---------------------------------------------------------------

92925b3dce6631a829e7f61c85da47842472f955
 compiler/hsSyn/HsUtils.hs                             | 8 +++++++-
 testsuite/tests/deriving/should_compile/T14578.stderr | 9 +++++----
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 22dbc1e..388ffdc 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -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)
diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr
index bdb6ca5..acbbdd6 100644
--- a/testsuite/tests/deriving/should_compile/T14578.stderr
+++ b/testsuite/tests/deriving/should_compile/T14578.stderr
@@ -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