diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-08-02 12:59:56 -0400 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-08-02 13:00:56 -0400 |
| commit | d74983ef0c4a5b47a53d2821f8be9ebbf86e9257 (patch) | |
| tree | bd3f68548f19f7b06311e9435b9e181e1d17f8f8 | |
| parent | 8ef852098286749af1165e1215204a5de63babaf (diff) | |
| download | haskell-d74983ef0c4a5b47a53d2821f8be9ebbf86e9257.tar.gz | |
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.
| -rw-r--r-- | compiler/typecheck/TcInstDcls.hs | 2 | ||||
| -rw-r--r-- | compiler/types/Type.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/deriving/should_compile/T14045b.hs | 13 | ||||
| -rw-r--r-- | 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 fe513f4f59..58d45061f7 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 b81192fae9..dcc134cbe3 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 0000000000..cb18e36029 --- /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 0025d25dee..5b69565c52 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, ['']) |