[GHC] #15307: Incorrect -ddump-deriv parenthesization for GND'd fmap implementation

[GHC]

#15307: Incorrect -ddump-deriv parenthesization for GND'd fmap implementation
-------------------------------------+-------------------------------------
           Reporter:  RyanGlScott    |             Owner:  (none)
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:  8.6.1
          Component:  Compiler       |           Version:  8.4.3
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 This program:

 {{{#!hs
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -ddump-deriv #-}
 module Bug where

 newtype Foo a = MkFoo (Maybe a) deriving Functor
 }}}

 When compiling, displays incorrect code in its `-ddump-deriv` output:

 {{{
 $ ghci Bug.hs
 GHCi, version 8.4.3: http://www.haskell.org/ghc/  :? for help
 Loaded GHCi configuration from /home/ryanglscott/.ghci
 [1 of 1] Compiling Bug              ( Bug.hs, interpreted )

 ==================== Derived instances ====================
 Derived class instances:
   instance GHC.Base.Functor Bug.Foo where
     GHC.Base.fmap
       = GHC.Prim.coerce
           @(forall (a_a1y2 :: TYPE GHC.Types.LiftedRep)
                    (b_a1y3 :: TYPE GHC.Types.LiftedRep).
             a_a1y2 -> b_a1y3 -> GHC.Base.Maybe a_a1y2 -> GHC.Base.Maybe
 b_a1y3)
           @(forall (a_a1y2 :: TYPE GHC.Types.LiftedRep)
                    (b_a1y3 :: TYPE GHC.Types.LiftedRep).
             a_a1y2 -> b_a1y3 -> Bug.Foo a_a1y2 -> Bug.Foo b_a1y3)
           GHC.Base.fmap
     (GHC.Base.<$)
       = GHC.Prim.coerce
           @(forall (a_a1y9 :: TYPE GHC.Types.LiftedRep)
                    (b_a1ya :: TYPE GHC.Types.LiftedRep).
             a_a1y9 -> GHC.Base.Maybe b_a1ya -> GHC.Base.Maybe a_a1y9)
           @(forall (a_a1y9 :: TYPE GHC.Types.LiftedRep)
                    (b_a1ya :: TYPE GHC.Types.LiftedRep).
             a_a1y9 -> Bug.Foo b_a1ya -> Bug.Foo a_a1y9)
           (GHC.Base.<$)


 Derived type family instances:


 Ok, one module loaded.
 }}}

 Notice how the type of `fmap` is `a_a1y2 -> b_a1y3 -> Bug.Foo a_a1y2 ->
 Bug.Foo b_a1y3`, not `(a_a1y2 -> b_a1y3) -> Bug.Foo a_a1y2 -> Bug.Foo
 b_a1y3`.

 The culprit is the `nlHsFunTy` function, which is used to construct this
 function type in `typeToLHsType`:

 {{{#!hs
 nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType
 (GhcPass p)
 nlHsFunTy a b = noLoc (HsFunTy noExt a b)
 }}}

 This makes no attempt to add `HsParTy`s around any of its arguments. It's
 tempting to parenthesize //both// arguments, but interestingly, if you do
 this, then the type of `fmap` would become:

 {{{#!hs
 (a -> b) -> (Foo a -> Foo b)
 }}}

 This perhaps not what we want, since the parentheses around `Foo a -> Foo
 b` are redundant. Therefore, I propose that we adopt the same
 parenthesization scheme that `ppr_ty` uses for pretty-printing Core
 `Type`s:

 {{{#!hs
 ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
   = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
     maybeParen ctxt_prec funPrec $
     sep [ppr_ty funPrec ty1, sep (ppr_fun_tail ty2)]
   where
     ppr_fun_tail (IfaceFunTy ty1 ty2)
       = (arrow <+> ppr_ty funPrec ty1) : ppr_fun_tail ty2
     ppr_fun_tail other_ty
       = [arrow <+> pprIfaceType other_ty]
 }}}

 Namely, always parenthesize the argument type under `funPrec`, and
 recursively check the result type to see if it's also a function type,
 parenthesizing its arguments as necessary.

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15307>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler