Incorrect -ddump-deriv parenthesization for GND'd fmap implementation

This program:

{-# 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:

nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
nlHsFunTy a b = noLoc (HsFunTy noExt a b)

This makes no attempt to add HsParTys 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:

(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 Types:

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.

Trac metadata

Trac field	Value
Version	8.4.3
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture