summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2020-05-09 15:49:07 -0400
committerBen Gamari <ben@smart-cactus.org>2020-05-09 15:50:28 -0400
commitc8cf710a02c386d5007a8a6179ec1826b7085a29 (patch)
tree515e0db0458fb7f185c6024a5153bb8e06621608
parent86c77b36628dcce7bc9b066fc24c8c521fecc3ee (diff)
downloadhaskell-wip/revert-MR3132.tar.gz
Revert "Specify kind variables for inferred kinds in base."wip/revert-MR3132
As noted in !3132, this has rather severe knock-on consequences in user-code. We'll need to revisit this before merging something along these lines. This reverts commit 9749fe1223d182b1f8e7e4f7378df661c509f396.
-rw-r--r--libraries/base/Control/Arrow.hs4
-rw-r--r--libraries/base/Control/Category.hs4
-rw-r--r--libraries/base/Data/Data.hs2
-rw-r--r--libraries/base/Data/Dynamic.hs6
-rw-r--r--libraries/base/Data/Fixed.hs15
-rw-r--r--libraries/base/Data/Functor/Compose.hs7
-rw-r--r--libraries/base/Data/Functor/Const.hs5
-rw-r--r--libraries/base/Data/Functor/Product.hs6
-rw-r--r--libraries/base/Data/Functor/Sum.hs6
-rw-r--r--libraries/base/Data/Type/Coercion.hs41
-rw-r--r--libraries/base/Data/Type/Equality.hs34
-rw-r--r--libraries/base/GHC/Generics.hs93
-rw-r--r--libraries/base/changelog.md8
-rw-r--r--libraries/ghc-prim/GHC/Types.hs6
-rw-r--r--testsuite/tests/dependent/should_fail/T11334b.stderr4
-rw-r--r--testsuite/tests/deriving/should_compile/T14578.stderr21
-rw-r--r--testsuite/tests/generics/T10604/T10604_deriving.stderr102
-rw-r--r--testsuite/tests/ghci/scripts/T12550.stdout10
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T15039b.stderr2
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T15039d.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T10285.stderr2
21 files changed, 140 insertions, 240 deletions
diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs
index 56fa82e161..eec25a3179 100644
--- a/libraries/base/Control/Arrow.hs
+++ b/libraries/base/Control/Arrow.hs
@@ -1,8 +1,8 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
-- The RULES for the methods of class Arrow may never fire
-- e.g. compose/arr; see #10528
diff --git a/libraries/base/Control/Category.hs b/libraries/base/Control/Category.hs
index 14584bdc0c..c033c7618e 100644
--- a/libraries/base/Control/Category.hs
+++ b/libraries/base/Control/Category.hs
@@ -1,7 +1,7 @@
+{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE Trustworthy #-}
{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
-- The RULES for the methods of class Category may never fire
-- e.g. identity/left, identity/right, association; see #10528
@@ -20,7 +20,7 @@
module Control.Category where
-import qualified GHC.Base (id, (.))
+import qualified GHC.Base (id,(.))
import Data.Type.Coercion
import Data.Type.Equality
import Data.Coerce (coerce)
diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs
index 0ce830742a..a8dfa61115 100644
--- a/libraries/base/Data/Data.hs
+++ b/libraries/base/Data/Data.hs
@@ -1,10 +1,10 @@
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
diff --git a/libraries/base/Data/Dynamic.hs b/libraries/base/Data/Dynamic.hs
index 8478f0e680..5a4f3f9a08 100644
--- a/libraries/base/Data/Dynamic.hs
+++ b/libraries/base/Data/Dynamic.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE ExplicitForAll #-}
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeApplications #-}
-----------------------------------------------------------------------------
diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs
index 17e5141b33..232175a1ab 100644
--- a/libraries/base/Data/Fixed.hs
+++ b/libraries/base/Data/Fixed.hs
@@ -1,9 +1,7 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
@@ -43,7 +41,6 @@ module Data.Fixed
import Data.Data
import GHC.TypeLits (KnownNat, natVal)
import GHC.Read
-import Data.Kind (Type, Constraint)
import Text.ParserCombinators.ReadPrec
import Text.Read.Lex
@@ -64,8 +61,7 @@ mod' n d = n - (fromInteger f) * d where
f = div' n d
-- | The type parameter should be an instance of 'HasResolution'.
-type Fixed :: forall k. k -> Type
-newtype Fixed a = MkFixed Integer
+newtype Fixed (a :: k) = MkFixed Integer
deriving ( Eq -- ^ @since 2.01
, Ord -- ^ @since 2.01
)
@@ -84,8 +80,7 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where
dataTypeOf _ = tyFixed
toConstr _ = conMkFixed
-type HasResolution :: forall k. k -> Constraint
-class HasResolution a where
+class HasResolution (a :: k) where
resolution :: p a -> Integer
-- | For example, @Fixed 1000@ will give you a 'Fixed' with a resolution of 1000.
diff --git a/libraries/base/Data/Functor/Compose.hs b/libraries/base/Data/Functor/Compose.hs
index 225d16283b..d8369ebc05 100644
--- a/libraries/base/Data/Functor/Compose.hs
+++ b/libraries/base/Data/Functor/Compose.hs
@@ -3,7 +3,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
@@ -27,7 +26,6 @@ module Data.Functor.Compose (
import Data.Functor.Classes
-import Data.Kind (Type)
import Control.Applicative
import Data.Coerce (coerce)
import Data.Data (Data)
@@ -40,9 +38,6 @@ infixr 9 `Compose`
-- | Right-to-left composition of functors.
-- The composition of applicative functors is always applicative,
-- but the composition of monads is not always a monad.
---
--- Kinds `k2` and `k1` explicitly quantified since 4.15.0.0.
-type Compose :: forall k2 k1. (k2 -> Type) -> (k1 -> k2) -> (k1 -> Type)
newtype Compose f g a = Compose { getCompose :: f (g a) }
deriving ( Data -- ^ @since 4.9.0.0
, Generic -- ^ @since 4.9.0.0
@@ -131,7 +126,7 @@ instance (Alternative f, Applicative g) => Alternative (Compose f g) where
-- | The deduction (via generativity) that if @g x :~: g y@ then @x :~: y@.
--
-- @since 4.14.0.0
-instance TestEquality f => TestEquality (Compose f g) where
+instance (TestEquality f) => TestEquality (Compose f g) where
testEquality (Compose x) (Compose y) =
case testEquality x y of -- :: Maybe (g x :~: g y)
Just Refl -> Just Refl -- :: Maybe (x :~: y)
diff --git a/libraries/base/Data/Functor/Const.hs b/libraries/base/Data/Functor/Const.hs
index dd1880e30b..651041f15b 100644
--- a/libraries/base/Data/Functor/Const.hs
+++ b/libraries/base/Data/Functor/Const.hs
@@ -2,9 +2,7 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
@@ -38,9 +36,6 @@ import GHC.Read (Read(readsPrec), readParen, lex)
import GHC.Show (Show(showsPrec), showParen, showString)
-- | The 'Const' functor.
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Const :: forall k. Type -> k -> Type
newtype Const a b = Const { getConst :: a }
deriving ( Bits -- ^ @since 4.9.0.0
, Bounded -- ^ @since 4.9.0.0
diff --git a/libraries/base/Data/Functor/Product.hs b/libraries/base/Data/Functor/Product.hs
index 266a72d75e..a3678e910e 100644
--- a/libraries/base/Data/Functor/Product.hs
+++ b/libraries/base/Data/Functor/Product.hs
@@ -1,9 +1,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Functor.Product
@@ -28,15 +26,11 @@ import Control.Monad (MonadPlus(..))
import Control.Monad.Fix (MonadFix(..))
import Control.Monad.Zip (MonadZip(mzipWith))
import Data.Data (Data)
-import Data.Kind (Type)
import Data.Functor.Classes
import GHC.Generics (Generic, Generic1)
import Text.Read (Read(..), readListDefault, readListPrecDefault)
-- | Lifted product of functors.
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Product :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type)
data Product f g a = Pair (f a) (g a)
deriving ( Data -- ^ @since 4.9.0.0
, Generic -- ^ @since 4.9.0.0
diff --git a/libraries/base/Data/Functor/Sum.hs b/libraries/base/Data/Functor/Sum.hs
index cca541fe5e..f7d6178a2b 100644
--- a/libraries/base/Data/Functor/Sum.hs
+++ b/libraries/base/Data/Functor/Sum.hs
@@ -1,9 +1,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Safe #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Functor.Sum
@@ -25,15 +23,11 @@ module Data.Functor.Sum (
import Control.Applicative ((<|>))
import Data.Data (Data)
-import Data.Kind (Type)
import Data.Functor.Classes
import GHC.Generics (Generic, Generic1)
import Text.Read (Read(..), readListDefault, readListPrecDefault)
-- | Lifted sum of functors.
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Sum :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type)
data Sum f g a = InL (f a) | InR (g a)
deriving ( Data -- ^ @since 4.9.0.0
, Generic -- ^ @since 4.9.0.0
diff --git a/libraries/base/Data/Type/Coercion.hs b/libraries/base/Data/Type/Coercion.hs
index a3c920d8e4..694bedec01 100644
--- a/libraries/base/Data/Type/Coercion.hs
+++ b/libraries/base/Data/Type/Coercion.hs
@@ -1,16 +1,14 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MagicHash #-}
-----------------------------------------------------------------------------
-- |
@@ -49,10 +47,9 @@ import GHC.Base
-- To use this equality in practice, pattern-match on the @Coercion a b@ to get out
-- the @Coercible a b@ instance, and then use 'coerce' to apply it.
--
--- @since 4.7.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type Coercion :: forall k. k -> k -> Type
+-- @since 4.7.0.0
data Coercion a b where
- Coercion :: Coercible @k a b => Coercion @k a b
+ Coercion :: Coercible a b => Coercion a b
-- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van
-- Steenbergen for 'type-equality', Edward Kmett for 'eq', and Gabor Greif
@@ -81,13 +78,13 @@ repr :: (a Eq.:~: b) -> Coercion a b
repr Eq.Refl = Coercion
-- | @since 4.7.0.0
-deriving instance Eq (Coercion a b)
+deriving instance Eq (Coercion a b)
-- | @since 4.7.0.0
deriving instance Show (Coercion a b)
-- | @since 4.7.0.0
-deriving instance Ord (Coercion a b)
+deriving instance Ord (Coercion a b)
-- | @since 4.7.0.0
deriving instance Coercible a b => Read (Coercion a b)
@@ -105,13 +102,9 @@ deriving instance Coercible a b => Bounded (Coercion a b)
-- | This class contains types where you can learn the equality of two types
-- from information contained in /terms/. Typically, only singleton types should
-- inhabit this class.
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type TestCoercion :: forall k. (k -> Type) -> Constraint
-class TestCoercion (f :: k -> Type) where
+class TestCoercion f where
-- | Conditionally prove the representational equality of @a@ and @b@.
- testCoercion :: forall (a :: k) (b :: k).
- f a -> f b -> Maybe (Coercion @k a b)
+ testCoercion :: f a -> f b -> Maybe (Coercion a b)
-- | @since 4.7.0.0
instance TestCoercion ((Eq.:~:) a) where
diff --git a/libraries/base/Data/Type/Equality.hs b/libraries/base/Data/Type/Equality.hs
index aa19ae3064..ab321ba011 100644
--- a/libraries/base/Data/Type/Equality.hs
+++ b/libraries/base/Data/Type/Equality.hs
@@ -1,20 +1,19 @@
-{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ExplicitNamespaces #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
@@ -62,8 +61,7 @@ infix 4 :~:, :~~:
-- in practice, pattern-match on the @a :~: b@ to get out the @Refl@ constructor;
-- in the body of the pattern-match, the compiler knows that @a ~ b@.
--
--- @since 4.7.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type (:~:) :: forall k. k -> k -> Type
+-- @since 4.7.0.0
data a :~: b where -- See Note [The equality types story] in GHC.Builtin.Types.Prim
Refl :: a :~: a
@@ -124,9 +122,8 @@ deriving instance a ~ b => Bounded (a :~: b)
-- | Kind heterogeneous propositional equality. Like ':~:', @a :~~: b@ is
-- inhabited by a terminating value if and only if @a@ is the same type as @b@.
--
--- @since 4.10.0.0. Kinds `k1` and `k2` explicitly quantified since
--- 4.15.0.0.
-type (:~~:) :: forall k1 k2. k1 -> k2 -> Type
+-- @since 4.10.0.0
+type (:~~:) :: k1 -> k2 -> Type
data a :~~: b where
HRefl :: a :~~: a
@@ -153,9 +150,6 @@ deriving instance a ~~ b => Bounded (a :~~: b)
-- | This class contains types where you can learn the equality of two types
-- from information contained in /terms/. Typically, only singleton types should
-- inhabit this class.
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type TestEquality :: forall k. (k -> Type) -> Constraint
class TestEquality f where
-- | Conditionally prove the equality of @a@ and @b@.
testEquality :: f a -> f b -> Maybe (a :~: b)
@@ -171,7 +165,7 @@ instance TestEquality ((:~~:) a) where
infix 4 ==
-- | A type family to compute Boolean equality.
-type (==) :: forall k. k -> k -> Bool
+type (==) :: k -> k -> Bool
type family a == b where
f a == g b = f == g && a == b
a == a = 'True
diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index 6c18844faf..56fca9b5a2 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -11,10 +11,8 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
@@ -756,8 +754,7 @@ import GHC.TypeLits ( KnownSymbol, KnownNat, symbolVal, natVal )
--------------------------------------------------------------------------------
-- | Void: used for datatypes without constructors
-type V1 :: forall k. k -> Type
-data V1 a
+data V1 (p :: k)
deriving ( Eq -- ^ @since 4.9.0.0
, Ord -- ^ @since 4.9.0.0
, Read -- ^ @since 4.9.0.0
@@ -772,8 +769,7 @@ instance Semigroup (V1 p) where
v <> _ = v
-- | Unit: used for constructors without arguments
-type U1 :: forall k. k -> Type
-data U1 a = U1
+data U1 (p :: k) = U1
deriving ( Generic -- ^ @since 4.7.0.0
, Generic1 -- ^ @since 4.9.0.0
)
@@ -824,8 +820,7 @@ instance Monoid (U1 p) where
mempty = U1
-- | Used for marking occurrences of the parameter
-type Par1 :: Type -> Type
-newtype Par1 a = Par1 { unPar1 :: a }
+newtype Par1 p = Par1 { unPar1 :: p }
deriving ( Eq -- ^ @since 4.7.0.0
, Ord -- ^ @since 4.7.0.0
, Read -- ^ @since 4.7.0.0
@@ -853,8 +848,7 @@ deriving instance Monoid p => Monoid (Par1 p)
-- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@
-- is enabled)
-type Rec1 :: forall k. (k -> Type) -> (k -> Type)
-newtype Rec1 f a = Rec1 { unRec1 :: f a }
+newtype Rec1 (f :: k -> Type) (p :: k) = Rec1 { unRec1 :: f p }
deriving ( Eq -- ^ @since 4.7.0.0
, Ord -- ^ @since 4.7.0.0
, Read -- ^ @since 4.7.0.0
@@ -884,8 +878,7 @@ deriving instance Semigroup (f p) => Semigroup (Rec1 f p)
deriving instance Monoid (f p) => Monoid (Rec1 f p)
-- | Constants, additional parameters and recursion of kind @*@
-type K1 :: forall k. Type -> Type -> k -> Type
-newtype K1 i a b = K1 { unK1 :: a }
+newtype K1 (i :: Type) c (p :: k) = K1 { unK1 :: c }
deriving ( Eq -- ^ @since 4.7.0.0
, Ord -- ^ @since 4.7.0.0
, Read -- ^ @since 4.7.0.0
@@ -926,9 +919,8 @@ deriving instance Semigroup (f p) => Semigroup (M1 i c f p)
deriving instance Monoid (f p) => Monoid (M1 i c f p)
-- | Meta-information (constructor names, etc.)
-type M1 :: forall k. Type -> Meta -> (k -> Type) -> (k -> Type)
-newtype M1 i meta f a =
- M1 { unM1 :: f a }
+newtype M1 (i :: Type) (c :: Meta) (f :: k -> Type) (p :: k) =
+ M1 { unM1 :: f p }
deriving ( Eq -- ^ @since 4.7.0.0
, Ord -- ^ @since 4.7.0.0
, Read -- ^ @since 4.7.0.0
@@ -940,8 +932,7 @@ newtype M1 i meta f a =
-- | Sums: encode choice between constructors
infixr 5 :+:
-type (:+:) :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type)
-data (f :+: g) a = L1 (f a) | R1 (g a)
+data (:+:) (f :: k -> Type) (g :: k -> Type) (p :: k) = L1 (f p) | R1 (g p)
deriving ( Eq -- ^ @since 4.7.0.0
, Ord -- ^ @since 4.7.0.0
, Read -- ^ @since 4.7.0.0
@@ -953,8 +944,7 @@ data (f :+: g) a = L1 (f a) | R1 (g a)
-- | Products: encode multiple arguments to constructors
infixr 6 :*:
-type (:*:) :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type)
-data (f :*: g) a = f a :*: g a
+data (:*:) (f :: k -> Type) (g :: k -> Type) (p :: k) = f p :*: g p
deriving ( Eq -- ^ @since 4.7.0.0
, Ord -- ^ @since 4.7.0.0
, Read -- ^ @since 4.7.0.0
@@ -995,9 +985,8 @@ instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where
-- | Composition of functors
infixr 7 :.:
-type (:.:) :: forall k2 k1. (k2 -> Type) -> (k1 -> k2) -> (k1 -> Type)
-newtype (f :.: g) a =
- Comp1 { unComp1 :: f (g a) }
+newtype (:.:) (f :: k2 -> Type) (g :: k1 -> k2) (p :: k1) =
+ Comp1 { unComp1 :: f (g p) }
deriving ( Eq -- ^ @since 4.7.0.0
, Ord -- ^ @since 4.7.0.0
, Read -- ^ @since 4.7.0.0
@@ -1028,7 +1017,6 @@ deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p)
-- | Constants of unlifted kinds
--
-- @since 4.9.0.0
-type URec :: forall k. Type -> k -> Type
data family URec (a :: Type) (p :: k)
-- | Used for marking occurrences of 'Addr#'
@@ -1102,46 +1090,37 @@ data instance URec Word (p :: k) = UWord { uWord# :: Word# }
-- | Type synonym for @'URec' 'Addr#'@
--
--- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type UAddr :: forall k. k -> Type
-type UAddr = URec (Ptr ())
+-- @since 4.9.0.0
+type UAddr = URec (Ptr ())
-- | Type synonym for @'URec' 'Char#'@
--
--- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type UChar :: forall k. k -> Type
-type UChar = URec Char
+-- @since 4.9.0.0
+type UChar = URec Char
-- | Type synonym for @'URec' 'Double#'@
--
--- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type UDouble :: forall k. k -> Type
+-- @since 4.9.0.0
type UDouble = URec Double
-- | Type synonym for @'URec' 'Float#'@
--
--- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type UFloat :: forall k. k -> Type
-type UFloat = URec Float
+-- @since 4.9.0.0
+type UFloat = URec Float
-- | Type synonym for @'URec' 'Int#'@
--
--- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type UInt :: forall k. k -> Type
-type UInt = URec Int
+-- @since 4.9.0.0
+type UInt = URec Int
-- | Type synonym for @'URec' 'Word#'@
--
--- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0.
-type UWord :: forall k. k -> Type
-type UWord = URec Word
+-- @since 4.9.0.0
+type UWord = URec Word
-- | Tag for K1: recursion (of kind @Type@)
data R
-- | Type synonym for encoding recursion (of kind @Type@)
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Rec0 :: forall k. Type -> k -> Type
type Rec0 = K1 R
-- | Tag for M1: datatype
@@ -1152,27 +1131,15 @@ data C
data S
-- | Type synonym for encoding meta-information for datatypes
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type D1 :: forall k. Meta -> (k -> Type) -> (k -> Type)
type D1 = M1 D
-- | Type synonym for encoding meta-information for constructors
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type C1 :: forall k. Meta -> (k -> Type) -> (k -> Type)
type C1 = M1 C
-- | Type synonym for encoding meta-information for record selectors
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type S1 :: forall k. Meta -> (k -> Type) -> (k -> Type)
type S1 = M1 S
-- | Class for datatypes that represent datatypes
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Datatype :: forall k. k -> Constraint
class Datatype d where
-- | The name of the datatype (unqualified)
datatypeName :: t d (f :: k -> Type) (a :: k) -> [Char]
@@ -1197,9 +1164,6 @@ instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt)
isNewtype _ = fromSing (sing :: Sing nt)
-- | Class for datatypes that represent data constructors
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Constructor :: forall k. k -> Constraint
class Constructor c where
-- | The name of the constructor
conName :: t c (f :: k -> Type) (a :: k) -> [Char]
@@ -1339,9 +1303,6 @@ data DecidedStrictness = DecidedLazy
)
-- | Class for datatypes that represent records
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Selector :: forall k. k -> Constraint
class Selector s where
-- | The name of the selector
selName :: t s (f :: k -> Type) (a :: k) -> [Char]
@@ -1394,7 +1355,6 @@ class Generic a where
-- 'from1' . 'to1' ≡ 'Prelude.id'
-- 'to1' . 'from1' ≡ 'Prelude.id'
-- @
-type Generic1 :: forall k. (k -> Type) -> Constraint
class Generic1 (f :: k -> Type) where
-- | Generic representation type
type Rep1 f :: k -> Type
@@ -1519,16 +1479,10 @@ deriving instance Generic1 Down
--------------------------------------------------------------------------------
-- | The singleton kind-indexed data family.
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type Sing :: forall k. k -> Type
data family Sing (a :: k)
-- | A 'SingI' constraint is essentially an implicitly-passed singleton.
---
--- Kind `k` explicitly quantified since 4.15.0.0.
-type SingI :: forall k. k -> Constraint
-class SingI a where
+class SingI (a :: k) where
-- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@
-- extension to use this method the way you want.
sing :: Sing a
@@ -1536,7 +1490,6 @@ class SingI a where
-- | The 'SingKind' class is essentially a /kind/ class. It classifies all kinds
-- for which singletons are defined. The class supports converting between a singleton
-- type and the base (unrefined) type which it is built from.
-type SingKind :: Type -> Constraint
class SingKind k where
-- | Get a base type from a proxy for the promoted kind. For example,
-- @DemoteRep Bool@ will be the type @Bool@.
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 0117815be8..c27b4fb1ca 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -2,14 +2,6 @@
## 4.15.0.0 *TBA*
- * `Const` (`Data.Functor.Const`), `Compose` (`Data.Functor.Compose`),
- `Product` (`Data.Functor.Product`), `Sum` (`Data.Functor.Sum`), `Coercion`
- and `TestCoercion` (`Data.Type.Coercion`), `(:~:)` and `TestEquality`
- (`Data.Type.Equality`); `UAddr`, `UChar`, `UDouble` `UFloat`, `UInt`,
- `UWord`, `Rec0`, `D1`, `C1`, `S1`, `Datatype`, `Constructor`, `Selector`
- (`GHC.Generics`) now use specified quantification, allowing the use of
- visible kind application.
-
* `openFile` now calls the `open` system call with an `interruptible` FFI
call, ensuring that the call can be interrupted with `SIGINT` on POSIX
systems.
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index bdf6c67225..0a32454149 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE MagicHash, NoImplicitPrelude, TypeFamilies, UnboxedTuples,
MultiParamTypeClasses, RoleAnnotations, CPP, TypeOperators,
- PolyKinds, StandaloneKindSignatures, RankNTypes #-}
+ PolyKinds #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Types
@@ -226,7 +226,6 @@ inside GHC, to change the kind and type.
-- about the difference between heterogeneous equality @~~@ and
-- homogeneous equality @~@, this is printed as @~@ unless
-- @-fprint-equality-relations@ is set.
-type (~~) :: forall k1 k2. k1 -> k2 -> Constraint
class a ~~ b
-- See also Note [The equality types story] in GHC.Builtin.Types.Prim
@@ -283,8 +282,7 @@ class a ~ b
-- by Joachim Breitner, Richard A. Eisenberg, Simon Peyton Jones and Stephanie Weirich.
--
-- @since 4.7.0.0
-type Coercible :: forall k. k -> k -> Constraint
-class Coercible a b
+class Coercible (a :: k) (b :: k)
-- See also Note [The equality types story] in GHC.Builtin.Types.Prim
{- *********************************************************************
diff --git a/testsuite/tests/dependent/should_fail/T11334b.stderr b/testsuite/tests/dependent/should_fail/T11334b.stderr
index 62249df4e5..effdf20828 100644
--- a/testsuite/tests/dependent/should_fail/T11334b.stderr
+++ b/testsuite/tests/dependent/should_fail/T11334b.stderr
@@ -1,7 +1,7 @@
T11334b.hs:8:14: error:
• Cannot default kind variable ‘f0’
- of kind: k20 -> *
+ of kind: k0 -> *
Perhaps enable PolyKinds or add a kind signature
• In an expression type signature: Proxy 'Compose
In the expression: Proxy :: Proxy 'Compose
@@ -9,7 +9,7 @@ T11334b.hs:8:14: error:
T11334b.hs:8:14: error:
• Cannot default kind variable ‘g0’
- of kind: k10 -> k20
+ of kind: k10 -> k0
Perhaps enable PolyKinds or add a kind signature
• In an expression type signature: Proxy 'Compose
In the expression: Proxy :: Proxy 'Compose
diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr
index 81fb28a4f4..58376989db 100644
--- a/testsuite/tests/deriving/should_compile/T14578.stderr
+++ b/testsuite/tests/deriving/should_compile/T14578.stderr
@@ -13,27 +13,26 @@ Derived class instances:
GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a
(GHC.Base.<>)
= GHC.Prim.coerce
- @(T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a
- -> T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a
- -> T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) 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) a)
@(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a)
- ((GHC.Base.<>)
- @(T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a))
+ ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a))
GHC.Base.sconcat
= GHC.Prim.coerce
- @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a)
- -> T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a)
+ @(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.Wat f g a) -> T14578.Wat f g a)
(GHC.Base.sconcat
- @(T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a))
+ @(T14578.App (Data.Functor.Compose.Compose f g) a))
GHC.Base.stimes
= GHC.Prim.coerce
@(b
- -> T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a
- -> T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a)
+ -> T14578.App (Data.Functor.Compose.Compose f g) a
+ -> T14578.App (Data.Functor.Compose.Compose f g) a)
@(b -> T14578.Wat f g a -> T14578.Wat f g a)
(GHC.Base.stimes
- @(T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a))
+ @(T14578.App (Data.Functor.Compose.Compose f g) a))
instance GHC.Base.Functor f =>
GHC.Base.Functor (T14578.App f) where
diff --git a/testsuite/tests/generics/T10604/T10604_deriving.stderr b/testsuite/tests/generics/T10604/T10604_deriving.stderr
index f4dfddd9ae..99c5ee8088 100644
--- a/testsuite/tests/generics/T10604/T10604_deriving.stderr
+++ b/testsuite/tests/generics/T10604/T10604_deriving.stderr
@@ -176,7 +176,7 @@ Derived class instances:
Derived type family instances:
type GHC.Generics.Rep (T10604_deriving.Starify a) = GHC.Generics.D1
- @(*)
+ @{*}
('GHC.Generics.MetaData
"Starify"
"T10604_deriving"
@@ -185,28 +185,28 @@ Derived type family instances:
((GHC.Generics.:+:)
@(*)
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Starify1"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
'GHC.Generics.NoSourceUnpackedness
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
- (GHC.Generics.Rec0 @(*) a)))
+ (GHC.Generics.Rec0 @{*} a)))
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Starify2"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -214,22 +214,22 @@ Derived type family instances:
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
- @(*) GHC.Types.Int))))
+ @{*} GHC.Types.Int))))
type GHC.Generics.Rep1
@(*) T10604_deriving.Starify = GHC.Generics.D1
- @(*)
+ @{*}
('GHC.Generics.MetaData
"Starify" "T10604_deriving" "main" 'GHC.Types.False)
((GHC.Generics.:+:)
@(*)
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Starify1"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing @GHC.Types.Symbol)
'GHC.Generics.NoSourceUnpackedness
@@ -237,22 +237,22 @@ Derived type family instances:
'GHC.Generics.DecidedLazy)
GHC.Generics.Par1))
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Starify2"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing @GHC.Types.Symbol)
'GHC.Generics.NoSourceUnpackedness
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
- (GHC.Generics.Rec0 @(*) GHC.Types.Int))))
+ (GHC.Generics.Rec0 @{*} GHC.Types.Int))))
type GHC.Generics.Rep
(T10604_deriving.SumOfProducts @{k} a) = GHC.Generics.D1
- @(*)
+ @{*}
('GHC.Generics.MetaData
"SumOfProducts"
"T10604_deriving"
@@ -261,7 +261,7 @@ Derived type family instances:
((GHC.Generics.:+:)
@(*)
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Prod1"
'GHC.Generics.PrefixI
@@ -269,7 +269,7 @@ Derived type family instances:
((GHC.Generics.:*:)
@(*)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -277,10 +277,10 @@ Derived type family instances:
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
- @(*)
+ @{*}
(T10604_deriving.Proxy @k a)))
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -288,10 +288,10 @@ Derived type family instances:
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
- @(*)
+ @{*}
(T10604_deriving.Proxy @k a)))))
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Prod2"
'GHC.Generics.PrefixI
@@ -299,7 +299,7 @@ Derived type family instances:
((GHC.Generics.:*:)
@(*)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -307,10 +307,10 @@ Derived type family instances:
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
- @(*)
+ @{*}
(T10604_deriving.Proxy @k a)))
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -318,11 +318,11 @@ Derived type family instances:
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
- @(*)
+ @{*}
(T10604_deriving.Proxy @k a))))))
type GHC.Generics.Rep1
@k (T10604_deriving.SumOfProducts @{k}) = GHC.Generics.D1
- @k
+ @{k}
('GHC.Generics.MetaData
"SumOfProducts"
"T10604_deriving"
@@ -331,7 +331,7 @@ Derived type family instances:
((GHC.Generics.:+:)
@k
(GHC.Generics.C1
- @k
+ @{k}
('GHC.Generics.MetaCons
"Prod1"
'GHC.Generics.PrefixI
@@ -339,7 +339,7 @@ Derived type family instances:
((GHC.Generics.:*:)
@k
(GHC.Generics.S1
- @k
+ @{k}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -349,7 +349,7 @@ Derived type family instances:
(GHC.Generics.Rec1
@k (T10604_deriving.Proxy @k)))
(GHC.Generics.S1
- @k
+ @{k}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -360,7 +360,7 @@ Derived type family instances:
@k
(T10604_deriving.Proxy @k)))))
(GHC.Generics.C1
- @k
+ @{k}
('GHC.Generics.MetaCons
"Prod2"
'GHC.Generics.PrefixI
@@ -368,7 +368,7 @@ Derived type family instances:
((GHC.Generics.:*:)
@k
(GHC.Generics.S1
- @k
+ @{k}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -378,7 +378,7 @@ Derived type family instances:
(GHC.Generics.Rec1
@k (T10604_deriving.Proxy @k)))
(GHC.Generics.S1
- @k
+ @{k}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing
@GHC.Types.Symbol)
@@ -390,40 +390,40 @@ Derived type family instances:
(T10604_deriving.Proxy @k))))))
type GHC.Generics.Rep
(T10604_deriving.Wrap2 @k a) = GHC.Generics.D1
- @(*)
+ @{*}
('GHC.Generics.MetaData
"Wrap2" "T10604_deriving" "main" 'GHC.Types.False)
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Wrap2" 'GHC.Generics.PrefixI 'GHC.Types.False)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing @GHC.Types.Symbol)
'GHC.Generics.NoSourceUnpackedness
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
- @(*)
+ @{*}
(T10604_deriving.Proxy
@(*) (T10604_deriving.Proxy @(k -> *) a)))))
type GHC.Generics.Rep1
@(k -> *) (T10604_deriving.Wrap2 @k) = GHC.Generics.D1
- @(k -> *)
+ @{k -> *}
('GHC.Generics.MetaData
"Wrap2"
"T10604_deriving"
"main"
'GHC.Types.False)
(GHC.Generics.C1
- @(k -> *)
+ @{k -> *}
('GHC.Generics.MetaCons
"Wrap2"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- @(k -> *)
+ @{k -> *}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing @GHC.Types.Symbol)
'GHC.Generics.NoSourceUnpackedness
@@ -437,39 +437,39 @@ Derived type family instances:
@(k -> *)
(T10604_deriving.Proxy @(k -> *))))))
type GHC.Generics.Rep (T10604_deriving.Wrap a) = GHC.Generics.D1
- @(*)
+ @{*}
('GHC.Generics.MetaData
"Wrap"
"T10604_deriving"
"main"
'GHC.Types.False)
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Wrap"
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- @(*)
+ @{*}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing @GHC.Types.Symbol)
'GHC.Generics.NoSourceUnpackedness
'GHC.Generics.NoSourceStrictness
'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
- @(*)
+ @{*}
(T10604_deriving.Proxy @(* -> *) a))))
type GHC.Generics.Rep1
@(* -> *) T10604_deriving.Wrap = GHC.Generics.D1
- @(* -> *)
+ @{* -> *}
('GHC.Generics.MetaData
"Wrap" "T10604_deriving" "main" 'GHC.Types.False)
(GHC.Generics.C1
- @(* -> *)
+ @{* -> *}
('GHC.Generics.MetaCons
"Wrap" 'GHC.Generics.PrefixI 'GHC.Types.False)
(GHC.Generics.S1
- @(* -> *)
+ @{* -> *}
('GHC.Generics.MetaSel
('GHC.Maybe.Nothing @GHC.Types.Symbol)
'GHC.Generics.NoSourceUnpackedness
@@ -479,26 +479,26 @@ Derived type family instances:
@(* -> *) (T10604_deriving.Proxy @(* -> *)))))
type GHC.Generics.Rep
(T10604_deriving.Proxy @k a) = GHC.Generics.D1
- @(*)
+ @{*}
('GHC.Generics.MetaData
"Proxy" "T10604_deriving" "main" 'GHC.Types.False)
(GHC.Generics.C1
- @(*)
+ @{*}
('GHC.Generics.MetaCons
"Proxy" 'GHC.Generics.PrefixI 'GHC.Types.False)
(GHC.Generics.U1 @(*)))
type GHC.Generics.Rep1
@k (T10604_deriving.Proxy @k) = GHC.Generics.D1
- @k
+ @{k}
('GHC.Generics.MetaData
"Proxy" "T10604_deriving" "main" 'GHC.Types.False)
(GHC.Generics.C1
- @k
+ @{k}
('GHC.Generics.MetaCons
"Proxy" 'GHC.Generics.PrefixI 'GHC.Types.False)
(GHC.Generics.U1 @k))
type GHC.Generics.Rep (T10604_deriving.Empty a) = GHC.Generics.D1
- @(*)
+ @{*}
('GHC.Generics.MetaData
"Empty"
"T10604_deriving"
@@ -507,7 +507,7 @@ Derived type family instances:
(GHC.Generics.V1 @(*))
type GHC.Generics.Rep1
@GHC.Types.Bool T10604_deriving.Empty = GHC.Generics.D1
- @GHC.Types.Bool
+ @{GHC.Types.Bool}
('GHC.Generics.MetaData
"Empty"
"T10604_deriving"
diff --git a/testsuite/tests/ghci/scripts/T12550.stdout b/testsuite/tests/ghci/scripts/T12550.stdout
index 9de82c86f9..a3117d02c2 100644
--- a/testsuite/tests/ghci/scripts/T12550.stdout
+++ b/testsuite/tests/ghci/scripts/T12550.stdout
@@ -33,11 +33,9 @@ instance Functor U1 -- Defined in ‘GHC.Generics’
instance ∀ (f ∷ ★ → ★). Functor f ⇒ Functor (Rec1 f)
-- Defined in ‘GHC.Generics’
instance Functor Par1 -- Defined in ‘GHC.Generics’
-instance ∀ i (meta ∷ Meta) (f ∷ ★ → ★).
- Functor f ⇒
- Functor (M1 i meta f)
+instance ∀ i (c ∷ Meta) (f ∷ ★ → ★). Functor f ⇒ Functor (M1 i c f)
-- Defined in ‘GHC.Generics’
-instance ∀ i a. Functor (K1 i a) -- Defined in ‘GHC.Generics’
+instance ∀ i c. Functor (K1 i c) -- Defined in ‘GHC.Generics’
instance ∀ (f ∷ ★ → ★) (g ∷ ★ → ★).
(Functor f, Functor g) ⇒
Functor (f :.: g)
@@ -62,13 +60,13 @@ datatypeName
∷ ∀ {d} {t ∷ ★ → (★ → ★) → ★ → ★} {f ∷ ★ → ★} {a}.
Datatype d ⇒
t d f a → [Char]
-type Datatype :: ∀ k. k → Constraint
+type Datatype :: ∀ {k}. k → Constraint
class Datatype d where
datatypeName ∷ ∀ k1 (t ∷ k → (k1 → ★) → k1 → ★) (f ∷ k1 → ★)
(a ∷ k1).
t d f a → [Char]
...
-- Defined in ‘GHC.Generics’
-(:*:) ∷ ∀ {f ∷ ★ → ★} {a} {g ∷ ★ → ★}. f a → g a → (:*:) f g a
+(:*:) ∷ ∀ {f ∷ ★ → ★} {p} {g ∷ ★ → ★}. f p → g p → (:*:) f g p
Rep ∷ ★ → ★ → ★
M1 ∷ ∀ k. ★ → Meta → (k → ★) → k → ★
diff --git a/testsuite/tests/partial-sigs/should_compile/T15039b.stderr b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr
index 1f6abf0db4..da14f26a17 100644
--- a/testsuite/tests/partial-sigs/should_compile/T15039b.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr
@@ -51,7 +51,7 @@ T15039b.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
T15039b.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Coercible @(*) a b’
Where: ‘a’, ‘b’ are rigid type variables bound by
- the inferred type of ex7 :: Coercible @(*) a b => Coercion @(*) a b
+ the inferred type of ex7 :: Coercible @(*) a b => Coercion @{*} a b
at T15039b.hs:35:1-44
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
diff --git a/testsuite/tests/partial-sigs/should_compile/T15039d.stderr b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr
index 0308e52375..68882c391f 100644
--- a/testsuite/tests/partial-sigs/should_compile/T15039d.stderr
+++ b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr
@@ -52,7 +52,7 @@ T15039d.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
T15039d.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Coercible @(*) a b’
Where: ‘a’, ‘b’ are rigid type variables bound by
- the inferred type of ex7 :: Coercible @(*) a b => Coercion @(*) a b
+ the inferred type of ex7 :: Coercible @(*) a b => Coercion @{*} a b
at T15039d.hs:35:1-44
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
diff --git a/testsuite/tests/typecheck/should_fail/T10285.stderr b/testsuite/tests/typecheck/should_fail/T10285.stderr
index 99edf39591..02215e2f70 100644
--- a/testsuite/tests/typecheck/should_fail/T10285.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10285.stderr
@@ -3,7 +3,7 @@ T10285.hs:8:17: error:
• Could not deduce: Coercible a b arising from a use of ‘coerce’
from the context: Coercible (N a) (N b)
bound by a pattern with constructor:
- Coercion :: forall k (a :: k) (b :: k).
+ Coercion :: forall {k} (a :: k) (b :: k).
Coercible a b =>
Coercion a b,
in an equation for ‘oops’