Commit bc761ad9 authored by David Feuer's avatar David Feuer Committed by David Feuer
Browse files

Cache TypeRep kinds aggressively

Cache `TypeRep k` in each `TrApp` or `TrTyCon` constructor of
`TypeRep (a :: k)`. This makes `typeRepKind` cheap.

With this change, we won't need any special effort to deserialize
typereps efficiently. The downside, of course, is that we make
`TypeRep`s slightly larger.

Reviewers: austin, hvr, bgamari, simonpj

Reviewed By: bgamari, simonpj

Subscribers: carter, simonpj, rwbarton, thomie

GHC Trac Issues: #14254

Differential Revision: https://phabricator.haskell.org/D4085
parent 12efb230
......@@ -1239,10 +1239,12 @@ ds_ev_typeable ty (EvTypeableTyCon tc kind_ev)
-- Note that we use the kind of the type, not the TyCon from which it
-- is constructed since the latter may be kind polymorphic whereas the
-- former we know is not (we checked in the solver).
; return $ mkApps (Var mkTrCon) [ Type (typeKind ty)
, Type ty
, tc_rep
, kind_args ]
; let expr = mkApps (Var mkTrCon) [ Type (typeKind ty)
, Type ty
, tc_rep
, kind_args ]
-- ; pprRuntimeTrace "Trace mkTrTyCon" (ppr expr) expr
; return expr
}
ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
......@@ -1253,8 +1255,11 @@ ds_ev_typeable ty (EvTypeableTyApp ev1 ev2)
-- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
-- TypeRep a -> TypeRep b -> TypeRep (a b)
; let (k1, k2) = splitFunTy (typeKind t1)
; return $ mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])
[ e1, e2 ] }
; let expr = mkApps (mkTyApps (Var mkTrApp) [ k1, k2, t1, t2 ])
[ e1, e2 ]
-- ; pprRuntimeTrace "Trace mkTrApp" (ppr expr) expr
; return expr
}
ds_ev_typeable ty (EvTypeableTrFun ev1 ev2)
| Just (t1,t2) <- splitFunTy_maybe ty
......
......@@ -240,6 +240,7 @@ basicKnownKeyNames
typeLitSymbolDataConName,
typeLitNatDataConName,
typeRepIdName,
mkTrTypeName,
mkTrConName,
mkTrAppName,
mkTrFunName,
......@@ -1256,6 +1257,7 @@ typeableClassName
, typeRepTyConName
, someTypeRepTyConName
, someTypeRepDataConName
, mkTrTypeName
, mkTrConName
, mkTrAppName
, mkTrFunName
......@@ -1269,6 +1271,7 @@ typeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "TypeRep") typeR
someTypeRepTyConName = tcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepTyConKey
someTypeRepDataConName = dcQual tYPEABLE_INTERNAL (fsLit "SomeTypeRep") someTypeRepDataConKey
typeRepIdName = varQual tYPEABLE_INTERNAL (fsLit "typeRep#") typeRepIdKey
mkTrTypeName = varQual tYPEABLE_INTERNAL (fsLit "mkTrType") mkTrTypeKey
mkTrConName = varQual tYPEABLE_INTERNAL (fsLit "mkTrCon") mkTrConKey
mkTrAppName = varQual tYPEABLE_INTERNAL (fsLit "mkTrApp") mkTrAppKey
mkTrFunName = varQual tYPEABLE_INTERNAL (fsLit "mkTrFun") mkTrFunKey
......@@ -2329,6 +2332,7 @@ proxyHashKey = mkPreludeMiscIdUnique 502
-- Used to make `Typeable` dictionaries
mkTyConKey
, mkTrTypeKey
, mkTrConKey
, mkTrAppKey
, mkTrFunKey
......@@ -2337,12 +2341,13 @@ mkTyConKey
, typeRepIdKey
:: Unique
mkTyConKey = mkPreludeMiscIdUnique 503
mkTrConKey = mkPreludeMiscIdUnique 504
mkTrAppKey = mkPreludeMiscIdUnique 505
typeNatTypeRepKey = mkPreludeMiscIdUnique 506
typeSymbolTypeRepKey = mkPreludeMiscIdUnique 507
typeRepIdKey = mkPreludeMiscIdUnique 508
mkTrFunKey = mkPreludeMiscIdUnique 509
mkTrTypeKey = mkPreludeMiscIdUnique 504
mkTrConKey = mkPreludeMiscIdUnique 505
mkTrAppKey = mkPreludeMiscIdUnique 506
typeNatTypeRepKey = mkPreludeMiscIdUnique 507
typeSymbolTypeRepKey = mkPreludeMiscIdUnique 508
typeRepIdKey = mkPreludeMiscIdUnique 509
mkTrFunKey = mkPreludeMiscIdUnique 510
-- Representations for primitive types
trTYPEKey
......@@ -2350,10 +2355,10 @@ trTYPEKey
, trRuntimeRepKey
, tr'PtrRepLiftedKey
:: Unique
trTYPEKey = mkPreludeMiscIdUnique 510
trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 511
trRuntimeRepKey = mkPreludeMiscIdUnique 512
tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 513
trTYPEKey = mkPreludeMiscIdUnique 511
trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 512
trRuntimeRepKey = mkPreludeMiscIdUnique 513
tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 514
-- KindReps for common cases
starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey :: Unique
......
......@@ -655,17 +655,20 @@ The TypeRep encoding of `Proxy Type Int` looks like this:
$tcProxy :: GHC.Types.TyCon
$trInt :: TypeRep Int
$trType :: TypeRep Type
TrType :: TypeRep Type
$trProxyType :: TypeRep (Proxy Type :: Type -> Type)
$trProxyType = TrTyCon $tcProxy
[$trType] -- kind variable instantiation
[TrType] -- kind variable instantiation
(tyConKind $tcProxy [TrType]) -- The TypeRep of
-- Type -> Type
$trProxy :: TypeRep (Proxy Type Int)
$trProxy = TrApp $trProxyType $trInt
$trProxy = TrApp $trProxyType $trInt TrType
$tkProxy :: GHC.Types.KindRep
$tkProxy = KindRepFun (KindRepVar 0) (KindRepTyConApp $trType [])
$tkProxy = KindRepFun (KindRepVar 0)
(KindRepTyConApp (KindRepTYPE LiftedRep) [])
Note how $trProxyType cannot use 'TrApp', because TypeRep cannot represent
polymorphic types. So instead
......@@ -679,9 +682,10 @@ polymorphic types. So instead
Proxy :: forall k. k->Type
* A KindRep is just a recipe that we can instantiate with the
argument kinds, using Data.Typeable.Internal.instantiateKindRep.
argument kinds, using Data.Typeable.Internal.tyConKind and
store in the relevant 'TypeRep' constructor.
Data.Typeable.Internal.typeRepKind uses instantiateKindRep
Data.Typeable.Internal.typeRepKind looks up the stored kinds.
* In a KindRep, the kind variables are represented by 0-indexed
de Bruijn numbers:
......
......@@ -75,7 +75,7 @@ module Data.Typeable.Internal (
-- * Construction
-- | These are for internal use only
mkTrCon, mkTrApp, mkTrFun,
mkTrType, mkTrCon, mkTrApp, mkTrAppChecked, mkTrFun,
mkTyCon, mkTyCon#,
typeSymbolTypeRep, typeNatTypeRep,
) where
......@@ -97,6 +97,7 @@ import {-# SOURCE #-} GHC.Fingerprint
-- Better to break the loop here, because we want non-SOURCE imports
-- of Data.Typeable as much as possible so we can optimise the derived
-- instances.
-- import {-# SOURCE #-} Debug.Trace (trace)
#include "MachDeps.h"
......@@ -178,6 +179,8 @@ rnfTyCon (TyCon _ _ m n _ k) = rnfModule m `seq` rnfTrName n `seq` rnfKindRep k
-- | A concrete representation of a (monomorphic) type.
-- 'TypeRep' supports reasonably efficient equality.
data TypeRep (a :: k) where
-- The TypeRep of Type. See Note [Kind caching], Wrinkle 2
TrType :: TypeRep Type
TrTyCon :: { -- See Note [TypeRep fingerprints]
trTyConFingerprint :: {-# UNPACK #-} !Fingerprint
......@@ -186,7 +189,8 @@ data TypeRep (a :: k) where
-- 'Just :: Bool -> Maybe Bool, the trTyCon will be
-- 'Just and the trKindVars will be [Bool].
, trTyCon :: !TyCon
, trKindVars :: [SomeTypeRep] }
, trKindVars :: [SomeTypeRep]
, trTyConKind :: !(TypeRep k) } -- See Note [Kind caching]
-> TypeRep (a :: k)
-- | Invariant: Saturated arrow types (e.g. things of the form @a -> b@)
......@@ -198,8 +202,9 @@ data TypeRep (a :: k) where
-- The TypeRep represents the application of trAppFun
-- to trAppArg. For Maybe Int, the trAppFun will be Maybe
-- and the trAppArg will be Int.
, trAppFun :: TypeRep (a :: k1 -> k2)
, trAppArg :: TypeRep (b :: k1) }
, trAppFun :: !(TypeRep (a :: k1 -> k2))
, trAppArg :: !(TypeRep (b :: k1))
, trAppKind :: !(TypeRep k2) } -- See Note [Kind caching]
-> TypeRep (a b)
-- | @TrFun fpr a b@ represents a function type @a -> b@. We use this for
......@@ -211,8 +216,8 @@ data TypeRep (a :: k) where
-- The TypeRep represents a function from trFunArg to
-- trFunRes.
, trFunArg :: TypeRep a
, trFunRes :: TypeRep b }
, trFunArg :: !(TypeRep a)
, trFunRes :: !(TypeRep b) }
-> TypeRep (a -> b)
{- Note [TypeRep fingerprints]
......@@ -222,6 +227,63 @@ us to test whether two TypeReps are equal in constant time, rather than
having to walk their full structures.
-}
{- Note [Kind caching]
~~~~~~~~~~~~~~~~~~~
We cache the kind of the TypeRep in each TrTyCon and TrApp constructor.
This is necessary to ensure that typeRepKind (which is used, at least, in
deserialization and dynApply) is cheap. There are two reasons for this:
1. Calculating the kind of a nest of type applications, such as
F X Y Z W (App (App (App (App F X) Y) Z) W)
is linear in the depth, which is already a bit pricy. In deserialization,
we build up such a nest from the inside out, so without caching, that ends
up taking quadratic time, and calculating the KindRep of the constructor,
F, a linear number of times. See #14254.
2. Calculating the kind of a type constructor, in instantiateTypeRep,
requires building (allocating) a TypeRep for the kind "from scratch".
This can get pricy. When combined with point (1), we can end up with
a large amount of extra allocation deserializing very deep nests.
See #14337.
It is quite possible to speed up deserialization by structuring that process
very carefully. Unfortunately, that doesn't help dynApply or anything else
that may use typeRepKind. Since caching the kind isn't terribly expensive, it
seems better to just do that and solve all the potential problems at once.
There are two things we need to be careful about when caching kinds.
Wrinkle 1:
We want to do it eagerly. Suppose we have
tf :: TypeRep (f :: j -> k)
ta :: TypeRep (a :: j)
Then the cached kind of App tf ta should be eagerly evaluated to k, rather
than being stored as a thunk that will strip the (j ->) off of j -> k if
and when it is forced.
Wrinkle 2:
We need to be able to represent TypeRep Type. This is a bit tricky because
typeRepKind (typeRep @Type) = typeRep @Type, so if we actually cache the
typerep of the kind of Type, we will have a loop. One simple way to do this
is to make the cached kind fields lazy and allow TypeRep Type to be cyclical.
But we *do not* want TypeReps to have cyclical structure! Most importantly,
a cyclical structure cannot be stored in a compact region. Secondarily,
using :force in GHCi on a cyclical structure will lead to non-termination.
To avoid this trouble, we use a separate constructor for TypeRep Type.
mkTrApp is responsible for recognizing that TYPE is being applied to
'LiftedRep and produce trType; other functions must recognize that TrType
represents an application.
-}
-- Compare keys for equality
-- | @since 2.01
......@@ -278,10 +340,15 @@ pattern Fun arg res <- TrFun {trFunArg = arg, trFunRes = res}
--
-- @since 4.8.0.0
typeRepFingerprint :: TypeRep a -> Fingerprint
typeRepFingerprint TrType = fpTYPELiftedRep
typeRepFingerprint (TrTyCon {trTyConFingerprint = fpr}) = fpr
typeRepFingerprint (TrApp {trAppFingerprint = fpr}) = fpr
typeRepFingerprint (TrFun {trFunFingerprint = fpr}) = fpr
-- For compiler use
mkTrType :: TypeRep Type
mkTrType = TrType
-- | Construct a representation for a type constructor
-- applied at a monomorphic kind.
--
......@@ -292,39 +359,74 @@ mkTrCon tc kind_vars = TrTyCon
{ trTyConFingerprint = fpr
, trTyCon = tc
, trKindVars = kind_vars
}
, trTyConKind = kind }
where
fpr_tc = tyConFingerprint tc
fpr_kvs = map someTypeRepFingerprint kind_vars
fpr = fingerprintFingerprints (fpr_tc:fpr_kvs)
kind = unsafeCoerceRep $ tyConKind tc kind_vars
-- The fingerprint of Type. We don't store this in the TrType
-- constructor, so we need to build it here.
fpTYPELiftedRep :: Fingerprint
fpTYPELiftedRep = fingerprintFingerprints
[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 #-}
trTYPE :: TypeRep TYPE
trTYPE = typeRep
-- | Construct a representation for a type application.
trLiftedRep :: TypeRep 'LiftedRep
trLiftedRep = typeRep
-- | Construct a representation for a type application that is
-- NOT a saturated arrow type. This is not checked!
-- Note that this is known-key to the compiler, which uses it in desugar
-- 'Typeable' evidence. See Note [Kind caching]
-- 'Typeable' evidence.
mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep (a :: k1 -> k2)
-> TypeRep (b :: k1)
-> TypeRep (a b)
mkTrApp rep@(TrApp {trAppFun = p, trAppArg = x :: TypeRep x}) (y :: TypeRep y)
| TrTyCon {trTyCon=con} <- p
, con == funTyCon -- cheap check first
, Just (IsTYPE (rx :: TypeRep rx)) <- isTYPE (typeRepKind x)
, Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y)
, Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry
$ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep
= mkTrFun x y
mkTrApp a b = TrApp
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]
-- | Construct a representation for a type application that
-- may be a saturated arrow type. This is renamed to mkTrApp in
-- Type.Reflection.Unsafe
mkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep (a :: k1 -> k2)
-> TypeRep (b :: k1)
-> TypeRep (a b)
mkTrAppChecked rep@(TrApp {trAppFun = p, trAppArg = x :: TypeRep x})
(y :: TypeRep y)
| TrTyCon {trTyCon=con} <- p
, con == funTyCon -- cheap check first
, Just (IsTYPE (rx :: TypeRep rx)) <- isTYPE (typeRepKind x)
, Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y)
, Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry
$ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep
= mkTrFun x y
mkTrAppChecked a b = mkTrApp a b
-- | A type application.
--
-- For instance,
......@@ -347,7 +449,7 @@ pattern App :: forall k2 (t :: k2). ()
=> forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b)
=> TypeRep a -> TypeRep b -> TypeRep t
pattern App f x <- (splitApp -> Just (IsApp f x))
where App f x = mkTrApp f x
where App f x = mkTrAppChecked f x
data IsApp (a :: k) where
IsApp :: forall k k' (f :: k' -> k) (x :: k'). ()
......@@ -356,6 +458,7 @@ data IsApp (a :: k) where
splitApp :: forall k (a :: k). ()
=> TypeRep a
-> Maybe (IsApp a)
splitApp TrType = Just (IsApp trTYPE trLiftedRep)
splitApp (TrApp {trAppFun = f, trAppArg = x}) = Just (IsApp f x)
splitApp rep@(TrFun {trFunArg=a, trFunRes=b}) = Just (IsApp (mkTrApp arr a) b)
where arr = bareArrow rep
......@@ -407,6 +510,7 @@ someTypeRepTyCon (SomeTypeRep t) = typeRepTyCon t
-- | Observe the type constructor of a type representation
typeRepTyCon :: TypeRep a -> TyCon
typeRepTyCon TrType = tyConTYPE
typeRepTyCon (TrTyCon {trTyCon = tc}) = tc
typeRepTyCon (TrApp {trAppFun = a}) = typeRepTyCon a
typeRepTyCon (TrFun {}) = typeRepTyCon $ typeRep @(->)
......@@ -429,15 +533,10 @@ eqTypeRep a b
-- | Observe the kind of a type.
typeRepKind :: TypeRep (a :: k) -> TypeRep k
typeRepKind (TrTyCon {trTyCon = tc, trKindVars = args})
= unsafeCoerceRep $ tyConKind tc args
typeRepKind (TrApp {trAppFun = f})
| TrFun {trFunRes = res} <- typeRepKind f
= res
| otherwise
= error ("Ill-kinded type application: " ++ show (typeRepKind f))
typeRepKind (TrFun {})
= typeRep @Type
typeRepKind TrType = TrType
typeRepKind (TrTyCon {trTyConKind = kind}) = kind
typeRepKind (TrApp {trAppKind = kind}) = kind
typeRepKind (TrFun {}) = typeRep @Type
tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep
tyConKind (TyCon _ _ _ _ nKindVars# kindRep) kindVars =
......@@ -458,7 +557,7 @@ instantiateKindRep vars = go
applyTy :: SomeTypeRep -> KindRep -> SomeTypeRep
applyTy (SomeTypeRep acc) ty
| SomeTypeRep ty' <- go ty
= SomeTypeRep $ mkTrApp (unsafeCoerce acc) (unsafeCoerce ty')
= SomeTypeRep $ mkTrApp (unsafeCoerce acc) ty'
in foldl' applyTy tycon_app ty_args
go (KindRepVar var)
= vars A.! var
......@@ -466,6 +565,7 @@ instantiateKindRep vars = go
= SomeTypeRep $ mkTrApp (unsafeCoerceRep $ go f) (unsafeCoerceRep $ go a)
go (KindRepFun a b)
= SomeTypeRep $ mkTrFun (unsafeCoerceRep $ go a) (unsafeCoerceRep $ go b)
go (KindRepTYPE LiftedRep) = SomeTypeRep TrType
go (KindRepTYPE r) = unkindedTypeRep $ tYPE `kApp` runtimeRepTypeRep r
go (KindRepTypeLitS sort s)
= mkTypeLitFromString sort (unpackCStringUtf8# s)
......@@ -570,12 +670,14 @@ data IsTYPE (a :: Type) where
-- | Is a type of the form @TYPE rep@?
isTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a)
isTYPE TrType = Just (IsTYPE trLiftedRep)
isTYPE (TrApp {trAppFun=f, trAppArg=r})
| Just HRefl <- f `eqTypeRep` typeRep @TYPE
= Just (IsTYPE r)
isTYPE _ = Nothing
getRuntimeRep :: forall (r :: RuntimeRep). TypeRep (TYPE r) -> TypeRep r
getRuntimeRep TrType = trLiftedRep
getRuntimeRep (TrApp {trAppArg=r}) = r
getRuntimeRep _ = error "Data.Typeable.Internal.getRuntimeRep: impossible"
......@@ -617,9 +719,8 @@ instance Show (TypeRep (a :: k)) where
showTypeable :: Int -> TypeRep (a :: k) -> ShowS
showTypeable _ TrType = showChar '*'
showTypeable _ rep
| Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) =
showChar '*'
| isListTyCon tc, [ty] <- tys =
showChar '[' . shows ty . showChar ']'
| isTupleTyCon tc =
......@@ -656,13 +757,33 @@ splitApps = go []
go [] (TrFun {trFunArg = a, trFunRes = b})
= (funTyCon, [SomeTypeRep a, SomeTypeRep b])
go _ (TrFun {})
= errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible"
= errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible 1"
go [] TrType = (tyConTYPE, [SomeTypeRep trLiftedRep])
go _ TrType
= errorWithoutStackTrace "Data.Typeable.Internal.splitApps: Impossible 2"
-- This is incredibly shady! We don't really want to do this here; we
-- should really have the compiler reveal the TYPE TyCon directly
-- somehow. We need to construct this by hand because otherwise
-- we end up with horrible and somewhat mysterious loops trying to calculate
-- typeRep @TYPE. For the moment, we use the fact that we can get the proper
-- name of the ghc-prim package from the TyCon of LiftedRep (which we can
-- produce a TypeRep for without difficulty), and then just substitute in the
-- appropriate module and constructor names.
--
-- The ticket to find a better way to deal with this is
-- Trac #14480.
tyConTYPE :: TyCon
tyConTYPE = mkTyCon (tyConPackage liftedRepTyCon) "GHC.Prim" "TYPE" 0
(KindRepFun (KindRepTyConApp liftedRepTyCon []) (KindRepTYPE LiftedRep))
where
liftedRepTyCon = typeRepTyCon (typeRep @RuntimeRep)
funTyCon :: TyCon
funTyCon = typeRepTyCon (typeRep @(->))
isListTyCon :: TyCon -> Bool
isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [Int])
isListTyCon tc = tc == typeRepTyCon (typeRep :: TypeRep [])
isTupleTyCon :: TyCon -> Bool
isTupleTyCon tc
......@@ -678,12 +799,11 @@ showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as
--
-- @since 4.8.0.0
rnfTypeRep :: TypeRep a -> ()
rnfTypeRep (TrTyCon {trTyCon = tyc})
= rnfTyCon tyc
rnfTypeRep (TrApp {trAppFun = f, trAppArg = x})
= rnfTypeRep f `seq` rnfTypeRep x
rnfTypeRep (TrFun {trFunArg = x, trFunRes = y})
= rnfTypeRep x `seq` rnfTypeRep y
-- The TypeRep structure is almost entirely strict by definition. The
-- fingerprinting and strict kind caching ensure that everything
-- else is forced anyway. So we don't need to do anything special
-- to reduce to normal form.
rnfTypeRep !_ = ()
-- | Helper to fully evaluate 'SomeTypeRep' for use as @NFData(rnf)@
-- implementation
......
......@@ -53,6 +53,8 @@ import GHC.Base
import GHC.List ((!!), foldr1, break)
import GHC.Num
import GHC.Stack.Types
import GHC.Types (TypeLitSort (..))
-- | The @shows@ functions return a function that prepends the
-- output 'String' to an existing 'String'. This allows constant-time
......@@ -547,3 +549,39 @@ integerToString n0 cs0
c@(C# _) -> jblock' (d - 1) q (c : cs)
where
(q, r) = n `quotRemInt` 10
instance Show KindRep where
showsPrec d (KindRepVar v) = showParen (d > 10) $
showString "KindRepVar " . showsPrec 11 v
showsPrec d (KindRepTyConApp p q) = showParen (d > 10) $
showString "KindRepTyConApp "
. showsPrec 11 p
. showString " "
. showsPrec 11 q
showsPrec d (KindRepApp p q) = showParen (d > 10) $
showString "KindRepApp "
. showsPrec 11 p
. showString " "
. showsPrec 11 q
showsPrec d (KindRepFun p q) = showParen (d > 10) $
showString "KindRepFun "
. showsPrec 11 p
. showString " "
. showsPrec 11 q
showsPrec d (KindRepTYPE rep) = showParen (d > 10) $
showString "KindRepTYPE " . showsPrec 11 rep
showsPrec d (KindRepTypeLitS p q) = showParen (d > 10) $
showString "KindRepTypeLitS "
. showsPrec 11 p
. showString " "
. showsPrec 11 (unpackCString# q)
showsPrec d (KindRepTypeLitD p q) = showParen (d > 10) $
showString "KindRepTypeLitD "
. showsPrec 11 p
. showString " "
. showsPrec 11 q
deriving instance Show RuntimeRep
deriving instance Show VecCount
deriving instance Show VecElem
deriving instance Show TypeLitSort
......@@ -12,6 +12,7 @@
-- type representations.
--
-----------------------------------------------------------------------------
{-# LANGUAGE TypeInType, ScopedTypeVariables #-}
module Type.Reflection.Unsafe (
-- * Type representations
......@@ -22,4 +23,12 @@ module Type.Reflection.Unsafe (
, TyCon, mkTrCon, tyConKindRep, tyConKindArgs, tyConFingerprint
) where
import Data.Typeable.Internal
import Data.Typeable.Internal hiding (mkTrApp)
import qualified Data.Typeable.Internal as TI
-- | Construct a representation for a type application.
mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep (a :: k1 -> k2)
-> TypeRep (b :: k1)
-> TypeRep (a b)
mkTrApp = TI.mkTrAppChecked
......@@ -9,7 +9,7 @@
instance Show Integer -- Defined in ‘GHC.Show’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
...plus 22 others
...plus 12 instances involving out-of-scope types
...plus 17 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of an interactive GHCi command: print it
......@@ -23,6 +23,6 @@
instance Show Integer -- Defined in ‘GHC.Show’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
...plus 22 others
...plus 12 instances involving out-of-scope types
...plus 17 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of an interactive GHCi command: print it
......@@ -9,6 +9,6 @@
instance Show TyCon -- Defined in ‘GHC.Show’
instance Show Integer -- Defined in ‘GHC.Show’
...plus 29 others
...plus 13 instances involving out-of-scope types
...plus 18 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of an interactive GHCi command: print it
......@@ -11,7 +11,7 @@ T12522a.hs:20:26: error:
instance Show Integer -- Defined in ‘GHC.Show’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
...plus 22 others
...plus six instances involving out-of-scope types
...plus 11 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the first argument of ‘(++)’, namely ‘show n’
In the second argument of ‘($)’, namely ‘show n ++ s’
......
......@@ -8,7 +8,7 @@ overloadedlistsfail01.hs:5:8: error:
instance Show Integer -- Defined in ‘GHC.Show’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
...plus 22 others
...plus 7 instances involving out-of-scope types
...plus 12 instances involving out-of-scope types