[commit: ghc] master: Make ppr_tc_args aware of -fprint-explicit-kinds (dbdcacf)

[git at git.haskell.org]

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

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

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

commit dbdcacfc55f28d8a85484cc1cf13dd78c45bf7ee
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Jul 5 08:52:20 2018 -0400

    Make ppr_tc_args aware of -fprint-explicit-kinds
    
    Summary:
    `ppr_tc_args` was printing invisible kind arguments even
    when `-fprint-explicit-kinds` wasn't enabled. Easily fixed.
    
    Test Plan: make test TEST=T15341
    
    Reviewers: goldfire, bgamari, simonpj
    
    Reviewed By: simonpj
    
    Subscribers: simonpj, rwbarton, thomie, carter
    
    GHC Trac Issues: #15341
    
    Differential Revision: https://phabricator.haskell.org/D4932


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

dbdcacfc55f28d8a85484cc1cf13dd78c45bf7ee
 compiler/iface/IfaceType.hs                                 | 8 ++++++--
 testsuite/tests/ghci/scripts/T15341.hs                      | 6 ++++++
 testsuite/tests/ghci/scripts/T15341.script                  | 4 ++++
 testsuite/tests/ghci/scripts/T15341.stdout                  | 6 ++++++
 testsuite/tests/ghci/scripts/T7939.stdout                   | 8 ++++----
 testsuite/tests/ghci/scripts/all.T                          | 1 +
 testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr | 2 +-
 7 files changed, 28 insertions(+), 7 deletions(-)

diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index d741265..5a7f761 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -824,11 +824,15 @@ pprParendIfaceTcArgs = ppr_tc_args appPrec
 
 ppr_tc_args :: PprPrec -> IfaceTcArgs -> SDoc
 ppr_tc_args ctx_prec args
- = let pprTys t ts = ppr_ty ctx_prec t <+> ppr_tc_args ctx_prec ts
+ = let ppr_rest    = ppr_tc_args ctx_prec
+       pprTys t ts = ppr_ty ctx_prec t <+> ppr_rest ts
    in case args of
         ITC_Nil        -> empty
         ITC_Vis   t ts -> pprTys t ts
-        ITC_Invis t ts -> pprTys t ts
+        ITC_Invis t ts -> sdocWithDynFlags $ \dflags ->
+                          if gopt Opt_PrintExplicitKinds dflags
+                             then pprTys t ts
+                             else ppr_rest ts
 
 -------------------
 pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
diff --git a/testsuite/tests/ghci/scripts/T15341.hs b/testsuite/tests/ghci/scripts/T15341.hs
new file mode 100644
index 0000000..b84c1bb
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T15341.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+module T15341 where
+
+type family Foo (a :: k) :: k where
+  Foo a = a
diff --git a/testsuite/tests/ghci/scripts/T15341.script b/testsuite/tests/ghci/scripts/T15341.script
new file mode 100644
index 0000000..0a3ffdc
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T15341.script
@@ -0,0 +1,4 @@
+:load T15341.hs
+:info Foo
+:set -fprint-explicit-kinds
+:info Foo
diff --git a/testsuite/tests/ghci/scripts/T15341.stdout b/testsuite/tests/ghci/scripts/T15341.stdout
new file mode 100644
index 0000000..1d29dc7
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T15341.stdout
@@ -0,0 +1,6 @@
+type family Foo (a :: k) :: k
+  where Foo a = a
+  	-- Defined at T15341.hs:5:1
+type family Foo k (a :: k) :: k
+  where Foo k a = a
+  	-- Defined at T15341.hs:5:1
diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout
index db2590c..82a8658 100644
--- a/testsuite/tests/ghci/scripts/T7939.stdout
+++ b/testsuite/tests/ghci/scripts/T7939.stdout
@@ -15,13 +15,13 @@ type family H (a :: Bool) :: Bool
 H :: Bool -> Bool
 type family J (a :: [k]) :: Bool
   where
-      J k '[] = 'False
-      J k (h : t) = 'True
+      J '[] = 'False
+      J (h : t) = 'True
   	-- Defined at T7939.hs:17:1
 J :: [k] -> Bool
 type family K (a1 :: [a]) :: Maybe a
   where
-      K a '[] = 'Nothing
-      K a (h : t) = 'Just h
+      K '[] = 'Nothing
+      K (h : t) = 'Just h
   	-- Defined at T7939.hs:21:1
 K :: [a] -> Maybe a
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 29fbdf8..8954594 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -269,3 +269,4 @@ test('T14676', extra_files(['../prog002']), ghci_script, ['T14676.script'])
 test('T14796', normal, ghci_script, ['T14796.script'])
 test('T14969', normal, ghci_script, ['T14969.script'])
 test('T15259', normal, ghci_script, ['T15259.script'])
+test('T15341', normal, ghci_script, ['T15341.script'])
diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
index ba1f46e..cab5078 100644
--- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
+++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
@@ -27,5 +27,5 @@ ClosedFam3.hs-boot:12:1: error:
     Main module: type family Baz a :: *
                    where Baz Int = Bool
     Boot file:   type family Baz (a :: k) :: *
-                   where Baz * Int = Bool
+                   where Baz Int = Bool
     The types have different kinds