diff options
21 files changed, 240 insertions, 140 deletions
diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs index eec25a3179..56fa82e161 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 c033c7618e..14584bdc0c 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 a8dfa61115..0ce830742a 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 5a4f3f9a08..8478f0e680 100644 --- a/libraries/base/Data/Dynamic.hs +++ b/libraries/base/Data/Dynamic.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs index 232175a1ab..17e5141b33 100644 --- a/libraries/base/Data/Fixed.hs +++ b/libraries/base/Data/Fixed.hs @@ -1,7 +1,9 @@ -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE PolyKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | @@ -41,6 +43,7 @@ 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 @@ -61,7 +64,8 @@ mod' n d = n - (fromInteger f) * d where f = div' n d -- | The type parameter should be an instance of 'HasResolution'. -newtype Fixed (a :: k) = MkFixed Integer +type Fixed :: forall k. k -> Type +newtype Fixed a = MkFixed Integer deriving ( Eq -- ^ @since 2.01 , Ord -- ^ @since 2.01 ) @@ -80,7 +84,8 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where dataTypeOf _ = tyFixed toConstr _ = conMkFixed -class HasResolution (a :: k) where +type HasResolution :: forall k. k -> Constraint +class HasResolution a 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 d8369ebc05..225d16283b 100644 --- a/libraries/base/Data/Functor/Compose.hs +++ b/libraries/base/Data/Functor/Compose.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- @@ -26,6 +27,7 @@ module Data.Functor.Compose ( import Data.Functor.Classes +import Data.Kind (Type) import Control.Applicative import Data.Coerce (coerce) import Data.Data (Data) @@ -38,6 +40,9 @@ 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 @@ -126,7 +131,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 651041f15b..dd1880e30b 100644 --- a/libraries/base/Data/Functor/Const.hs +++ b/libraries/base/Data/Functor/Const.hs @@ -2,7 +2,9 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- @@ -36,6 +38,9 @@ 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 a3678e910e..266a72d75e 100644 --- a/libraries/base/Data/Functor/Product.hs +++ b/libraries/base/Data/Functor/Product.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneKindSignatures #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Product @@ -26,11 +28,15 @@ 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 f7d6178a2b..cca541fe5e 100644 --- a/libraries/base/Data/Functor/Sum.hs +++ b/libraries/base/Data/Functor/Sum.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} +{-# LANGUAGE StandaloneKindSignatures #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Sum @@ -23,11 +25,15 @@ 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 694bedec01..a3c920d8e4 100644 --- a/libraries/base/Data/Type/Coercion.hs +++ b/libraries/base/Data/Type/Coercion.hs @@ -1,14 +1,16 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE MagicHash #-} +{-# 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 #-} ----------------------------------------------------------------------------- -- | @@ -47,9 +49,10 @@ 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 +-- @since 4.7.0.0. Kind `k` explicitly quantified since 4.15.0.0. +type Coercion :: forall k. k -> k -> Type data Coercion a b where - Coercion :: Coercible a b => Coercion a b + Coercion :: Coercible @k a b => Coercion @k a b -- with credit to Conal Elliott for 'ty', Erik Hesselink & Martijn van -- Steenbergen for 'type-equality', Edward Kmett for 'eq', and Gabor Greif @@ -78,13 +81,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) @@ -102,9 +105,13 @@ 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. -class TestCoercion f where +-- +-- Kind `k` explicitly quantified since 4.15.0.0. +type TestCoercion :: forall k. (k -> Type) -> Constraint +class TestCoercion (f :: k -> Type) where -- | Conditionally prove the representational equality of @a@ and @b@. - testCoercion :: f a -> f b -> Maybe (Coercion a b) + testCoercion :: forall (a :: k) (b :: k). + f a -> f b -> Maybe (Coercion @k 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 ab321ba011..aa19ae3064 100644 --- a/libraries/base/Data/Type/Equality.hs +++ b/libraries/base/Data/Type/Equality.hs @@ -1,19 +1,20 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | @@ -61,7 +62,8 @@ 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 +-- @since 4.7.0.0. Kind `k` explicitly quantified since 4.15.0.0. +type (:~:) :: forall k. k -> k -> Type data a :~: b where -- See Note [The equality types story] in GHC.Builtin.Types.Prim Refl :: a :~: a @@ -122,8 +124,9 @@ 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 -type (:~~:) :: k1 -> k2 -> Type +-- @since 4.10.0.0. Kinds `k1` and `k2` explicitly quantified since +-- 4.15.0.0. +type (:~~:) :: forall k1 k2. k1 -> k2 -> Type data a :~~: b where HRefl :: a :~~: a @@ -150,6 +153,9 @@ 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) @@ -165,7 +171,7 @@ instance TestEquality ((:~~:) a) where infix 4 == -- | A type family to compute Boolean equality. -type (==) :: k -> k -> Bool +type (==) :: forall k. 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 56fca9b5a2..6c18844faf 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -11,8 +11,10 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -754,7 +756,8 @@ import GHC.TypeLits ( KnownSymbol, KnownNat, symbolVal, natVal ) -------------------------------------------------------------------------------- -- | Void: used for datatypes without constructors -data V1 (p :: k) +type V1 :: forall k. k -> Type +data V1 a deriving ( Eq -- ^ @since 4.9.0.0 , Ord -- ^ @since 4.9.0.0 , Read -- ^ @since 4.9.0.0 @@ -769,7 +772,8 @@ instance Semigroup (V1 p) where v <> _ = v -- | Unit: used for constructors without arguments -data U1 (p :: k) = U1 +type U1 :: forall k. k -> Type +data U1 a = U1 deriving ( Generic -- ^ @since 4.7.0.0 , Generic1 -- ^ @since 4.9.0.0 ) @@ -820,7 +824,8 @@ instance Monoid (U1 p) where mempty = U1 -- | Used for marking occurrences of the parameter -newtype Par1 p = Par1 { unPar1 :: p } +type Par1 :: Type -> Type +newtype Par1 a = Par1 { unPar1 :: a } deriving ( Eq -- ^ @since 4.7.0.0 , Ord -- ^ @since 4.7.0.0 , Read -- ^ @since 4.7.0.0 @@ -848,7 +853,8 @@ deriving instance Monoid p => Monoid (Par1 p) -- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@ -- is enabled) -newtype Rec1 (f :: k -> Type) (p :: k) = Rec1 { unRec1 :: f p } +type Rec1 :: forall k. (k -> Type) -> (k -> Type) +newtype Rec1 f a = Rec1 { unRec1 :: f a } deriving ( Eq -- ^ @since 4.7.0.0 , Ord -- ^ @since 4.7.0.0 , Read -- ^ @since 4.7.0.0 @@ -878,7 +884,8 @@ 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 @*@ -newtype K1 (i :: Type) c (p :: k) = K1 { unK1 :: c } +type K1 :: forall k. Type -> Type -> k -> Type +newtype K1 i a b = K1 { unK1 :: a } deriving ( Eq -- ^ @since 4.7.0.0 , Ord -- ^ @since 4.7.0.0 , Read -- ^ @since 4.7.0.0 @@ -919,8 +926,9 @@ 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.) -newtype M1 (i :: Type) (c :: Meta) (f :: k -> Type) (p :: k) = - M1 { unM1 :: f p } +type M1 :: forall k. Type -> Meta -> (k -> Type) -> (k -> Type) +newtype M1 i meta f a = + M1 { unM1 :: f a } deriving ( Eq -- ^ @since 4.7.0.0 , Ord -- ^ @since 4.7.0.0 , Read -- ^ @since 4.7.0.0 @@ -932,7 +940,8 @@ newtype M1 (i :: Type) (c :: Meta) (f :: k -> Type) (p :: k) = -- | Sums: encode choice between constructors infixr 5 :+: -data (:+:) (f :: k -> Type) (g :: k -> Type) (p :: k) = L1 (f p) | R1 (g p) +type (:+:) :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) +data (f :+: g) a = L1 (f a) | R1 (g a) deriving ( Eq -- ^ @since 4.7.0.0 , Ord -- ^ @since 4.7.0.0 , Read -- ^ @since 4.7.0.0 @@ -944,7 +953,8 @@ data (:+:) (f :: k -> Type) (g :: k -> Type) (p :: k) = L1 (f p) | R1 (g p) -- | Products: encode multiple arguments to constructors infixr 6 :*: -data (:*:) (f :: k -> Type) (g :: k -> Type) (p :: k) = f p :*: g p +type (:*:) :: forall k. (k -> Type) -> (k -> Type) -> (k -> Type) +data (f :*: g) a = f a :*: g a deriving ( Eq -- ^ @since 4.7.0.0 , Ord -- ^ @since 4.7.0.0 , Read -- ^ @since 4.7.0.0 @@ -985,8 +995,9 @@ instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where -- | Composition of functors infixr 7 :.: -newtype (:.:) (f :: k2 -> Type) (g :: k1 -> k2) (p :: k1) = - Comp1 { unComp1 :: f (g p) } +type (:.:) :: forall k2 k1. (k2 -> Type) -> (k1 -> k2) -> (k1 -> Type) +newtype (f :.: g) a = + Comp1 { unComp1 :: f (g a) } deriving ( Eq -- ^ @since 4.7.0.0 , Ord -- ^ @since 4.7.0.0 , Read -- ^ @since 4.7.0.0 @@ -1017,6 +1028,7 @@ 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#' @@ -1090,37 +1102,46 @@ data instance URec Word (p :: k) = UWord { uWord# :: Word# } -- | Type synonym for @'URec' 'Addr#'@ -- --- @since 4.9.0.0 -type UAddr = URec (Ptr ()) +-- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0. +type UAddr :: forall k. k -> Type +type UAddr = URec (Ptr ()) -- | Type synonym for @'URec' 'Char#'@ -- --- @since 4.9.0.0 -type UChar = 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 -- | Type synonym for @'URec' 'Double#'@ -- --- @since 4.9.0.0 +-- @since 4.9.0.0. Kind `k` explicitly quantified since 4.15.0.0. +type UDouble :: forall k. k -> Type type UDouble = URec Double -- | Type synonym for @'URec' 'Float#'@ -- --- @since 4.9.0.0 -type UFloat = 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 -- | Type synonym for @'URec' 'Int#'@ -- --- @since 4.9.0.0 -type UInt = 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 -- | Type synonym for @'URec' 'Word#'@ -- --- @since 4.9.0.0 -type UWord = 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 -- | 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 @@ -1131,15 +1152,27 @@ 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] @@ -1164,6 +1197,9 @@ 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] @@ -1303,6 +1339,9 @@ 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] @@ -1355,6 +1394,7 @@ 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 @@ -1479,10 +1519,16 @@ 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. -class SingI (a :: k) where +-- +-- Kind `k` explicitly quantified since 4.15.0.0. +type SingI :: forall k. k -> Constraint +class SingI a where -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@ -- extension to use this method the way you want. sing :: Sing a @@ -1490,6 +1536,7 @@ class SingI (a :: k) 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 c27b4fb1ca..0117815be8 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -2,6 +2,14 @@ ## 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 0a32454149..bdf6c67225 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 #-} + PolyKinds, StandaloneKindSignatures, RankNTypes #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Types @@ -226,6 +226,7 @@ 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 @@ -282,7 +283,8 @@ class a ~ b -- by Joachim Breitner, Richard A. Eisenberg, Simon Peyton Jones and Stephanie Weirich. -- -- @since 4.7.0.0 -class Coercible (a :: k) (b :: k) +type Coercible :: forall k. k -> k -> Constraint +class Coercible a b -- 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 effdf20828..62249df4e5 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: k0 -> * + of kind: k20 -> * 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 -> k0 + of kind: k10 -> k20 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 58376989db..81fb28a4f4 100644 --- a/testsuite/tests/deriving/should_compile/T14578.stderr +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -13,26 +13,27 @@ 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 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 @(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.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) - ((GHC.Base.<>) @(T14578.App (Data.Functor.Compose.Compose f g) a)) + ((GHC.Base.<>) + @(T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a)) 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 @(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.Wat f g a) -> T14578.Wat f g a) (GHC.Base.sconcat - @(T14578.App (Data.Functor.Compose.Compose f g) a)) + @(T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) f g) a)) GHC.Base.stimes = GHC.Prim.coerce @(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 @(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) @(b -> T14578.Wat f g a -> T14578.Wat f g a) (GHC.Base.stimes - @(T14578.App (Data.Functor.Compose.Compose f g) a)) + @(T14578.App (Data.Functor.Compose.Compose @(TYPE 'GHC.Types.LiftedRep) @(TYPE 'GHC.Types.LiftedRep) 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 99c5ee8088..f4dfddd9ae 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 a3117d02c2..9de82c86f9 100644 --- a/testsuite/tests/ghci/scripts/T12550.stdout +++ b/testsuite/tests/ghci/scripts/T12550.stdout @@ -33,9 +33,11 @@ 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 (c ∷ Meta) (f ∷ ★ → ★). Functor f ⇒ Functor (M1 i c f) +instance ∀ i (meta ∷ Meta) (f ∷ ★ → ★). + Functor f ⇒ + Functor (M1 i meta f) -- Defined in ‘GHC.Generics’ -instance ∀ i c. Functor (K1 i c) -- Defined in ‘GHC.Generics’ +instance ∀ i a. Functor (K1 i a) -- Defined in ‘GHC.Generics’ instance ∀ (f ∷ ★ → ★) (g ∷ ★ → ★). (Functor f, Functor g) ⇒ Functor (f :.: g) @@ -60,13 +62,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 ∷ ★ → ★} {p} {g ∷ ★ → ★}. f p → g p → (:*:) f g p +(:*:) ∷ ∀ {f ∷ ★ → ★} {a} {g ∷ ★ → ★}. f a → g a → (:*:) f g a 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 da14f26a17..1f6abf0db4 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 68882c391f..0308e52375 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 02215e2f70..99edf39591 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’ |