[commit: ghc] master: Put parens around (ty :: kind) when pretty-printing TH syntax (111e587)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/111e5870803bcccd1c0736fdba432f8f9410454f/ghc

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

commit 111e5870803bcccd1c0736fdba432f8f9410454f
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Feb 6 14:48:33 2015 +0000

    Put parens around (ty :: kind) when pretty-printing TH syntax
    
    See Note [Pretty-printing kind signatures] in Language.Haskell.TH.Ppr.hs,
    and Trac #10050.


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

111e5870803bcccd1c0736fdba432f8f9410454f
 libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 15 +++++++++++++--
 testsuite/tests/th/T8953.stderr                       | 12 ++++++------
 testsuite/tests/th/TH_RichKinds.stderr                | 14 +++++++-------
 3 files changed, 26 insertions(+), 15 deletions(-)

diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 4ba43f3..e5cab65 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -498,14 +498,25 @@ pprParendType PromotedNilT        = text "'[]"
 pprParendType PromotedConsT       = text "(':)"
 pprParendType StarT               = char '*'
 pprParendType ConstraintT         = text "Constraint"
+pprParendType (SigT ty k)         = parens (ppr ty <+> text "::" <+> ppr k)
 pprParendType other               = parens (ppr other)
 
 instance Ppr Type where
     ppr (ForallT tvars ctxt ty)
       = text "forall" <+> hsep (map ppr tvars) <+> text "."
                       <+> sep [pprCxt ctxt, ppr ty]
-    ppr (SigT ty k) = ppr ty <+> text "::" <+> ppr k
-    ppr ty          = pprTyApp (split ty)
+    ppr ty = pprTyApp (split ty)
+       -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind)
+       -- See Note [Pretty-printing kind signatures]
+
+{- Note [Pretty-printing kind signatures]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GHC's parser only recognises a kind signature in a type when there are
+parens around it.  E.g. the parens are required here:
+   f :: (Int :: *)
+   type instance F Int = (Bool :: *)
+So we always print a SigT with parens (see Trac #10050). -}
+
 
 pprTyApp :: (Type, [Type]) -> Doc
 pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]
diff --git a/testsuite/tests/th/T8953.stderr b/testsuite/tests/th/T8953.stderr
index 14db2b7..94312ef 100644
--- a/testsuite/tests/th/T8953.stderr
+++ b/testsuite/tests/th/T8953.stderr
@@ -2,8 +2,8 @@ type family T8953.Poly (a_0 :: k_1) :: *
 type instance T8953.Poly (x_2 :: GHC.Types.Bool) = GHC.Types.Int
 type instance T8953.Poly (x_3 :: GHC.Base.Maybe k_4) = GHC.Types.Double
 type family T8953.Silly :: k_0 -> *
-type instance T8953.Silly = Data.Proxy.Proxy :: * -> *
-type instance T8953.Silly = Data.Proxy.Proxy :: (* -> *) -> *
+type instance T8953.Silly = (Data.Proxy.Proxy :: * -> *)
+type instance T8953.Silly = (Data.Proxy.Proxy :: (* -> *) -> *)
 T8953.a :: Data.Proxy.Proxy (Data.Proxy.Proxy :: * -> *)
 T8953.b :: Data.Proxy.Proxy (Data.Proxy.Proxy :: (* -> *) -> *)
 type T8953.StarProxy (a_0 :: *) = Data.Proxy.Proxy a_0
@@ -11,9 +11,9 @@ class T8953.PC (a_0 :: k_1)
 instance T8953.PC (a_2 :: *)
 instance T8953.PC (Data.Proxy.Proxy :: (k_3 -> *) -> *)
 type family T8953.F (a_0 :: *) :: k_1
-type instance T8953.F GHC.Types.Char = T8953.G (T8953.T1 :: * ->
-                                                            (* -> *) -> *)
-                                               GHC.Types.Bool :: (* -> *) -> *
+type instance T8953.F GHC.Types.Char = (T8953.G (T8953.T1 :: * ->
+                                                             (* -> *) -> *)
+                                                GHC.Types.Bool :: (* -> *) -> *)
 type family T8953.G (a_0 :: k_1) :: k_1
 type instance T8953.G (T8953.T1 :: k_2 ->
-                                   k1_3 -> *) = T8953.T2 :: k_2 -> k1_3 -> *
+                                   k1_3 -> *) = (T8953.T2 :: k_2 -> k1_3 -> *)
diff --git a/testsuite/tests/th/TH_RichKinds.stderr b/testsuite/tests/th/TH_RichKinds.stderr
index c52667e..09a8e40 100644
--- a/testsuite/tests/th/TH_RichKinds.stderr
+++ b/testsuite/tests/th/TH_RichKinds.stderr
@@ -1,9 +1,9 @@
 
 TH_RichKinds.hs:12:3: Warning:
-    forall a_0 . a_0 :: GHC.Types.Bool
-forall a_1 . a_1 :: Constraint
-forall a_2 . a_2 :: [*]
-forall a_3 . a_3 :: (*, GHC.Types.Bool)
-forall a_4 . a_4 :: GHC.Tuple.()
-forall a_5 . a_5 :: (* -> GHC.Types.Bool) ->
-                    (*, * -> *) -> GHC.Types.Bool
+    forall a_0 . (a_0 :: GHC.Types.Bool)
+forall a_1 . (a_1 :: Constraint)
+forall a_2 . (a_2 :: [*])
+forall a_3 . (a_3 :: (*, GHC.Types.Bool))
+forall a_4 . (a_4 :: GHC.Tuple.())
+forall a_5 . (a_5 :: (* -> GHC.Types.Bool) ->
+                     (*, * -> *) -> GHC.Types.Bool)