Print types more truthfullywip/T18458

See #18458.

Class methods in particular get more nested types

12 files changed, 63 insertions, 60 deletions

diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 28a628344f..d98905829d 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -418,24 +418,14 @@ isIfaceLiftedTypeKind (IfaceTyConApp tc
 isIfaceLiftedTypeKind _ = False
 
 splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
--- Mainly for printing purposes
+-- Splits (forall tv1 .. tvn. (c1, ..., cn) => tau)
+-- into ([tv1,..,tvn], [c1, .., cm], tau)
 --
--- Here we split nested IfaceSigmaTy properly.
---
--- @
--- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b)
--- @
---
--- If you called @splitIfaceSigmaTy@ on this type:
---
--- @
--- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b))
--- @
+-- Historical note: this function used to split multiple levels
+-- and put all the foralls at the top; but that is plain confusing,
+-- so we made it do the simple thing.  See #18458
 splitIfaceSigmaTy ty
-  = case (bndrs, theta) of
-      ([], []) -> (bndrs, theta, tau)
-      _        -> let (bndrs', theta', tau') = splitIfaceSigmaTy tau
-                   in (bndrs ++ bndrs', theta ++ theta', tau')
+  = (bndrs, theta, tau)
   where
     (bndrs, rho)   = split_foralls ty
     (theta, tau)   = split_rho rho
diff --git a/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
index 851e92e5fd..f7acf41928 100644
--- a/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
@@ -22,9 +22,9 @@ free_monad_hole_fits.hs:14:28: warning: [-Wtyped-holes (in -Wdefault)]
       Constraints include
         Functor f (from free_monad_hole_fits.hs:10:10-38)
       Valid hole fits include
-        fmap :: forall (f :: * -> *) a b.
+        fmap :: forall (f :: * -> *).
                 Functor f =>
-                (a -> b) -> f a -> f b
+                forall a b. (a -> b) -> f a -> f b
         (<$>) :: forall (f :: * -> *) a b.
                  Functor f =>
                  (a -> b) -> f a -> f b
@@ -32,7 +32,9 @@ free_monad_hole_fits.hs:14:28: warning: [-Wtyped-holes (in -Wdefault)]
         ($) (_ :: (Free f a -> Free f b) -> f (Free f a) -> f (Free f b))
           where ($) :: forall a b. (a -> b) -> a -> b
         pure (_ :: f (Free f a) -> f (Free f b))
-          where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+          where pure :: forall (f :: * -> *).
+                        Applicative f =>
+                        forall a. a -> f a
 
 free_monad_hole_fits.hs:25:31: warning: [-Wtyped-holes (in -Wdefault)]
     • Found hole: _a :: Free f a -> Free f b
@@ -56,13 +58,13 @@ free_monad_hole_fits.hs:25:31: warning: [-Wtyped-holes (in -Wdefault)]
         Applicative f (from free_monad_hole_fits.hs:22:10-40)
       Valid refinement hole fits include
         fmap (_ :: a -> b)
-          where fmap :: forall (f :: * -> *) a b.
+          where fmap :: forall (f :: * -> *).
                         Functor f =>
-                        (a -> b) -> f a -> f b
+                        forall a b. (a -> b) -> f a -> f b
         (<*>) (_ :: Free f (a -> b))
-          where (<*>) :: forall (f :: * -> *) a b.
+          where (<*>) :: forall (f :: * -> *).
                          Applicative f =>
-                         f (a -> b) -> f a -> f b
+                         forall a b. f (a -> b) -> f a -> f b
         (<$>) (_ :: a -> b)
           where (<$>) :: forall (f :: * -> *) a b.
                          Functor f =>
@@ -74,4 +76,6 @@ free_monad_hole_fits.hs:25:31: warning: [-Wtyped-holes (in -Wdefault)]
         ($) (_ :: Free f a -> Free f b)
           where ($) :: forall a b. (a -> b) -> a -> b
         pure (_ :: Free f b)
-          where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+          where pure :: forall (f :: * -> *).
+                        Applicative f =>
+                        forall a. a -> f a
diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr
index 77a6fc9a40..f5136c2b93 100644
--- a/testsuite/tests/typecheck/should_compile/holes.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes.stderr
@@ -180,13 +180,13 @@ holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)]
         scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b]
         unzip :: forall a b. [(a, b)] -> ([a], [b])
         (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a
-        ceiling :: forall a b. (RealFrac a, Integral b) => a -> b
-        floor :: forall a b. (RealFrac a, Integral b) => a -> b
-        properFraction :: forall a b.
-                          (RealFrac a, Integral b) =>
-                          a -> (b, a)
-        round :: forall a b. (RealFrac a, Integral b) => a -> b
-        truncate :: forall a b. (RealFrac a, Integral b) => a -> b
+        ceiling :: forall a. RealFrac a => forall b. Integral b => a -> b
+        floor :: forall a. RealFrac a => forall b. Integral b => a -> b
+        properFraction :: forall a.
+                          RealFrac a =>
+                          forall b. Integral b => a -> (b, a)
+        round :: forall a. RealFrac a => forall b. Integral b => a -> b
+        truncate :: forall a. RealFrac a => forall b. Integral b => a -> b
         seq :: forall a b. a -> b -> b
         ($) :: forall a b. (a -> b) -> a -> b
         either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
diff --git a/testsuite/tests/typecheck/should_compile/holes3.stderr b/testsuite/tests/typecheck/should_compile/holes3.stderr
index 874fd4459f..e21119b622 100644
--- a/testsuite/tests/typecheck/should_compile/holes3.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes3.stderr
@@ -183,13 +183,13 @@ holes3.hs:11:15: error:
         scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b]
         unzip :: forall a b. [(a, b)] -> ([a], [b])
         (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a
-        ceiling :: forall a b. (RealFrac a, Integral b) => a -> b
-        floor :: forall a b. (RealFrac a, Integral b) => a -> b
-        properFraction :: forall a b.
-                          (RealFrac a, Integral b) =>
-                          a -> (b, a)
-        round :: forall a b. (RealFrac a, Integral b) => a -> b
-        truncate :: forall a b. (RealFrac a, Integral b) => a -> b
+        ceiling :: forall a. RealFrac a => forall b. Integral b => a -> b
+        floor :: forall a. RealFrac a => forall b. Integral b => a -> b
+        properFraction :: forall a.
+                          RealFrac a =>
+                          forall b. Integral b => a -> (b, a)
+        round :: forall a. RealFrac a => forall b. Integral b => a -> b
+        truncate :: forall a. RealFrac a => forall b. Integral b => a -> b
         seq :: forall a b. a -> b -> b
         ($) :: forall a b. (a -> b) -> a -> b
         either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
diff --git a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
index 6007ab4d0b..03f856985b 100644
--- a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr
@@ -25,15 +25,17 @@ subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)]
           with mempty @(String -> [String])
           (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
            (and originally defined in ‘GHC.Base’))
-        fail :: forall (m :: * -> *) a. MonadFail m => String -> m a
+        fail :: forall (m :: * -> *).
+                MonadFail m =>
+                forall a. String -> m a
           with fail @[] @String
           (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
            (and originally defined in ‘Control.Monad.Fail’))
-        return :: forall (m :: * -> *) a. Monad m => a -> m a
+        return :: forall (m :: * -> *). Monad m => forall a. a -> m a
           with return @[] @String
           (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
            (and originally defined in ‘GHC.Base’))
-        pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+        pure :: forall (f :: * -> *). Applicative f => forall a. a -> f a
           with pure @[] @String
           (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1
            (and originally defined in ‘GHC.Base’))
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr
index 61ec4e0551..235508aa64 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc231.stderr
@@ -3,7 +3,8 @@ TYPE SIGNATURES
     forall {s} {b} {chain}.
     Zork s (Z [Char]) b =>
     Q s (Z [Char]) chain -> ST s ()
-  huh :: forall s a b chain. Zork s a b => Q s a chain -> ST s ()
+  huh ::
+    forall s a b. Zork s a b => forall chain. Q s a chain -> ST s ()
   s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1
 TYPE CONSTRUCTORS
   data type Q{3} :: * -> * -> * -> *
@@ -15,4 +16,4 @@ DATA CONSTRUCTORS
   Z :: forall a. a -> Z a
   Node :: forall s a chain. s -> a -> chain -> Q s a chain
 Dependent modules: []
-Dependent packages: [base-4.13.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
+Dependent packages: [base-4.15.0.0, ghc-bignum-1.0, ghc-prim-0.7.0]
diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
index 116a18f42f..9b98dc0ed7 100644
--- a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
@@ -24,11 +24,11 @@ valid_hole_fits.hs:17:17: warning: [-Wtyped-holes (in -Wdefault)]
         c :: Int -> IO Int (bound at valid_hole_fits.hs:16:1)
         a :: Int -> IO Int (bound at valid_hole_fits.hs:12:1)
         b :: Int -> IO Int (bound at valid_hole_fits.hs:14:1)
-        return :: forall (m :: * -> *) a. Monad m => a -> m a
+        return :: forall (m :: * -> *). Monad m => forall a. a -> m a
           with return @IO @Int
           (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
            (and originally defined in ‘GHC.Base’))
-        pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+        pure :: forall (f :: * -> *). Applicative f => forall a. a -> f a
           with pure @IO @Int
           (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
            (and originally defined in ‘GHC.Base’))
@@ -80,11 +80,11 @@ valid_hole_fits.hs:27:5: warning: [-Wtyped-holes (in -Wdefault)]
           with Just @Integer
           (imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17
            (and originally defined in ‘GHC.Maybe’))
-        return :: forall (m :: * -> *) a. Monad m => a -> m a
+        return :: forall (m :: * -> *). Monad m => forall a. a -> m a
           with return @Maybe @Integer
           (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
            (and originally defined in ‘GHC.Base’))
-        pure :: forall (f :: * -> *) a. Applicative f => a -> f a
+        pure :: forall (f :: * -> *). Applicative f => forall a. a -> f a
           with pure @Maybe @Integer
           (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
            (and originally defined in ‘GHC.Base’))
@@ -211,7 +211,9 @@ valid_hole_fits.hs:38:10: warning: [-Wtyped-holes (in -Wdefault)]
         (:) :: forall a. a -> [a] -> [a]
           with (:) @a
           (bound at <wired into compiler>)
-        (<$) :: forall (f :: * -> *) a b. Functor f => a -> f b -> f a
+        (<$) :: forall (f :: * -> *).
+                Functor f =>
+                forall a b. a -> f b -> f a
           with (<$) @[] @a @a
           (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
            (and originally defined in ‘GHC.Base’))
@@ -245,7 +247,9 @@ valid_hole_fits.hs:41:8: warning: [-Wtyped-holes (in -Wdefault)]
           with print @String
           (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
            (and originally defined in ‘System.IO’))
-        fail :: forall (m :: * -> *) a. MonadFail m => String -> m a
+        fail :: forall (m :: * -> *).
+                MonadFail m =>
+                forall a. String -> m a
           with fail @IO @()
           (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40
            (and originally defined in ‘Control.Monad.Fail’))
diff --git a/testsuite/tests/typecheck/should_fail/T12083b.stderr b/testsuite/tests/typecheck/should_fail/T12083b.stderr
index 87649ec4c3..4a88132f40 100644
--- a/testsuite/tests/typecheck/should_fail/T12083b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12083b.stderr
@@ -3,5 +3,5 @@ T12083b.hs:6:5: error:
     • Illegal qualified type: Eq a => r
       Perhaps you intended to use RankNTypes
     • When checking the class method:
-        test :: forall a r. Class a => a -> (Eq a => r) -> r
+        test :: forall a. Class a => forall r. a -> (Eq a => r) -> r
       In the class declaration for ‘Class’
diff --git a/testsuite/tests/typecheck/should_fail/T12151.stderr b/testsuite/tests/typecheck/should_fail/T12151.stderr
index 8a4831c535..4b233d8b64 100644
--- a/testsuite/tests/typecheck/should_fail/T12151.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12151.stderr
@@ -9,7 +9,7 @@ T12151.hs:9:13: error:
     • Could not deduce (Put a0)
       from the context: Put a
         bound by the type signature for:
-                   put :: forall a t. Put a => t
+                   put :: forall a. Put a => forall t. t
         at T12151.hs:9:13-15
       The type variable ‘a0’ is ambiguous
     • In the ambiguity check for ‘put’
diff --git a/testsuite/tests/typecheck/should_fail/T12918b.stderr b/testsuite/tests/typecheck/should_fail/T12918b.stderr
index 3492ca6415..92aa85e9f3 100644
--- a/testsuite/tests/typecheck/should_fail/T12918b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12918b.stderr
@@ -3,34 +3,34 @@ T12918b.hs:8:11: error:
     • The default type signature for bar1: forall b. b -> a
       does not match its corresponding non-default type signature
     • When checking the class method:
-        bar1 :: forall a b. Foo1 a => a -> b
+        bar1 :: forall a. Foo1 a => forall b. a -> b
       In the class declaration for ‘Foo1’
 
 T12918b.hs:12:11: error:
     • The default type signature for bar2: forall x. x
       does not match its corresponding non-default type signature
     • When checking the class method:
-        bar2 :: forall a b. Foo1 a => a -> b
+        bar2 :: forall a. Foo1 a => forall b. a -> b
       In the class declaration for ‘Foo1’
 
 T12918b.hs:12:11: error:
     • Could not deduce (Foo1 a0)
       from the context: Foo1 a
         bound by the type signature for:
-                   bar2 :: forall a x. Foo1 a => x
+                   bar2 :: forall a. Foo1 a => forall x. x
         at T12918b.hs:12:11-14
       The type variable ‘a0’ is ambiguous
     • In the ambiguity check for ‘bar2’
       To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
       When checking the class method:
-        bar2 :: forall a b. Foo1 a => a -> b
+        bar2 :: forall a. Foo1 a => forall b. a -> b
       In the class declaration for ‘Foo1’
 
 T12918b.hs:16:11: error:
     • The default type signature for bar3: a -> Int
       does not match its corresponding non-default type signature
     • When checking the class method:
-        bar3 :: forall a b. Foo1 a => a -> b
+        bar3 :: forall a. Foo1 a => forall b. a -> b
       In the class declaration for ‘Foo1’
 
 T12918b.hs:20:11: error:
diff --git a/testsuite/tests/typecheck/should_fail/T14884.stderr b/testsuite/tests/typecheck/should_fail/T14884.stderr
index e1738891a7..2f5dedd6a1 100644
--- a/testsuite/tests/typecheck/should_fail/T14884.stderr
+++ b/testsuite/tests/typecheck/should_fail/T14884.stderr
@@ -13,9 +13,9 @@ T14884.hs:4:5: error:
           with mapM_ @[] @IO @Char @()
           (imported from ‘Prelude’ at T14884.hs:1:8-13
            (and originally defined in ‘Data.Foldable’))
-        foldMap :: forall (t :: * -> *) m a.
-                   (Foldable t, Monoid m) =>
-                   (a -> m) -> t a -> m
+        foldMap :: forall (t :: * -> *).
+                   Foldable t =>
+                   forall m a. Monoid m => (a -> m) -> t a -> m
           with foldMap @[] @(IO ()) @Char
           (imported from ‘Prelude’ at T14884.hs:1:8-13
            (and originally defined in ‘Data.Foldable’))
diff --git a/testsuite/tests/typecheck/should_fail/T7437.stderr b/testsuite/tests/typecheck/should_fail/T7437.stderr
index 9b75781411..d6663df40e 100644
--- a/testsuite/tests/typecheck/should_fail/T7437.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7437.stderr
@@ -11,7 +11,9 @@ T7437.hs:14:13: error:
     • Could not deduce (Put a0)
       from the context: (Put a, Generic t, GPut (Rep t))
         bound by the type signature for:
-                   put :: forall a t. (Put a, Generic t, GPut (Rep t)) => t -> [()]
+                   put :: forall a.
+                          Put a =>
+                          forall t. (Generic t, GPut (Rep t)) => t -> [()]
         at T7437.hs:14:13-15
       The type variable ‘a0’ is ambiguous
     • In the ambiguity check for ‘put’