Implicitly bind kind variables in type family instance RHSes when it's sensible

Summary:
Before, there was a discrepancy in how GHC renamed type synonyms as
opposed to type family instances. That is, GHC would accept definitions like
this one:

```lang=haskell
type T = (Nothing :: Maybe a)
```

However, it would not accept a very similar type family instance:

```lang=haskell
type family   T :: Maybe a
type instance T = (Nothing :: Maybe a)
```

The primary goal of this patch is to bring the renaming of type family
instances up to par with that of type synonyms, causing the latter definition
to be accepted, and fixing #14131.

In particular, we now allow kind variables on the right-hand sides of type
(and data) family instances to be //implicitly// bound by LHS type (or kind)
patterns (as opposed to type variables, which must always be explicitly
bound by LHS type patterns only). As a consequence, this allows programs
reported in #7938 and #9574 to typecheck, whereas before they would
have been rejected.

Implementation-wise, there isn't much trickery involved in making this happen.
We simply need to bind additional kind variables from the RHS of a type family
in the right place (in particular, see `RnSource.rnFamInstEqn`, which has
undergone a minor facelift).

While doing this has the upside of fixing #14131, it also made it easier to
trigger #13985, so I decided to fix that while I was in town. This was
accomplished by a careful blast of `reportFloatingKvs` in `tcFamTyPats`.

Test Plan: ./validate

Reviewers: simonpj, goldfire, austin, bgamari

Reviewed By: simonpj

Subscribers: rwbarton, thomie

GHC Trac Issues: #13985, #14131

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

1 files changed, 211 insertions, 52 deletions

diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index 6ea6e8f2e0..60862cc110 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -6,32 +6,32 @@
   [((,)
     (NonRecursive)
     {Bag(Located (HsBind Name)):
-     [({ DumpRenamedAst.hs:11:1-23 }
+     [({ DumpRenamedAst.hs:18:1-23 }
        (FunBind
-        ({ DumpRenamedAst.hs:11:1-4 }
+        ({ DumpRenamedAst.hs:18:1-4 }
          {Name: DumpRenamedAst.main})
         (MG
-         ({ DumpRenamedAst.hs:11:1-23 }
-          [({ DumpRenamedAst.hs:11:1-23 }
+         ({ DumpRenamedAst.hs:18:1-23 }
+          [({ DumpRenamedAst.hs:18:1-23 }
             (Match
              (FunRhs
-              ({ DumpRenamedAst.hs:11:1-4 }
+              ({ DumpRenamedAst.hs:18:1-4 }
                {Name: DumpRenamedAst.main})
               (Prefix)
               (NoSrcStrict))
              []
              (Nothing)
              (GRHSs
-              [({ DumpRenamedAst.hs:11:6-23 }
+              [({ DumpRenamedAst.hs:18:6-23 }
                 (GRHS
                  []
-                 ({ DumpRenamedAst.hs:11:8-23 }
+                 ({ DumpRenamedAst.hs:18:8-23 }
                   (HsApp
-                   ({ DumpRenamedAst.hs:11:8-15 }
+                   ({ DumpRenamedAst.hs:18:8-15 }
                     (HsVar
-                     ({ DumpRenamedAst.hs:11:8-15 }
+                     ({ DumpRenamedAst.hs:18:8-15 }
                       {Name: putStrLn})))
-                   ({ DumpRenamedAst.hs:11:17-23 }
+                   ({ DumpRenamedAst.hs:18:17-23 }
                     (HsLit
                      (HsString
                       (SourceText
@@ -49,9 +49,9 @@
   [])
  []
  [(TyClGroup
-   [({ DumpRenamedAst.hs:5:1-30 }
+   [({ DumpRenamedAst.hs:6:1-30 }
      (DataDecl
-      ({ DumpRenamedAst.hs:5:6-10 }
+      ({ DumpRenamedAst.hs:6:6-10 }
        {Name: DumpRenamedAst.Peano})
       (HsQTvs
        []
@@ -65,9 +65,9 @@
         [])
        (Nothing)
        (Nothing)
-       [({ DumpRenamedAst.hs:5:14-17 }
+       [({ DumpRenamedAst.hs:6:14-17 }
          (ConDeclH98
-          ({ DumpRenamedAst.hs:5:14-17 }
+          ({ DumpRenamedAst.hs:6:14-17 }
            {Name: DumpRenamedAst.Zero})
           (Nothing)
           (Just
@@ -76,19 +76,19 @@
           (PrefixCon
            [])
           (Nothing)))
-       ,({ DumpRenamedAst.hs:5:21-30 }
+       ,({ DumpRenamedAst.hs:6:21-30 }
          (ConDeclH98
-          ({ DumpRenamedAst.hs:5:21-24 }
+          ({ DumpRenamedAst.hs:6:21-24 }
            {Name: DumpRenamedAst.Succ})
           (Nothing)
           (Just
            ({ <no location info> }
             []))
           (PrefixCon
-           [({ DumpRenamedAst.hs:5:26-30 }
+           [({ DumpRenamedAst.hs:6:26-30 }
              (HsTyVar
               (NotPromoted)
-              ({ DumpRenamedAst.hs:5:26-30 }
+              ({ DumpRenamedAst.hs:6:26-30 }
                {Name: DumpRenamedAst.Peano})))])
           (Nothing)))]
        ({ <no location info> }
@@ -99,103 +99,262 @@
    []
    [])
  ,(TyClGroup
-   [({ DumpRenamedAst.hs:7:1-39 }
+   [({ DumpRenamedAst.hs:8:1-39 }
      (FamDecl
       (FamilyDecl
        (ClosedTypeFamily
         (Just
-         [({ DumpRenamedAst.hs:8:3-36 }
+         [({ DumpRenamedAst.hs:9:3-36 }
            (HsIB
             [{Name: a}
             ,{Name: as}]
             (FamEqn
-             ({ DumpRenamedAst.hs:8:3-8 }
+             ({ DumpRenamedAst.hs:9:3-8 }
               {Name: DumpRenamedAst.Length})
-             [({ DumpRenamedAst.hs:8:10-17 }
+             [({ DumpRenamedAst.hs:9:10-17 }
                (HsParTy
-                ({ DumpRenamedAst.hs:8:11-16 }
+                ({ DumpRenamedAst.hs:9:11-16 }
                  (HsOpTy
-                  ({ DumpRenamedAst.hs:8:11 }
+                  ({ DumpRenamedAst.hs:9:11 }
                    (HsTyVar
                     (NotPromoted)
-                    ({ DumpRenamedAst.hs:8:11 }
+                    ({ DumpRenamedAst.hs:9:11 }
                      {Name: a})))
-                  ({ DumpRenamedAst.hs:8:13 }
+                  ({ DumpRenamedAst.hs:9:13 }
                    {Name: :})
-                  ({ DumpRenamedAst.hs:8:15-16 }
+                  ({ DumpRenamedAst.hs:9:15-16 }
                    (HsTyVar
                     (NotPromoted)
-                    ({ DumpRenamedAst.hs:8:15-16 }
+                    ({ DumpRenamedAst.hs:9:15-16 }
                      {Name: as})))))))]
              (Prefix)
-             ({ DumpRenamedAst.hs:8:21-36 }
+             ({ DumpRenamedAst.hs:9:21-36 }
               (HsAppTy
-               ({ DumpRenamedAst.hs:8:21-24 }
+               ({ DumpRenamedAst.hs:9:21-24 }
                 (HsTyVar
                  (NotPromoted)
-                 ({ DumpRenamedAst.hs:8:21-24 }
+                 ({ DumpRenamedAst.hs:9:21-24 }
                   {Name: DumpRenamedAst.Succ})))
-               ({ DumpRenamedAst.hs:8:26-36 }
+               ({ DumpRenamedAst.hs:9:26-36 }
                 (HsParTy
-                 ({ DumpRenamedAst.hs:8:27-35 }
+                 ({ DumpRenamedAst.hs:9:27-35 }
                   (HsAppTy
-                   ({ DumpRenamedAst.hs:8:27-32 }
+                   ({ DumpRenamedAst.hs:9:27-32 }
                     (HsTyVar
                      (NotPromoted)
-                     ({ DumpRenamedAst.hs:8:27-32 }
+                     ({ DumpRenamedAst.hs:9:27-32 }
                       {Name: DumpRenamedAst.Length})))
-                   ({ DumpRenamedAst.hs:8:34-35 }
+                   ({ DumpRenamedAst.hs:9:34-35 }
                     (HsTyVar
                      (NotPromoted)
-                     ({ DumpRenamedAst.hs:8:34-35 }
+                     ({ DumpRenamedAst.hs:9:34-35 }
                       {Name: as}))))))))))
             (True)))
-         ,({ DumpRenamedAst.hs:9:3-24 }
+         ,({ DumpRenamedAst.hs:10:3-24 }
            (HsIB
             []
             (FamEqn
-             ({ DumpRenamedAst.hs:9:3-8 }
+             ({ DumpRenamedAst.hs:10:3-8 }
               {Name: DumpRenamedAst.Length})
-             [({ DumpRenamedAst.hs:9:10-12 }
+             [({ DumpRenamedAst.hs:10:10-12 }
                (HsExplicitListTy
                 (Promoted)
                 (PlaceHolder)
                 []))]
              (Prefix)
-             ({ DumpRenamedAst.hs:9:21-24 }
+             ({ DumpRenamedAst.hs:10:21-24 }
               (HsTyVar
                (NotPromoted)
-               ({ DumpRenamedAst.hs:9:21-24 }
+               ({ DumpRenamedAst.hs:10:21-24 }
                 {Name: DumpRenamedAst.Zero}))))
             (True)))]))
-       ({ DumpRenamedAst.hs:7:13-18 }
+       ({ DumpRenamedAst.hs:8:13-18 }
         {Name: DumpRenamedAst.Length})
        (HsQTvs
         [{Name: k}]
-        [({ DumpRenamedAst.hs:7:20-30 }
+        [({ DumpRenamedAst.hs:8:20-30 }
           (KindedTyVar
-           ({ DumpRenamedAst.hs:7:21-22 }
+           ({ DumpRenamedAst.hs:8:21-22 }
             {Name: as})
-           ({ DumpRenamedAst.hs:7:27-29 }
+           ({ DumpRenamedAst.hs:8:27-29 }
             (HsListTy
-             ({ DumpRenamedAst.hs:7:28 }
+             ({ DumpRenamedAst.hs:8:28 }
               (HsTyVar
                (NotPromoted)
-               ({ DumpRenamedAst.hs:7:28 }
+               ({ DumpRenamedAst.hs:8:28 }
                 {Name: k})))))))]
         {NameSet:
          []})
        (Prefix)
-       ({ DumpRenamedAst.hs:7:32-39 }
+       ({ DumpRenamedAst.hs:8:32-39 }
         (KindSig
-         ({ DumpRenamedAst.hs:7:35-39 }
+         ({ DumpRenamedAst.hs:8:35-39 }
           (HsTyVar
            (NotPromoted)
-           ({ DumpRenamedAst.hs:7:35-39 }
+           ({ DumpRenamedAst.hs:8:35-39 }
             {Name: DumpRenamedAst.Peano})))))
        (Nothing))))]
    []
-   [])]
+   [])
+ ,(TyClGroup
+   [({ DumpRenamedAst.hs:12:1-30 }
+     (FamDecl
+      (FamilyDecl
+       (DataFamily)
+       ({ DumpRenamedAst.hs:12:13-15 }
+        {Name: DumpRenamedAst.Nat})
+       (HsQTvs
+        [{Name: k}]
+        []
+        {NameSet:
+         []})
+       (Prefix)
+       ({ DumpRenamedAst.hs:12:17-30 }
+        (KindSig
+         ({ DumpRenamedAst.hs:12:20-30 }
+          (HsFunTy
+           ({ DumpRenamedAst.hs:12:20 }
+            (HsTyVar
+             (NotPromoted)
+             ({ DumpRenamedAst.hs:12:20 }
+              {Name: k})))
+           ({ DumpRenamedAst.hs:12:25-30 }
+            (HsFunTy
+             ({ DumpRenamedAst.hs:12:25 }
+              (HsTyVar
+               (NotPromoted)
+               ({ DumpRenamedAst.hs:12:25 }
+                {Name: k})))
+             ({ DumpRenamedAst.hs:12:30 }
+              (HsTyVar
+               (NotPromoted)
+               ({ DumpRenamedAst.hs:12:30 }
+                {Name: *})))))))))
+       (Nothing))))]
+   []
+   [({ DumpRenamedAst.hs:(15,1)-(16,45) }
+     (DataFamInstD
+      (DataFamInstDecl
+       (HsIB
+        [{Name: k}
+        ,{Name: a}]
+        (FamEqn
+         ({ DumpRenamedAst.hs:15:18-20 }
+          {Name: DumpRenamedAst.Nat})
+         [({ DumpRenamedAst.hs:15:22-34 }
+           (HsKindSig
+            ({ DumpRenamedAst.hs:15:23 }
+             (HsTyVar
+              (NotPromoted)
+              ({ DumpRenamedAst.hs:15:23 }
+               {Name: a})))
+            ({ DumpRenamedAst.hs:15:28-33 }
+             (HsFunTy
+              ({ DumpRenamedAst.hs:15:28 }
+               (HsTyVar
+                (NotPromoted)
+                ({ DumpRenamedAst.hs:15:28 }
+                 {Name: k})))
+              ({ DumpRenamedAst.hs:15:33 }
+               (HsTyVar
+                (NotPromoted)
+                ({ DumpRenamedAst.hs:15:33 }
+                 {Name: *})))))))]
+         (Prefix)
+         (HsDataDefn
+          (NewType)
+          ({ <no location info> }
+           [])
+          (Nothing)
+          (Just
+           ({ DumpRenamedAst.hs:15:39-51 }
+            (HsFunTy
+             ({ DumpRenamedAst.hs:15:39-46 }
+              (HsParTy
+               ({ DumpRenamedAst.hs:15:40-45 }
+                (HsFunTy
+                 ({ DumpRenamedAst.hs:15:40 }
+                  (HsTyVar
+                   (NotPromoted)
+                   ({ DumpRenamedAst.hs:15:40 }
+                    {Name: k})))
+                 ({ DumpRenamedAst.hs:15:45 }
+                  (HsTyVar
+                   (NotPromoted)
+                   ({ DumpRenamedAst.hs:15:45 }
+                    {Name: *})))))))
+             ({ DumpRenamedAst.hs:15:51 }
+              (HsTyVar
+               (NotPromoted)
+               ({ DumpRenamedAst.hs:15:51 }
+                {Name: *}))))))
+          [({ DumpRenamedAst.hs:16:3-45 }
+            (ConDeclGADT
+             [({ DumpRenamedAst.hs:16:3-5 }
+               {Name: DumpRenamedAst.Nat})]
+             (HsIB
+              [{Name: f}
+              ,{Name: g}]
+              ({ DumpRenamedAst.hs:16:10-45 }
+               (HsFunTy
+                ({ DumpRenamedAst.hs:16:10-34 }
+                 (HsParTy
+                  ({ DumpRenamedAst.hs:16:11-33 }
+                   (HsForAllTy
+                    [({ DumpRenamedAst.hs:16:18-19 }
+                      (UserTyVar
+                       ({ DumpRenamedAst.hs:16:18-19 }
+                        {Name: xx})))]
+                    ({ DumpRenamedAst.hs:16:22-33 }
+                     (HsFunTy
+                      ({ DumpRenamedAst.hs:16:22-25 }
+                       (HsAppTy
+                        ({ DumpRenamedAst.hs:16:22 }
+                         (HsTyVar
+                          (NotPromoted)
+                          ({ DumpRenamedAst.hs:16:22 }
+                           {Name: f})))
+                        ({ DumpRenamedAst.hs:16:24-25 }
+                         (HsTyVar
+                          (NotPromoted)
+                          ({ DumpRenamedAst.hs:16:24-25 }
+                           {Name: xx})))))
+                      ({ DumpRenamedAst.hs:16:30-33 }
+                       (HsAppTy
+                        ({ DumpRenamedAst.hs:16:30 }
+                         (HsTyVar
+                          (NotPromoted)
+                          ({ DumpRenamedAst.hs:16:30 }
+                           {Name: g})))
+                        ({ DumpRenamedAst.hs:16:32-33 }
+                         (HsTyVar
+                          (NotPromoted)
+                          ({ DumpRenamedAst.hs:16:32-33 }
+                           {Name: xx})))))))))))
+                ({ DumpRenamedAst.hs:16:39-45 }
+                 (HsAppTy
+                  ({ DumpRenamedAst.hs:16:39-43 }
+                   (HsAppTy
+                    ({ DumpRenamedAst.hs:16:39-41 }
+                     (HsTyVar
+                      (NotPromoted)
+                      ({ DumpRenamedAst.hs:16:39-41 }
+                       {Name: DumpRenamedAst.Nat})))
+                    ({ DumpRenamedAst.hs:16:43 }
+                     (HsTyVar
+                      (NotPromoted)
+                      ({ DumpRenamedAst.hs:16:43 }
+                       {Name: f})))))
+                  ({ DumpRenamedAst.hs:16:45 }
+                   (HsTyVar
+                    (NotPromoted)
+                    ({ DumpRenamedAst.hs:16:45 }
+                     {Name: g})))))))
+              (True))
+             (Nothing)))]
+          ({ <no location info> }
+           [])))
+        (True)))))])]
  []
  []
  []