Fix #15308 by suppressing invisble args more rigorously
authorRyan Scott <ryan.gl.scott@gmail.com>
Thu, 5 Jul 2018 12:30:02 +0000 (08:30 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 12 Jul 2018 21:06:12 +0000 (17:06 -0400)
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

(cherry picked from commit 93b7ac8d73885369f61f6eb6147352d45de4e957)

compiler/iface/IfaceType.hs
testsuite/tests/dependent/should_fail/T15308.hs [new file with mode: 0644]
testsuite/tests/dependent/should_fail/T15308.stderr [new file with mode: 0644]
testsuite/tests/dependent/should_fail/all.T
testsuite/tests/typecheck/should_fail/T12785b.stderr

index 3b1c948..5a7f761 100644 (file)
@@ -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 (file)
index 0000000..b49fe1f
--- /dev/null
@@ -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 (file)
index 0000000..a4bdbd5
--- /dev/null
@@ -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
index 2bfc39a..1bc3f42 100644 (file)
@@ -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'])
index b8e572d..44937c3 100644 (file)
@@ -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 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) f s (bound at T12785b.hs:29:12)
-        nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) 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)