diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-01-03 20:11:31 -0500 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-01-03 20:11:31 -0500 |
commit | 649e777211fe08432900093002547d7358f92d82 (patch) | |
tree | a8951ccb028655b79d467fbebb83242d7c8e0ab1 /testsuite/tests/deriving | |
parent | 7a25659efc4d22086a9e75dc90e3701c1706c625 (diff) | |
download | haskell-649e777211fe08432900093002547d7358f92d82.tar.gz |
Make typeToLHsType produce kind signatures for tycon applications
Summary:
`GeneralizedNewtypeDeriving` generates calls to `coerce`
which take visible type arguments. These types must be produced by
way of `typeToLHsType`, which converts a `Type` to an `LHsType`.
However, `typeToLHsType` was leaving off important kind information
when a `Type` contained a poly-kinded tycon application, leading to
incorrectly generated code in #14579.
This fixes the issue by tweaking `typeToLHsType` to generate
explicit kind signatures for tycon applications. This makes the
generated code noisier, but at least the program from #14579 now
works correctly.
Test Plan: make test TEST=T14579
Reviewers: simonpj, bgamari
Reviewed By: simonpj
Subscribers: rwbarton, thomie, carter
GHC Trac Issues: #14579
Differential Revision: https://phabricator.haskell.org/D4264
Diffstat (limited to 'testsuite/tests/deriving')
-rw-r--r-- | testsuite/tests/deriving/should_compile/T14578.stderr | 21 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/T14579.hs | 12 | ||||
-rw-r--r-- | testsuite/tests/deriving/should_compile/all.T | 1 |
3 files changed, 27 insertions, 7 deletions
diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr index e4230ad8cd..63375aeae0 100644 --- a/testsuite/tests/deriving/should_compile/T14578.stderr +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -73,15 +73,20 @@ Derived class instances: GHC.Base.Semigroup (T14578.Wat f g a) where (GHC.Base.<>) = GHC.Prim.coerce - @(T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + @(T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.<>) GHC.Base.sconcat = GHC.Prim.coerce - @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g) a) - -> T14578.App (Data.Functor.Compose.Compose f g) a) + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) GHC.Base.sconcat GHC.Base.stimes @@ -89,8 +94,10 @@ Derived class instances: @(forall (b :: TYPE GHC.Types.LiftedRep). GHC.Real.Integral b => b - -> T14578.App (Data.Functor.Compose.Compose f g) a - -> T14578.App (Data.Functor.Compose.Compose f g) a) + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) @(forall (b :: TYPE GHC.Types.LiftedRep). GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a) GHC.Base.stimes diff --git a/testsuite/tests/deriving/should_compile/T14579.hs b/testsuite/tests/deriving/should_compile/T14579.hs new file mode 100644 index 0000000000..19452446d6 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14579.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeInType #-} +module T14579 where + +import Data.Kind +import Data.Proxy + +newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a) + deriving Eq + +newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a)) + deriving Eq diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index af9a577a89..8752bbdb73 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -99,3 +99,4 @@ test('T14094', normal, compile, ['']) test('T14339', normal, compile, ['']) test('T14331', normal, compile, ['']) test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) +test('T14579', normal, compile, ['']) |