Don't reify redundant class method tyvars/contexts

Summary:
Currently, reifying classes produces class methods with
redundant tyvars and class contexts in their type signatures, such
as in the following:

```lang=haskell
class C a where
  method :: forall a. C a => a
```

Fixing this is very straightforward: just apply `tcSplitMethodTy` to
the type of each class method to lop off the redundant parts.

It's possible that this could break some TH code in the wild that
assumes the existence of these tyvars and class contexts, so I'll
advertise this change in the release notes just to be safe.

Test Plan: make test TEST="TH_reifyDecl1 T9064 T10891 T14888"

Reviewers: goldfire, bgamari, simonpj

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, carter

GHC Trac Issues: #15551

Differential Revision: https://phabricator.haskell.org/D5088

6 files changed, 32 insertions, 18 deletions

diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index d57ec1c3bf..5a26de5196 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -1576,13 +1576,17 @@ reifyClass cls
     (_, fds, theta, _, ats, op_stuff) = classExtraBigSig cls
     fds' = map reifyFunDep fds
     reify_op (op, def_meth)
-      = do { ty <- reifyType (idType op)
+      = do { let (_, _, ty) = tcSplitMethodTy (idType op)
+               -- Use tcSplitMethodTy to get rid of the extraneous class
+               -- variables and predicates at the beginning of op's type
+               -- (see #15551).
+           ; ty' <- reifyType ty
            ; let nm' = reifyName op
            ; case def_meth of
                 Just (_, GenericDM gdm_ty) ->
                   do { gdm_ty' <- reifyType gdm_ty
-                     ; return [TH.SigD nm' ty, TH.DefaultSigD nm' gdm_ty'] }
-                _ -> return [TH.SigD nm' ty] }
+                     ; return [TH.SigD nm' ty', TH.DefaultSigD nm' gdm_ty'] }
+                _ -> return [TH.SigD nm' ty'] }
 
     reifyAT :: ClassATItem -> TcM [TH.Dec]
     reifyAT (ATI tycon def) = do
diff --git a/docs/users_guide/8.8.1-notes.rst b/docs/users_guide/8.8.1-notes.rst
index 0a095f02f2..da236f923d 100644
--- a/docs/users_guide/8.8.1-notes.rst
+++ b/docs/users_guide/8.8.1-notes.rst
@@ -52,6 +52,21 @@ Runtime system
 Template Haskell
 ~~~~~~~~~~~~~~~~
 
+- Reifying type classes no longer shows redundant class type variables and
+  contexts in the type signature of each class method. For instance,
+  reifying the following class: ::
+
+    class C a where
+      method :: a
+
+  Used to produce the following: ::
+
+    class C a where
+      method :: forall a. C a => a
+
+  Where the ``forall a. C a =>`` part is entirely redundant. This part is no
+  longer included when reifying ``C``. It's possible that this may break some
+  code which assumes the existence of ``forall a. C a =>``.
 
 ``ghc-prim`` library
 ~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr
index 874f4f0890..6b382e61d9 100644
--- a/testsuite/tests/th/T10891.stderr
+++ b/testsuite/tests/th/T10891.stderr
@@ -1,11 +1,9 @@
 class T10891.C (a_0 :: *)
-    where T10891.f :: forall (a_0 :: *) . T10891.C a_0 =>
-                                          a_0 -> GHC.Types.Int
+    where T10891.f :: a_0 -> GHC.Types.Int
 class T10891.C' (a_0 :: *)
     where type T10891.F (a_0 :: *) :: *
           type T10891.F a_0 = a_0
-          T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 =>
-                                           a_0 -> GHC.Types.Int
+          T10891.f' :: a_0 -> GHC.Types.Int
 instance T10891.C' GHC.Types.Int
 class T10891.C'' (a_0 :: *)
     where data T10891.Fd (a_0 :: *) :: *
diff --git a/testsuite/tests/th/T14888.stderr b/testsuite/tests/th/T14888.stderr
index 963937f9f6..e6d63254e7 100644
--- a/testsuite/tests/th/T14888.stderr
+++ b/testsuite/tests/th/T14888.stderr
@@ -5,7 +5,6 @@ T14888.hs:18:23-59: Splicing expression
     reify ''Functor' >>= stringE . pprint
   ======>
     "class T14888.Functor' (f_0 :: * -> *)
-    where T14888.fmap' :: forall (f_0 :: * ->
-                                         *) . T14888.Functor' f_0 =>
-                          forall (a_1 :: *) (b_2 :: *) . (a_1 -> b_2) -> f_0 a_1 -> f_0 b_2
+    where T14888.fmap' :: forall (a_1 :: *) (b_2 :: *) .
+                          (a_1 -> b_2) -> f_0 a_1 -> f_0 b_2
 instance T14888.Functor' ((->) r_3 :: * -> *)"
diff --git a/testsuite/tests/th/T9064.stderr b/testsuite/tests/th/T9064.stderr
index f118e202ad..c7f3df187c 100644
--- a/testsuite/tests/th/T9064.stderr
+++ b/testsuite/tests/th/T9064.stderr
@@ -1,5 +1,4 @@
 class T9064.C (a_0 :: *)
-    where T9064.foo :: forall (a_0 :: *) . T9064.C a_0 =>
-                       a_0 -> GHC.Base.String
+    where T9064.foo :: a_0 -> GHC.Base.String
           default T9064.foo :: GHC.Show.Show a_0 => a_0 -> GHC.Base.String
 instance T9064.C T9064.Bar
diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr
index e65558774a..b18089b3a0 100644
--- a/testsuite/tests/th/TH_reifyDecl1.stderr
+++ b/testsuite/tests/th/TH_reifyDecl1.stderr
@@ -9,15 +9,14 @@ data TH_reifyDecl1.Tree (a_0 :: *)
     | (TH_reifyDecl1.Tree a_0) TH_reifyDecl1.:+: (TH_reifyDecl1.Tree a_0)
 type TH_reifyDecl1.IntList = [GHC.Types.Int]
 newtype TH_reifyDecl1.Length = TH_reifyDecl1.Length GHC.Types.Int
-Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall (a_0 :: *) . TH_reifyDecl1.Tree a_0
+Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall (a_0 :: *) .
+                                                           TH_reifyDecl1.Tree a_0
 Class op from TH_reifyDecl1.C1: TH_reifyDecl1.m1 :: forall (a_0 :: *) . TH_reifyDecl1.C1 a_0 =>
-                                                                        a_0 -> GHC.Types.Int
+                                                    a_0 -> GHC.Types.Int
 class TH_reifyDecl1.C1 (a_0 :: *)
-    where TH_reifyDecl1.m1 :: forall (a_0 :: *) . TH_reifyDecl1.C1 a_0 =>
-                                                  a_0 -> GHC.Types.Int
+    where TH_reifyDecl1.m1 :: a_0 -> GHC.Types.Int
 class TH_reifyDecl1.C2 (a_0 :: *)
-    where TH_reifyDecl1.m2 :: forall (a_0 :: *) . TH_reifyDecl1.C2 a_0 =>
-                                                  a_0 -> GHC.Types.Int
+    where TH_reifyDecl1.m2 :: a_0 -> GHC.Types.Int
 instance TH_reifyDecl1.C2 GHC.Types.Int
 class TH_reifyDecl1.C3 (a_0 :: *)
     where type TH_reifyDecl1.AT1 (a_0 :: *) :: *