summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
Diffstat (limited to 'libraries')
-rw-r--r--libraries/base/Data/Typeable.hs2
-rw-r--r--libraries/base/Data/Typeable/Internal.hs66
-rw-r--r--libraries/base/GHC/Enum.hs5
-rwxr-xr-xlibraries/base/GHC/Exts.hs3
-rw-r--r--libraries/base/GHC/Show.hs3
-rw-r--r--libraries/base/Unsafe/Coerce.hs2
-rw-r--r--libraries/base/tests/T11334a.hs4
-rw-r--r--libraries/base/tests/T11334a.stdout2
m---------libraries/binary0
-rw-r--r--libraries/ghc-heap/GHC/Exts/Heap.hs8
-rw-r--r--libraries/ghc-heap/tests/ClosureSizeUtils.hs2
-rw-r--r--libraries/ghc-prim/GHC/Types.hs21
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Syntax.hs8
13 files changed, 106 insertions, 20 deletions
diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs
index 43c9aa187d..1c84c99021 100644
--- a/libraries/base/Data/Typeable.hs
+++ b/libraries/base/Data/Typeable.hs
@@ -89,6 +89,8 @@ module Data.Typeable
-- * For backwards compatibility
, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7
+ -- Jank
+ , I.trLiftedRep
) where
import qualified Data.Typeable.Internal as I
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index 008ac1b81b..39974b4052 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ViewPatterns #-}
@@ -79,7 +80,10 @@ module Data.Typeable.Internal (
-- | These are for internal use only
mkTrType, mkTrCon, mkTrApp, mkTrAppChecked, mkTrFun,
mkTyCon, mkTyCon#,
- typeSymbolTypeRep, typeNatTypeRep, typeCharTypeRep
+ typeSymbolTypeRep, typeNatTypeRep, typeCharTypeRep,
+
+ -- * For internal use
+ trLiftedRep
) where
import GHC.Prim ( FUN )
@@ -375,7 +379,12 @@ mkTrCon tc kind_vars = TrTyCon
-- constructor, so we need to build it here.
fpTYPELiftedRep :: Fingerprint
fpTYPELiftedRep = fingerprintFingerprints
- [tyConFingerprint tyConTYPE, typeRepFingerprint trLiftedRep]
+ [ tyConFingerprint tyConTYPE
+ , fingerprintFingerprints
+ [ tyConFingerprint tyCon'BoxedRep
+ , tyConFingerprint tyCon'Lifted
+ ]
+ ]
-- There is absolutely nothing to gain and everything to lose
-- by inlining the worker. The wrapper should inline anyway.
{-# NOINLINE fpTYPELiftedRep #-}
@@ -383,7 +392,7 @@ fpTYPELiftedRep = fingerprintFingerprints
trTYPE :: TypeRep TYPE
trTYPE = typeRep
-trLiftedRep :: TypeRep 'LiftedRep
+trLiftedRep :: TypeRep ('BoxedRep 'Lifted)
trLiftedRep = typeRep
trMany :: TypeRep 'Many
@@ -623,7 +632,7 @@ instantiateKindRep vars = go
= SomeTypeRep $ mkTrApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a)
go (KindRepFun a b)
= SomeTypeRep $ mkTrFun trMany (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b)
- go (KindRepTYPE LiftedRep) = SomeTypeRep TrType
+ go (KindRepTYPE (BoxedRep Lifted)) = SomeTypeRep TrType
go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r
go (KindRepTypeLitS sort s)
= mkTypeLitFromString sort (unpackCStringUtf8# s)
@@ -662,8 +671,9 @@ buildList = foldr cons nil
runtimeRepTypeRep :: RuntimeRep -> SomeKindedTypeRep RuntimeRep
runtimeRepTypeRep r =
case r of
- LiftedRep -> rep @'LiftedRep
- UnliftedRep -> rep @'UnliftedRep
+ BoxedRep Lifted -> SomeKindedTypeRep trLiftedRep
+ BoxedRep v -> kindedTypeRep @_ @'BoxedRep
+ `kApp` levityTypeRep v
VecRep c e -> kindedTypeRep @_ @'VecRep
`kApp` vecCountTypeRep c
`kApp` vecElemTypeRep e
@@ -688,6 +698,15 @@ runtimeRepTypeRep r =
rep :: forall (a :: RuntimeRep). Typeable a => SomeKindedTypeRep RuntimeRep
rep = kindedTypeRep @RuntimeRep @a
+levityTypeRep :: Levity -> SomeKindedTypeRep Levity
+levityTypeRep c =
+ case c of
+ Lifted -> rep @'Lifted
+ Unlifted -> rep @'Unlifted
+ where
+ rep :: forall (a :: Levity). Typeable a => SomeKindedTypeRep Levity
+ rep = kindedTypeRep @Levity @a
+
vecCountTypeRep :: VecCount -> SomeKindedTypeRep VecCount
vecCountTypeRep c =
case c of
@@ -840,13 +859,40 @@ splitApps = go []
-- produce a TypeRep for without difficulty), and then just substitute in the
-- appropriate module and constructor names.
--
+-- Prior to the introduction of BoxedRep, this was bad, but now it is
+-- even worse! We have to construct several different TyCons by hand
+-- so that we can build the fingerprint for TYPE ('BoxedRep 'LiftedRep).
+-- If we call `typeRep @('BoxedRep 'LiftedRep)` while trying to compute
+-- the fingerprint of `TYPE ('BoxedRep 'LiftedRep)`, we get a loop.
+--
-- The ticket to find a better way to deal with this is
-- #14480.
+
+tyConRuntimeRep :: TyCon
+tyConRuntimeRep = mkTyCon ghcPrimPackage "GHC.Types" "RuntimeRep" 0
+ (KindRepTYPE (BoxedRep Lifted))
+
tyConTYPE :: TyCon
-tyConTYPE = mkTyCon (tyConPackage liftedRepTyCon) "GHC.Prim" "TYPE" 0
- (KindRepFun (KindRepTyConApp liftedRepTyCon []) (KindRepTYPE LiftedRep))
- where
- liftedRepTyCon = typeRepTyCon (typeRep @RuntimeRep)
+tyConTYPE = mkTyCon ghcPrimPackage "GHC.Prim" "TYPE" 0
+ (KindRepFun
+ (KindRepTyConApp tyConRuntimeRep [])
+ (KindRepTYPE (BoxedRep Lifted))
+ )
+
+tyConLevity :: TyCon
+tyConLevity = mkTyCon ghcPrimPackage "GHC.Types" "Levity" 0
+ (KindRepTYPE (BoxedRep Lifted))
+
+tyCon'Lifted :: TyCon
+tyCon'Lifted = mkTyCon ghcPrimPackage "GHC.Types" "'Lifted" 0
+ (KindRepTyConApp tyConLevity [])
+
+tyCon'BoxedRep :: TyCon
+tyCon'BoxedRep = mkTyCon ghcPrimPackage "GHC.Types" "'BoxedRep" 0
+ (KindRepFun (KindRepTyConApp tyConLevity []) (KindRepTyConApp tyConRuntimeRep []))
+
+ghcPrimPackage :: String
+ghcPrimPackage = tyConPackage (typeRepTyCon (typeRep @Bool))
funTyCon :: TyCon
funTyCon = typeRepTyCon (typeRep @(->))
diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs
index d107c1eb12..02b3d0e784 100644
--- a/libraries/base/GHC/Enum.hs
+++ b/libraries/base/GHC/Enum.hs
@@ -1005,6 +1005,11 @@ enumNegDeltaToNatural x0 ndelta lim = go x0
-- Instances from GHC.Types
+-- | @since 4.16.0.0
+deriving instance Bounded Levity
+-- | @since 4.16.0.0
+deriving instance Enum Levity
+
-- | @since 4.10.0.0
deriving instance Bounded VecCount
-- | @since 4.10.0.0
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 106c7e9ea6..4b88d34c63 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -90,7 +90,8 @@ module GHC.Exts
type (~~),
-- * Representation polymorphism
- GHC.Prim.TYPE, RuntimeRep(..), VecCount(..), VecElem(..),
+ GHC.Prim.TYPE, RuntimeRep(..), LiftedRep, Levity(..),
+ VecCount(..), VecElem(..),
-- * Transform comprehensions
Down(..), groupWith, sortWith, the,
diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs
index 97d6ad31c7..0d90006432 100644
--- a/libraries/base/GHC/Show.hs
+++ b/libraries/base/GHC/Show.hs
@@ -598,6 +598,9 @@ instance Show KindRep where
. showString " "
. showsPrec 11 q
+-- | @since 4.15.0.0
+deriving instance Show Levity
+
-- | @since 4.11.0.0
deriving instance Show RuntimeRep
diff --git a/libraries/base/Unsafe/Coerce.hs b/libraries/base/Unsafe/Coerce.hs
index 7c8e39e92e..1341a4d1d7 100644
--- a/libraries/base/Unsafe/Coerce.hs
+++ b/libraries/base/Unsafe/Coerce.hs
@@ -285,7 +285,7 @@ unsafeEqualityProof = case unsafeEqualityProof @a @b of UnsafeRefl -> UnsafeRefl
unsafeCoerce :: forall (a :: Type) (b :: Type) . a -> b
unsafeCoerce x = case unsafeEqualityProof @a @b of UnsafeRefl -> x
-unsafeCoerceUnlifted :: forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep) . a -> b
+unsafeCoerceUnlifted :: forall (a :: TYPE ('BoxedRep 'Unlifted)) (b :: TYPE ('BoxedRep 'Unlifted)) . a -> b
-- Kind-homogeneous, but levity monomorphic (TYPE UnliftedRep)
unsafeCoerceUnlifted x = case unsafeEqualityProof @a @b of UnsafeRefl -> x
diff --git a/libraries/base/tests/T11334a.hs b/libraries/base/tests/T11334a.hs
index 0cf91eaa2a..ad296967a7 100644
--- a/libraries/base/tests/T11334a.hs
+++ b/libraries/base/tests/T11334a.hs
@@ -7,5 +7,5 @@ import GHC.Types
main :: IO ()
main = do
print (typeOf (Proxy :: Proxy 'Just))
- print (typeOf (Proxy :: Proxy (TYPE 'LiftedRep)))
- print (typeOf (Proxy :: Proxy (TYPE 'UnliftedRep)))
+ print (typeOf (Proxy :: Proxy (TYPE ('BoxedRep 'Lifted))))
+ print (typeOf (Proxy :: Proxy (TYPE ('BoxedRep 'Unlifted))))
diff --git a/libraries/base/tests/T11334a.stdout b/libraries/base/tests/T11334a.stdout
index c2d860d653..b46a92d366 100644
--- a/libraries/base/tests/T11334a.stdout
+++ b/libraries/base/tests/T11334a.stdout
@@ -1,3 +1,3 @@
Proxy (* -> Maybe *) ('Just *)
Proxy * *
-Proxy * (TYPE 'UnliftedRep)
+Proxy * (TYPE ('BoxedRep 'Unlifted))
diff --git a/libraries/binary b/libraries/binary
-Subproject d0c3f06716be373e4195535a76f94f1bba8ab97
+Subproject 6d3cb9fdc961cc6cce23860d74316c635ed9094
diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs
index 10a9ea8be9..1e429ca054 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap.hs
@@ -91,10 +91,18 @@ class HasHeapRep (a :: TYPE rep) where
-> IO Closure
-- ^ Heap representation of the closure.
+#if __GLASGOW_HASKELL__ >= 901
+instance HasHeapRep (a :: TYPE ('BoxedRep 'Lifted)) where
+#else
instance HasHeapRep (a :: TYPE 'LiftedRep) where
+#endif
getClosureData = getClosureDataFromHeapObject
+#if __GLASGOW_HASKELL__ >= 901
+instance HasHeapRep (a :: TYPE ('BoxedRep 'Unlifted)) where
+#else
instance HasHeapRep (a :: TYPE 'UnliftedRep) where
+#endif
getClosureData x = getClosureDataFromHeapObject (unsafeCoerce# x)
instance Int# ~ a => HasHeapRep (a :: TYPE 'IntRep) where
diff --git a/libraries/ghc-heap/tests/ClosureSizeUtils.hs b/libraries/ghc-heap/tests/ClosureSizeUtils.hs
index 5fafa4f7a5..3b1578451a 100644
--- a/libraries/ghc-heap/tests/ClosureSizeUtils.hs
+++ b/libraries/ghc-heap/tests/ClosureSizeUtils.hs
@@ -30,7 +30,7 @@ assertSize x =
assertSizeBox (asBox x) (typeRep @a)
assertSizeUnlifted
- :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a)
+ :: forall (a :: TYPE ('BoxedRep 'Unlifted)). (HasCallStack, Typeable a)
=> a -- ^ closure
-> Int -- ^ expected size in words
-> IO ()
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index f558619ac1..59edeec8af 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -33,7 +33,9 @@ module GHC.Types (
Symbol,
Any,
type (~~), Coercible,
- TYPE, RuntimeRep(..), Type, Constraint,
+ TYPE, Levity(..), RuntimeRep(..),
+ LiftedRep, UnliftedRep,
+ Type, UnliftedType, 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.
@@ -85,8 +87,17 @@ type (->) = FUN 'Many
-- | The kind of constraints, like @Show a@
data Constraint
+-- | The runtime representation of lifted types.
+type LiftedRep = 'BoxedRep 'Lifted
+
+-- | The runtime representation of unlifted types.
+type UnliftedRep = 'BoxedRep 'Unlifted
+
-- | The kind of types with lifted values. For example @Int :: Type@.
-type Type = TYPE 'LiftedRep
+type Type = TYPE LiftedRep
+
+-- | The kind of types with unlifted values. For example @Int# :: UnliftedType@.
+type UnliftedType = TYPE UnliftedRep
data Multiplicity = Many | One
@@ -410,6 +421,8 @@ data SPEC = SPEC | SPEC2
* *
********************************************************************* -}
+-- | Whether a boxed type is lifted or unlifted.
+data Levity = Lifted | Unlifted
-- | GHC maintains a property that the kind of all inhabited types
-- (as distinct from type constructors or type-level data) tells us
@@ -425,8 +438,7 @@ data SPEC = SPEC | SPEC2
data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type
| TupleRep [RuntimeRep] -- ^ An unboxed tuple of the given reps
| SumRep [RuntimeRep] -- ^ An unboxed sum of the given reps
- | LiftedRep -- ^ lifted; represented by a pointer
- | UnliftedRep -- ^ unlifted; represented by a pointer
+ | BoxedRep Levity -- ^ boxed; represented by a pointer
| IntRep -- ^ signed, word-sized value
| Int8Rep -- ^ signed, 8-bit value
| Int16Rep -- ^ signed, 16-bit value
@@ -444,6 +456,7 @@ data RuntimeRep = VecRep VecCount VecElem -- ^ a SIMD vector type
-- RuntimeRep is intimately tied to TyCon.RuntimeRep (in GHC proper). See
-- Note [RuntimeRep and PrimRep] in RepType.
-- See also Note [Wiring in RuntimeRep] in GHC.Builtin.Types
+-- See also Note [TYPE and RuntimeRep] in GHC.Builtin.Type.Prim
-- | Length of a SIMD vector type
data VecCount = Vec2
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 6508c07a65..3cb5a44ee8 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -61,6 +61,10 @@ import Foreign.ForeignPtr
import Foreign.C.String
import Foreign.C.Types
+#if __GLASGOW_HASKELL__ >= 901
+import GHC.Types ( Levity(..) )
+#endif
+
-----------------------------------------------------
--
-- The Quasi class
@@ -816,7 +820,11 @@ class Lift (t :: TYPE r) where
-- | Turn a value into a Template Haskell expression, suitable for use in
-- a splice.
lift :: Quote m => t -> m Exp
+#if __GLASGOW_HASKELL__ >= 901
+ default lift :: (r ~ ('BoxedRep 'Lifted), Quote m) => t -> m Exp
+#else
default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp
+#endif
lift = unTypeCode . liftTyped
-- | Turn a value into a Template Haskell typed expression, suitable for use
View Lorry Controller Status