Fix #15012 with a well-placed use of Any

Previously, derived `Generic1` instances could have associated `Rep1`
type family instances with unbound variables, such as in the following
example:

```lang=haskell
data T a = MkT (FakeOut a) deriving Generic1
type FakeOut a = Int

==>

instance Generic1 T where
  type Rep1 T = ... (Rec0 (FakeOut a))
```

Yikes! To avoid this, we simply map the last type variable in a
derived `Generic1` instance to `Any`.

Test Plan: make test TEST=T15012

Reviewers: bgamari

Reviewed By: bgamari

Subscribers: simonpj, thomie, carter

GHC Trac Issues: #15012

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

5 files changed, 60 insertions, 1 deletions

diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs
index 61a432e9dc..9da94280ce 100644
--- a/compiler/typecheck/TcGenGenerics.hs
+++ b/compiler/typecheck/TcGenGenerics.hs
@@ -420,7 +420,15 @@ tc_mkRepFamInsts gk tycon inst_tys =
        -- type arguments before generating the Rep/Rep1 instance, since some
        -- of the tyvars might have been instantiated when deriving.
        -- See Note [Generating a correctly typed Rep instance].
-     ; let env        = zipTyEnv tyvars inst_args
+     ; let (env_tyvars, env_inst_args)
+             = case gk_ of
+                 Gen0_ -> (tyvars, inst_args)
+                 Gen1_ last_tv
+                          -- See the "wrinkle" in
+                          -- Note [Generating a correctly typed Rep instance]
+                       -> ( last_tv : tyvars
+                          , anyTypeOfKind (tyVarKind last_tv) : inst_args )
+           env        = zipTyEnv env_tyvars env_inst_args
            in_scope   = mkInScopeSet (tyCoVarsOfTypes inst_tys)
            subst      = mkTvSubst in_scope env
            repTy'     = substTy  subst repTy
@@ -923,6 +931,32 @@ the tyConTyVars of the TyCon to their counterparts in the fully instantiated
 type. (For example, using T above as example, you'd map a :-> Int.) We then
 apply the substitution to the RHS before generating the instance.
 
+A wrinkle in all of this: when forming the type variable substitution for
+Generic1 instances, we map the last type variable of the tycon to Any. Why?
+It's because of wily data types like this one (#15012):
+
+   data T a = MkT (FakeOut a)
+   type FakeOut a = Int
+
+If we ignore a, then we'll produce the following Rep1 instance:
+
+   instance Generic1 T where
+     type Rep1 T = ... (Rec0 (FakeOut a))
+     ...
+
+Oh no! Now we have `a` on the RHS, but it's completely unbound. Instead, we
+ensure that `a` is mapped to Any:
+
+   instance Generic1 T where
+     type Rep1 T = ... (Rec0 (FakeOut Any))
+     ...
+
+And now all is good.
+
+Alternatively, we could have avoided this problem by expanding all type
+synonyms on the RHSes of Rep1 instances. But we might blow up the size of
+these types even further by doing this, so we choose not to do so.
+
 Note [Handling kinds in a Rep instance]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Because Generic1 is poly-kinded, the representation types were generalized to
diff --git a/testsuite/tests/generics/Makefile b/testsuite/tests/generics/Makefile
index 9a36a1c5fe..69a5802b96 100644
--- a/testsuite/tests/generics/Makefile
+++ b/testsuite/tests/generics/Makefile
@@ -1,3 +1,8 @@
 TOP=../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
+
+T15012:
+	$(RM) T15012.hi T15012.o T15012a.hi T15012a.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T15012a.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T15012.hs
diff --git a/testsuite/tests/generics/T15012.hs b/testsuite/tests/generics/T15012.hs
new file mode 100644
index 0000000000..388eddc0ed
--- /dev/null
+++ b/testsuite/tests/generics/T15012.hs
@@ -0,0 +1,7 @@
+module T15012 where
+
+import GHC.Generics
+import T15012a
+
+blah :: IO ()
+blah = print $ from1 $ TyFamily 1 2
diff --git a/testsuite/tests/generics/T15012a.hs b/testsuite/tests/generics/T15012a.hs
new file mode 100644
index 0000000000..5109ea08f0
--- /dev/null
+++ b/testsuite/tests/generics/T15012a.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeFamilies #-}
+module T15012a where
+
+import GHC.Generics
+
+type FakeOut a = Int
+
+data family   TyFamily y z
+data instance TyFamily a b = TyFamily Int (FakeOut b)
+  deriving Generic1
diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T
index 1d4aeaee38..f127f7895f 100644
--- a/testsuite/tests/generics/all.T
+++ b/testsuite/tests/generics/all.T
@@ -43,3 +43,5 @@ test('T10361a', normal, compile, [''])
 test('T10361b', normal, compile, [''])
 test('T11358', normal, compile_and_run, [''])
 test('T12220', normal, compile, [''])
+test('T15012', [extra_files(['T15012.hs', 'T15012a.hs'])], run_command,
+               ['$MAKE -s --no-print-directory T15012'])