diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/Data/Data.hs | 2 | ||||
| -rw-r--r-- | libraries/base/Data/Typeable/Internal.hs | 28 | ||||
| -rw-r--r-- | libraries/base/GHC/Err.hs | 8 | ||||
| -rwxr-xr-x | libraries/base/GHC/Exts.hs | 4 | ||||
| -rw-r--r-- | libraries/base/tests/T11334.hs | 4 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Types.hs | 73 |
6 files changed, 80 insertions, 39 deletions
diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs index 88191c1011..cc94bac30f 100644 --- a/libraries/base/Data/Data.hs +++ b/libraries/base/Data/Data.hs @@ -114,7 +114,7 @@ import Data.Monoid import Data.Ord import Data.Typeable import Data.Version( Version(..) ) -import GHC.Base hiding (Any) +import GHC.Base hiding (Any, IntRep, FloatRep) import GHC.List import GHC.Num import GHC.Read diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs index efec62f7d8..87e5c88c76 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -10,6 +10,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- -- | @@ -249,18 +250,6 @@ tyConOf = typeRepTyCon . typeRep tcFun :: TyCon tcFun = tyConOf (Proxy :: Proxy (Int -> Int)) -tcList :: TyCon -tcList = tyConOf (Proxy :: Proxy []) - -tcTYPE :: TyCon -tcTYPE = tyConOf (Proxy :: Proxy TYPE) - -tc'Lifted :: TyCon -tc'Lifted = tyConOf (Proxy :: Proxy 'Lifted) - -tc'Unlifted :: TyCon -tc'Unlifted = tyConOf (Proxy :: Proxy 'Unlifted) - -- | Adds a TypeRep argument to a TypeRep. mkAppTy :: TypeRep -> TypeRep -> TypeRep {-# INLINE mkAppTy #-} @@ -364,10 +353,19 @@ instance Show TypeRep where showsPrec p (TypeRep _ tycon kinds tys) = case tys of [] -> showsPrec p tycon - [x@(TypeRep _ argCon _ _)] + [x] | tycon == tcList -> showChar '[' . shows x . showChar ']' - | tycon == tcTYPE && argCon == tc'Lifted -> showChar '*' - | tycon == tcTYPE && argCon == tc'Unlifted -> showChar '#' + where + tcList = tyConOf @[] Proxy + [TypeRep _ ptrRepCon _ []] + | tycon == tcTYPE && ptrRepCon == tc'PtrRepLifted + -> showChar '*' + | tycon == tcTYPE && ptrRepCon == tc'PtrRepUnlifted + -> showChar '#' + where + tcTYPE = tyConOf @TYPE Proxy + tc'PtrRepLifted = tyConOf @'PtrRepLifted Proxy + tc'PtrRepUnlifted = tyConOf @'PtrRepUnlifted Proxy [a,r] | tycon == tcFun -> showParen (p > 8) $ showsPrec 9 a . showString " -> " . diff --git a/libraries/base/GHC/Err.hs b/libraries/base/GHC/Err.hs index 88b9c39898..4231fcefa5 100644 --- a/libraries/base/GHC/Err.hs +++ b/libraries/base/GHC/Err.hs @@ -24,7 +24,7 @@ module GHC.Err( absentErr, error, errorWithoutStackTrace, undefined ) where import GHC.CString () -import GHC.Types (Char, Levity) +import GHC.Types (Char, RuntimeRep) import GHC.Stack.Types import GHC.Prim import GHC.Integer () -- Make sure Integer is compiled first @@ -33,7 +33,7 @@ import GHC.Integer () -- Make sure Integer is compiled first import {-# SOURCE #-} GHC.Exception( errorCallWithCallStackException ) -- | 'error' stops execution and displays an error message. -error :: forall (v :: Levity). forall (a :: TYPE v). +error :: forall (r :: RuntimeRep). forall (a :: TYPE r). HasCallStack => [Char] -> a error s = raise# (errorCallWithCallStackException s ?callStack) -- Bleh, we should be using 'GHC.Stack.callStack' instead of @@ -44,7 +44,7 @@ error s = raise# (errorCallWithCallStackException s ?callStack) -- | A variant of 'error' that does not produce a stack trace. -- -- @since 4.9.0.0 -errorWithoutStackTrace :: forall (v :: Levity). forall (a :: TYPE v). +errorWithoutStackTrace :: forall (r :: RuntimeRep). forall (a :: TYPE r). [Char] -> a errorWithoutStackTrace s = -- we don't have withFrozenCallStack yet, so we just inline the definition @@ -74,7 +74,7 @@ errorWithoutStackTrace s = -- It is expected that compilers will recognize this and insert error -- messages which are more appropriate to the context in which 'undefined' -- appears. -undefined :: forall (v :: Levity). forall (a :: TYPE v). +undefined :: forall (r :: RuntimeRep). forall (a :: TYPE r). HasCallStack => a undefined = error "Prelude.undefined" diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs index 31e70ebd21..21f7bfd8b9 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -56,8 +56,8 @@ module GHC.Exts -- * Equality type (~~), - -- * Levity polymorphism - GHC.Prim.TYPE, Levity(..), + -- * Representation polymorphism + GHC.Prim.TYPE, RuntimeRep(..), VecCount(..), VecElem(..), -- * Transform comprehensions Down(..), groupWith, sortWith, the, diff --git a/libraries/base/tests/T11334.hs b/libraries/base/tests/T11334.hs index 22864d9c1d..2b4ac56c70 100644 --- a/libraries/base/tests/T11334.hs +++ b/libraries/base/tests/T11334.hs @@ -7,5 +7,5 @@ import GHC.Types main :: IO () main = do print (typeOf (Proxy :: Proxy 'Just)) - print (typeOf (Proxy :: Proxy (TYPE 'Lifted))) - print (typeOf (Proxy :: Proxy (TYPE 'Unlifted))) + print (typeOf (Proxy :: Proxy (TYPE 'PtrRepLifted))) + print (typeOf (Proxy :: Proxy (TYPE 'PtrRepUnlifted))) diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs index 727811bdf4..6f9e09fdfb 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -30,10 +30,11 @@ module GHC.Types ( SPEC(..), Nat, Symbol, type (~~), Coercible, - TYPE, Levity(..), Type, type (*), type (★), Constraint, + TYPE, RuntimeRep(..), Type, type (*), type (★), Constraint, -- The historical type * should ideally be written as -- `type *`, without the parentheses. But that's a true -- pain to parse, and for little gain. + VecCount(..), VecElem(..), -- * Runtime type representation Module(..), TrName(..), TyCon(..) @@ -57,13 +58,13 @@ infixr 5 : data Constraint -- | The kind of types with values. For example @Int :: Type@. -type Type = TYPE 'Lifted +type Type = TYPE 'PtrRepLifted -- | A backward-compatible (pre-GHC 8.0) synonym for 'Type' -type * = TYPE 'Lifted +type * = TYPE 'PtrRepLifted -- | A unicode backward-compatible (pre-GHC 8.0) synonym for 'Type' -type ★ = TYPE 'Lifted +type ★ = TYPE 'PtrRepLifted {- ********************************************************************* * * @@ -330,17 +331,59 @@ you're reading this in 2023 then things went wrong). See #8326. -- loops should be aggressively specialized. data SPEC = SPEC | SPEC2 --- | GHC divides all proper types (that is, types that can perhaps be --- inhabited, as distinct from type constructors or type-level data) --- into two worlds: lifted types and unlifted types. For example, --- @Int@ is lifted while @Int#@ is unlifted. Certain operations need --- to be polymorphic in this distinction. A classic example is 'unsafeCoerce#', --- which needs to be able to coerce between lifted and unlifted types. --- To achieve this, we use kind polymorphism: lifted types have kind --- @TYPE Lifted@ and unlifted ones have kind @TYPE Unlifted@. 'Levity' --- is the kind of 'Lifted' and 'Unlifted'. @*@ is a synonym for @TYPE Lifted@ --- and @#@ is a synonym for @TYPE Unlifted@. -data Levity = Lifted | Unlifted + +{- ********************************************************************* +* * + RuntimeRep +* * +********************************************************************* -} + + +-- | GHC maintains a property that the kind of all inhabited types +-- (as distinct from type constructors or type-level data) tells us +-- the runtime representation of values of that type. This datatype +-- encodes the choice of runtime value. +-- Note that 'TYPE' is parameterised by 'RuntimeRep'; this is precisely +-- what we mean by the fact that a type's kind encodes the runtime +-- representation. +-- +-- For boxed values (that is, values that are represented by a pointer), +-- a further distinction is made, between lifted types (that contain ⊥), +-- and unlifted ones (that don't). +data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type + | PtrRepLifted -- ^ lifted; represented by a pointer + | PtrRepUnlifted -- ^ unlifted; represented by a pointer + | VoidRep -- ^ erased entirely + | IntRep -- ^ signed, word-sized value + | WordRep -- ^ unsigned, word-sized value + | Int64Rep -- ^ signed, 64-bit value (on 32-bit only) + | Word64Rep -- ^ unsigned, 64-bit value (on 32-bit only) + | AddrRep -- ^ A pointer, but /not/ to a Haskell value + | FloatRep -- ^ a 32-bit floating point number + | DoubleRep -- ^ a 64-bit floating point number + | UnboxedTupleRep -- ^ An unboxed tuple; this doesn't specify a concrete rep + +-- See also Note [Wiring in RuntimeRep] in TysWiredIn + +-- | Length of a SIMD vector type +data VecCount = Vec2 + | Vec4 + | Vec8 + | Vec16 + | Vec32 + | Vec64 + +-- | Element of a SIMD vector type +data VecElem = Int8ElemRep + | Int16ElemRep + | Int32ElemRep + | Int64ElemRep + | Word8ElemRep + | Word16ElemRep + | Word32ElemRep + | Word64ElemRep + | FloatElemRep + | DoubleElemRep {- ********************************************************************* * * |