[commit: ghc] master: Get the roles right for newtype instances (d74983e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d74983ef0c4a5b47a53d2821f8be9ebbf86e9257/ghc

>---------------------------------------------------------------

commit d74983ef0c4a5b47a53d2821f8be9ebbf86e9257
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Aug 2 12:59:56 2017 -0400

    Get the roles right for newtype instances
    
    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.


>---------------------------------------------------------------

d74983ef0c4a5b47a53d2821f8be9ebbf86e9257
 compiler/typecheck/TcInstDcls.hs                   |  2 +-
 compiler/types/Type.hs                             |  8 ++++++--
 testsuite/tests/deriving/should_compile/T14045b.hs | 13 +++++++++++++
 testsuite/tests/deriving/should_compile/all.T      |  1 +
 4 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index fe513f4..58d4506 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -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
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index b81192f..dcc134c 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -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
index 0000000..cb18e36
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T14045b.hs
@@ -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 )
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 0025d25..5b69565 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -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, [''])