Get the roles right for newtype instances
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 2 Aug 2017 16:59:56 +0000 (12:59 -0400)
committerRyan Scott <ryan.gl.scott@gmail.com>
Wed, 2 Aug 2017 17:00:56 +0000 (13:00 -0400)
This was a simple slip, that gave rise to the bug reported in
comment:13 of Trac #14045.  We were supplying roles to mkAlgTyCon
that didn't match the tyvars.

compiler/typecheck/TcInstDcls.hs
compiler/types/Type.hs
testsuite/tests/deriving/should_compile/T14045b.hs [new file with mode: 0644]
testsuite/tests/deriving/should_compile/all.T

index fe513f4..58d4506 100644 (file)
@@ -695,7 +695,7 @@ tcDataFamInstDecl mb_clsinfo
                       -- the end of Note [Data type families] in TyCon
                     rep_tc   = mkAlgTyCon rep_tc_name
                                           ty_binders liftedTypeKind
-                                          (map (const Nominal) full_tvs)
+                                          (map (const Nominal) ty_binders)
                                           (fmap unLoc cType) stupid_theta
                                           tc_rhs parent
                                           gadt_syntax
index b81192f..dcc134c 100644 (file)
@@ -1315,8 +1315,12 @@ mkLamType v ty
 
 mkLamTypes vs ty = foldr mkLamType ty vs
 
--- | Given a list of type-level vars and a result type, makes TyBinders, preferring
--- anonymous binders if the variable is, in fact, not dependent.
+-- | Given a list of type-level vars and a result kind,
+-- makes TyBinders, preferring anonymous binders
+-- if the variable is, in fact, not dependent.
+-- e.g.    mkTyConBindersPreferAnon [(k:*),(b:k),(c:k)] (k->k)
+-- We want (k:*) Named, (a;k) Anon, (c:k) Anon
+--
 -- All binders are /visible/.
 mkTyConBindersPreferAnon :: [TyVar] -> Type -> [TyConBinder]
 mkTyConBindersPreferAnon vars inner_ty = fst (go vars)
diff --git a/testsuite/tests/deriving/should_compile/T14045b.hs b/testsuite/tests/deriving/should_compile/T14045b.hs
new file mode 100644 (file)
index 0000000..cb18e36
--- /dev/null
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeFamilies, KindSignatures, GADTs, GeneralizedNewtypeDeriving #-}
+
+module T14045b where
+
+import Data.Kind ( Type )
+
+data family T a b :: Type
+
+-- newtype instance T Int d = MkT (IO d)
+
+newtype instance T Int :: Type -> Type where
+   MkT :: IO d -> T Int d
+  deriving( Monad, Applicative, Functor )
index 0025d25..5b69565 100644 (file)
@@ -94,3 +94,4 @@ test('drv-phantom', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddump-
 test('T13813', normal, compile, [''])
 test('T13919', normal, compile, [''])
 test('T13998', normal, compile, [''])
+test('T14045b', normal, compile, [''])