From 331f556886e611af3d2633d1cebb868574a2aa13 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Tue, 15 Dec 2020 11:21:06 -0500 Subject: Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. --- libraries/base/Data/Typeable.hs | 2 - libraries/base/Data/Typeable/Internal.hs | 98 ++++++---------------- libraries/base/GHC/Enum.hs | 5 -- libraries/base/GHC/Exts.hs | 3 +- libraries/base/GHC/Show.hs | 3 - libraries/base/Unsafe/Coerce.hs | 2 +- libraries/base/tests/T11334a.hs | 4 +- libraries/base/tests/T11334a.stdout | 2 +- libraries/binary | 2 +- libraries/ghc-heap/GHC/Exts/Heap.hs | 8 -- libraries/ghc-heap/tests/ClosureSizeUtils.hs | 2 +- libraries/ghc-prim/GHC/Types.hs | 13 +-- .../template-haskell/Language/Haskell/TH/Syntax.hs | 8 -- 13 files changed, 37 insertions(+), 115 deletions(-) (limited to 'libraries') diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs index 1c84c99021..43c9aa187d 100644 --- a/libraries/base/Data/Typeable.hs +++ b/libraries/base/Data/Typeable.hs @@ -89,8 +89,6 @@ 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 de20ca8e19..85abebf331 100644 --- a/libraries/base/Data/Typeable/Internal.hs +++ b/libraries/base/Data/Typeable/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ViewPatterns #-} @@ -81,9 +80,6 @@ module Data.Typeable.Internal ( mkTrType, mkTrCon, mkTrApp, mkTrAppChecked, mkTrFun, mkTyCon, mkTyCon#, typeSymbolTypeRep, typeNatTypeRep, - - -- Jank - trLiftedRep ) where import GHC.Prim ( FUN ) @@ -379,12 +375,7 @@ mkTrCon tc kind_vars = TrTyCon -- constructor, so we need to build it here. fpTYPELiftedRep :: Fingerprint fpTYPELiftedRep = fingerprintFingerprints - [ tyConFingerprint tyConTYPE - , fingerprintFingerprints - [ tyConFingerprint tyCon'BoxedRep - , tyConFingerprint tyCon'Lifted - ] - ] + [tyConFingerprint tyConTYPE, typeRepFingerprint trLiftedRep] -- There is absolutely nothing to gain and everything to lose -- by inlining the worker. The wrapper should inline anyway. {-# NOINLINE fpTYPELiftedRep #-} @@ -392,7 +383,7 @@ fpTYPELiftedRep = fingerprintFingerprints trTYPE :: TypeRep TYPE trTYPE = typeRep -trLiftedRep :: TypeRep ('BoxedRep 'Lifted) +trLiftedRep :: TypeRep 'LiftedRep trLiftedRep = typeRep trMany :: TypeRep 'Many @@ -408,23 +399,23 @@ mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). -> TypeRep (b :: k1) -> TypeRep (a b) mkTrApp a b -- See Note [Kind caching], Wrinkle 2 - | Just HRefl <- a `eqTypeRep` trTYPE - , Just HRefl <- b `eqTypeRep` trLiftedRep - = TrType - - | TrFun {trFunRes = res_kind} <- typeRepKind a - = TrApp - { trAppFingerprint = fpr - , trAppFun = a - , trAppArg = b - , trAppKind = res_kind } - - | otherwise = error ("Ill-kinded type application: " - ++ show (typeRepKind a)) - where - fpr_a = typeRepFingerprint a - fpr_b = typeRepFingerprint b - fpr = fingerprintFingerprints [fpr_a, fpr_b] + | Just HRefl <- a `eqTypeRep` trTYPE + , Just HRefl <- b `eqTypeRep` trLiftedRep + = TrType + + | TrFun {trFunRes = res_kind} <- typeRepKind a + = TrApp + { trAppFingerprint = fpr + , trAppFun = a + , trAppArg = b + , trAppKind = res_kind } + + | otherwise = error ("Ill-kinded type application: " + ++ show (typeRepKind a)) + where + fpr_a = typeRepFingerprint a + fpr_b = typeRepFingerprint b + fpr = fingerprintFingerprints [fpr_a, fpr_b] -- | Construct a representation for a type application that -- may be a saturated arrow type. This is renamed to mkTrApp in @@ -632,7 +623,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 (BoxedRep Lifted)) = SomeTypeRep TrType + go (KindRepTYPE LiftedRep) = SomeTypeRep TrType go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r go (KindRepTypeLitS sort s) = mkTypeLitFromString sort (unpackCStringUtf8# s) @@ -671,9 +662,8 @@ buildList = foldr cons nil runtimeRepTypeRep :: RuntimeRep -> SomeKindedTypeRep RuntimeRep runtimeRepTypeRep r = case r of - BoxedRep Lifted -> SomeKindedTypeRep trLiftedRep - BoxedRep v -> kindedTypeRep @_ @'BoxedRep - `kApp` levityTypeRep v + LiftedRep -> rep @'LiftedRep + UnliftedRep -> rep @'UnliftedRep VecRep c e -> kindedTypeRep @_ @'VecRep `kApp` vecCountTypeRep c `kApp` vecElemTypeRep e @@ -698,15 +688,6 @@ 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 @@ -859,40 +840,13 @@ 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 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)) +tyConTYPE = mkTyCon (tyConPackage liftedRepTyCon) "GHC.Prim" "TYPE" 0 + (KindRepFun (KindRepTyConApp liftedRepTyCon []) (KindRepTYPE LiftedRep)) + where + liftedRepTyCon = typeRepTyCon (typeRep @RuntimeRep) funTyCon :: TyCon funTyCon = typeRepTyCon (typeRep @(->)) diff --git a/libraries/base/GHC/Enum.hs b/libraries/base/GHC/Enum.hs index 7bf00f490d..54d6c6b34a 100644 --- a/libraries/base/GHC/Enum.hs +++ b/libraries/base/GHC/Enum.hs @@ -1005,11 +1005,6 @@ enumNegDeltaToNatural x0 ndelta lim = go x0 -- Instances from GHC.Types --- | @since 4.15.0.0 -deriving instance Bounded Levity --- | @since 4.15.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 087427e84a..31788c24c0 100755 --- a/libraries/base/GHC/Exts.hs +++ b/libraries/base/GHC/Exts.hs @@ -91,8 +91,7 @@ module GHC.Exts type (~~), -- * Representation polymorphism - GHC.Prim.TYPE, RuntimeRep(..), LiftedRep, Levity(..), - VecCount(..), VecElem(..), + GHC.Prim.TYPE, RuntimeRep(..), VecCount(..), VecElem(..), -- * Transform comprehensions Down(..), groupWith, sortWith, the, diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index bf8ced5312..3de7aca723 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -594,9 +594,6 @@ 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 ae8c64145a..6792592254 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 ('BoxedRep 'Unlifted)) (b :: TYPE ('BoxedRep 'Unlifted)) . a -> b +unsafeCoerceUnlifted :: forall (a :: TYPE 'UnliftedRep) (b :: TYPE 'UnliftedRep) . 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 ad296967a7..0cf91eaa2a 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 ('BoxedRep 'Lifted)))) - print (typeOf (Proxy :: Proxy (TYPE ('BoxedRep 'Unlifted)))) + print (typeOf (Proxy :: Proxy (TYPE 'LiftedRep))) + print (typeOf (Proxy :: Proxy (TYPE 'UnliftedRep))) diff --git a/libraries/base/tests/T11334a.stdout b/libraries/base/tests/T11334a.stdout index b46a92d366..c2d860d653 100644 --- a/libraries/base/tests/T11334a.stdout +++ b/libraries/base/tests/T11334a.stdout @@ -1,3 +1,3 @@ Proxy (* -> Maybe *) ('Just *) Proxy * * -Proxy * (TYPE ('BoxedRep 'Unlifted)) +Proxy * (TYPE 'UnliftedRep) diff --git a/libraries/binary b/libraries/binary index f22b3d34bb..b224410161 160000 --- a/libraries/binary +++ b/libraries/binary @@ -1 +1 @@ -Subproject commit f22b3d34bb46f95ec5a23d1ef894e2a05818a781 +Subproject commit b224410161f112dd1133a787ded9831799589ce7 diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs index 70ee2f0ecf..2dfe788406 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap.hs +++ b/libraries/ghc-heap/GHC/Exts/Heap.hs @@ -90,18 +90,10 @@ 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 3b1578451a..5fafa4f7a5 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 ('BoxedRep 'Unlifted)). (HasCallStack, Typeable a) + :: forall (a :: TYPE 'UnliftedRep). (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 2f9130425a..dc81a9b8d3 100644 --- a/libraries/ghc-prim/GHC/Types.hs +++ b/libraries/ghc-prim/GHC/Types.hs @@ -33,7 +33,7 @@ module GHC.Types ( Symbol, Any, type (~~), Coercible, - TYPE, Levity(..), RuntimeRep(..), LiftedRep, Type, Constraint, + TYPE, RuntimeRep(..), 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. @@ -85,11 +85,8 @@ type (->) = FUN 'Many -- | The kind of constraints, like @Show a@ data Constraint --- | The runtime representation of lifted types. -type LiftedRep = 'BoxedRep 'Lifted - -- | The kind of types with lifted values. For example @Int :: Type@. -type Type = TYPE LiftedRep +type Type = TYPE 'LiftedRep data Multiplicity = Many | One @@ -413,8 +410,6 @@ 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 @@ -430,7 +425,8 @@ data Levity = Lifted | Unlifted 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 - | BoxedRep Levity -- ^ boxed; represented by a pointer + | LiftedRep -- ^ lifted; represented by a pointer + | UnliftedRep -- ^ unlifted; represented by a pointer | IntRep -- ^ signed, word-sized value | Int8Rep -- ^ signed, 8-bit value | Int16Rep -- ^ signed, 16-bit value @@ -448,7 +444,6 @@ 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 c7d5c81c68..a3104ed684 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -61,10 +61,6 @@ import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types -#if __GLASGOW_HASKELL__ >= 901 -import GHC.Types ( Levity(..) ) -#endif - ----------------------------------------------------- -- -- The Quasi class @@ -820,11 +816,7 @@ 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 -- cgit v1.2.1