Commit b08a6d75 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari
Browse files

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
parent cac8be61
...@@ -420,7 +420,15 @@ tc_mkRepFamInsts gk tycon inst_tys = ...@@ -420,7 +420,15 @@ tc_mkRepFamInsts gk tycon inst_tys =
-- type arguments before generating the Rep/Rep1 instance, since some -- type arguments before generating the Rep/Rep1 instance, since some
-- of the tyvars might have been instantiated when deriving. -- of the tyvars might have been instantiated when deriving.
-- See Note [Generating a correctly typed Rep instance]. -- 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) in_scope = mkInScopeSet (tyCoVarsOfTypes inst_tys)
subst = mkTvSubst in_scope env subst = mkTvSubst in_scope env
repTy' = substTy subst repTy repTy' = substTy subst repTy
...@@ -923,6 +931,32 @@ the tyConTyVars of the TyCon to their counterparts in the fully instantiated ...@@ -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 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. 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] Note [Handling kinds in a Rep instance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Because Generic1 is poly-kinded, the representation types were generalized to Because Generic1 is poly-kinded, the representation types were generalized to
......
TOP=../.. TOP=../..
include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.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
module T15012 where
import GHC.Generics
import T15012a
blah :: IO ()
blah = print $ from1 $ TyFamily 1 2
{-# 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
...@@ -43,3 +43,5 @@ test('T10361a', normal, compile, ['']) ...@@ -43,3 +43,5 @@ test('T10361a', normal, compile, [''])
test('T10361b', normal, compile, ['']) test('T10361b', normal, compile, [''])
test('T11358', normal, compile_and_run, ['']) test('T11358', normal, compile_and_run, [''])
test('T12220', normal, compile, ['']) test('T12220', normal, compile, [''])
test('T15012', [extra_files(['T15012.hs', 'T15012a.hs'])], run_command,
['$MAKE -s --no-print-directory T15012'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment