[commit: ghc] master: Fix #15308 by suppressing invisble args more rigorously (93b7ac8)

[git at git.haskell.org]

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

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

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

commit 93b7ac8d73885369f61f6eb6147352d45de4e957
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Thu Jul 5 08:30:02 2018 -0400

    Fix #15308 by suppressing invisble args more rigorously
    
    Summary:
    There was a buglet in `stripInvisArgs` (which is part of the
    pretty-printing pipeline for types) in which only invisble arguments
    which came before any visible arguments would be suppressed, but any
    invisble arguments that came //after// visible ones would still be
    printed, even if `-fprint-explicit-kinds`  wasn't enabled.
    The fix is simple: make `stripInvisArgs` recursively process the
    remaining types even after a visible argument is encountered.
    
    Test Plan: make test TEST=T15308
    
    Reviewers: goldfire, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: simonpj, rwbarton, thomie, carter
    
    GHC Trac Issues: #15308
    
    Differential Revision: https://phabricator.haskell.org/D4891


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

93b7ac8d73885369f61f6eb6147352d45de4e957
 compiler/iface/IfaceType.hs                          |  7 ++++++-
 testsuite/tests/dependent/should_fail/T15308.hs      | 12 ++++++++++++
 testsuite/tests/dependent/should_fail/T15308.stderr  |  5 +++++
 testsuite/tests/dependent/should_fail/all.T          |  1 +
 testsuite/tests/typecheck/should_fail/T12785b.stderr | 12 ++++--------
 5 files changed, 28 insertions(+), 9 deletions(-)

diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 537f419..d741265 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -513,8 +513,13 @@ stripInvisArgs dflags tys
     where
       suppress_invis c
         = case c of
+            ITC_Nil        -> ITC_Nil
             ITC_Invis _ ts -> suppress_invis ts
-            _ -> c
+            ITC_Vis   t ts -> ITC_Vis t $ suppress_invis ts
+              -- Keep recursing through the remainder of the arguments, as it's
+              -- possible that there are remaining invisible ones.
+              -- See the "In type declarations" section of Note [TyVarBndrs,
+              -- TyVarBinders, TyConBinders, and visibility] in TyCoRep.
 
 tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
 tcArgsIfaceTypes ITC_Nil = []
diff --git a/testsuite/tests/dependent/should_fail/T15308.hs b/testsuite/tests/dependent/should_fail/T15308.hs
new file mode 100644
index 0000000..b49fe1f
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T15308.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeInType #-}
+module T15308 where
+
+import Data.Kind
+
+data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where
+  MkFoo :: Foo a f
+
+f :: Foo a f -> String
+f = show
diff --git a/testsuite/tests/dependent/should_fail/T15308.stderr b/testsuite/tests/dependent/should_fail/T15308.stderr
new file mode 100644
index 0000000..a4bdbd5
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T15308.stderr
@@ -0,0 +1,5 @@
+
+T15308.hs:12:5: error:
+    • No instance for (Show (Foo a f)) arising from a use of ‘show’
+    • In the expression: show
+      In an equation for ‘f’: f = show
diff --git a/testsuite/tests/dependent/should_fail/all.T b/testsuite/tests/dependent/should_fail/all.T
index 2bfc39a..1bc3f42 100644
--- a/testsuite/tests/dependent/should_fail/all.T
+++ b/testsuite/tests/dependent/should_fail/all.T
@@ -32,3 +32,4 @@ test('T14845_fail2', normal, compile_fail, [''])
 test('InferDependency', normal, compile_fail, [''])
 test('T15245', normal, compile_fail, [''])
 test('T15215', normal, compile_fail, [''])
+test('T15308', normal, compile_fail, ['-fno-print-explicit-kinds'])
diff --git a/testsuite/tests/typecheck/should_fail/T12785b.stderr b/testsuite/tests/typecheck/should_fail/T12785b.stderr
index b8e572d..44937c3 100644
--- a/testsuite/tests/typecheck/should_fail/T12785b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12785b.stderr
@@ -11,7 +11,7 @@ T12785b.hs:29:63: error:
       ‘s’ is a rigid type variable bound by
         a pattern with constructor:
           Hide :: forall a (n :: Peano) (f :: a -> *) (s :: HTree n a).
-                  STree n a f s -> Hidden n f,
+                  STree n f s -> Hidden n f,
         in an equation for ‘nest’
         at T12785b.hs:29:7-12
     • In the second argument of ‘($)’, namely ‘a `SBranchX` tr’
@@ -20,12 +20,8 @@ T12785b.hs:29:63: error:
           nest (Hide a `Branch` (nest . hmap nest -> Hide tr))
             = Hide $ a `SBranchX` tr
     • Relevant bindings include
-        tr :: STree
-                n
-                (HTree ('S n) (HTree ('S ('S n)) a))
-                (STree ('S n) (HTree ('S ('S n)) a) (STree ('S ('S n)) a f))
-                s1
+        tr :: STree n (STree ('S n) (STree ('S ('S n)) f)) s1
           (bound at T12785b.hs:29:49)
-        a :: STree ('S m) a f s (bound at T12785b.hs:29:12)
-        nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) a f)
+        a :: STree ('S m) f s (bound at T12785b.hs:29:12)
+        nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) f)
           (bound at T12785b.hs:27:1)