{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE LinearTypes #-}
module Data.Typeable.Internal (
Fingerprint(..),
Typeable(..),
withTypeable,
Module,
moduleName, modulePackage, rnfModule,
TyCon,
tyConPackage, tyConModule, tyConName, tyConKindArgs, tyConKindRep,
tyConFingerprint,
KindRep(.., KindRepTypeLit), TypeLitSort(..),
rnfTyCon,
TypeRep,
pattern TypeRep,
pattern App, pattern Con, pattern Con', pattern Fun,
typeRep,
typeOf,
typeRepTyCon,
typeRepFingerprint,
rnfTypeRep,
eqTypeRep,
typeRepKind,
splitApps,
SomeTypeRep(..),
someTypeRep,
someTypeRepTyCon,
someTypeRepFingerprint,
rnfSomeTypeRep,
mkTrType, mkTrCon, mkTrApp, mkTrAppChecked, mkTrFun,
mkTyCon, mkTyCon#,
typeSymbolTypeRep, typeNatTypeRep, typeCharTypeRep,
trLiftedRep
) where
import GHC.Base
import qualified GHC.Arr as A
import Data.Type.Equality
import GHC.List ( splitAt, foldl', elem )
import GHC.Word
import GHC.Show
import GHC.TypeLits ( KnownChar, charVal', KnownSymbol, symbolVal'
, TypeError, ErrorMessage(..) )
import GHC.TypeNats ( KnownNat, Nat, natVal' )
import Unsafe.Coerce ( unsafeCoerce )
import GHC.Fingerprint.Type
import {-# SOURCE #-} GHC.Fingerprint
#include "MachDeps.h"
modulePackage :: Module -> String
modulePackage :: Module -> String
modulePackage (Module TrName
p TrName
_) = TrName -> String
trNameString TrName
p
moduleName :: Module -> String
moduleName :: Module -> String
moduleName (Module TrName
_ TrName
m) = TrName -> String
trNameString TrName
m
tyConPackage :: TyCon -> String
tyConPackage :: TyCon -> String
tyConPackage (TyCon Word64#
_ Word64#
_ Module
m TrName
_ Int#
_ KindRep
_) = Module -> String
modulePackage Module
m
tyConModule :: TyCon -> String
tyConModule :: TyCon -> String
tyConModule (TyCon Word64#
_ Word64#
_ Module
m TrName
_ Int#
_ KindRep
_) = Module -> String
moduleName Module
m
tyConName :: TyCon -> String
tyConName :: TyCon -> String
tyConName (TyCon Word64#
_ Word64#
_ Module
_ TrName
n Int#
_ KindRep
_) = TrName -> String
trNameString TrName
n
trNameString :: TrName -> String
trNameString :: TrName -> String
trNameString (TrNameS Addr#
s) = Addr# -> String
unpackCStringUtf8# Addr#
s
trNameString (TrNameD String
s) = String
s
tyConFingerprint :: TyCon -> Fingerprint
tyConFingerprint :: TyCon -> Fingerprint
tyConFingerprint (TyCon Word64#
hi Word64#
lo Module
_ TrName
_ Int#
_ KindRep
_)
= Word64 -> Word64 -> Fingerprint
Fingerprint (Word64# -> Word64
W64# Word64#
hi) (Word64# -> Word64
W64# Word64#
lo)
tyConKindArgs :: TyCon -> Int
tyConKindArgs :: TyCon -> KindBndr
tyConKindArgs (TyCon Word64#
_ Word64#
_ Module
_ TrName
_ Int#
n KindRep
_) = Int# -> KindBndr
I# Int#
n
tyConKindRep :: TyCon -> KindRep
tyConKindRep :: TyCon -> KindRep
tyConKindRep (TyCon Word64#
_ Word64#
_ Module
_ TrName
_ Int#
_ KindRep
k) = KindRep
k
rnfModule :: Module -> ()
rnfModule :: Module -> ()
rnfModule (Module TrName
p TrName
m) = TrName -> ()
rnfTrName TrName
p () -> () -> ()
forall a b. a -> b -> b
`seq` TrName -> ()
rnfTrName TrName
m
rnfTrName :: TrName -> ()
rnfTrName :: TrName -> ()
rnfTrName (TrNameS Addr#
_) = ()
rnfTrName (TrNameD String
n) = String -> ()
rnfString String
n
rnfKindRep :: KindRep -> ()
rnfKindRep :: KindRep -> ()
rnfKindRep (KindRepTyConApp TyCon
tc [KindRep]
args) = TyCon -> ()
rnfTyCon TyCon
tc () -> () -> ()
forall a b. a -> b -> b
`seq` (KindRep -> ()) -> [KindRep] -> ()
forall a. (a -> ()) -> [a] -> ()
rnfList KindRep -> ()
rnfKindRep [KindRep]
args
rnfKindRep (KindRepVar KindBndr
_) = ()
rnfKindRep (KindRepApp KindRep
a KindRep
b) = KindRep -> ()
rnfKindRep KindRep
a () -> () -> ()
forall a b. a -> b -> b
`seq` KindRep -> ()
rnfKindRep KindRep
b
rnfKindRep (KindRepFun KindRep
a KindRep
b) = KindRep -> ()
rnfKindRep KindRep
a () -> () -> ()
forall a b. a -> b -> b
`seq` KindRep -> ()
rnfKindRep KindRep
b
rnfKindRep (KindRepTYPE RuntimeRep
rr) = RuntimeRep -> ()
rnfRuntimeRep RuntimeRep
rr
rnfKindRep (KindRepTypeLitS TypeLitSort
_ Addr#
_) = ()
rnfKindRep (KindRepTypeLitD TypeLitSort
_ String
t) = String -> ()
rnfString String
t
rnfRuntimeRep :: RuntimeRep -> ()
rnfRuntimeRep :: RuntimeRep -> ()
rnfRuntimeRep (VecRep !VecCount
_ !VecElem
_) = ()
rnfRuntimeRep !RuntimeRep
_ = ()
rnfList :: (a -> ()) -> [a] -> ()
rnfList :: forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
_ [] = ()
rnfList a -> ()
force (a
x:[a]
xs) = a -> ()
force a
x () -> () -> ()
forall a b. a -> b -> b
`seq` (a -> ()) -> [a] -> ()
forall a. (a -> ()) -> [a] -> ()
rnfList a -> ()
force [a]
xs
rnfString :: [Char] -> ()
rnfString :: String -> ()
rnfString = (Char -> ()) -> String -> ()
forall a. (a -> ()) -> [a] -> ()
rnfList (Char -> () -> ()
forall a b. a -> b -> b
`seq` ())
rnfTyCon :: TyCon -> ()
rnfTyCon :: TyCon -> ()
rnfTyCon (TyCon Word64#
_ Word64#
_ Module
m TrName
n Int#
_ KindRep
k) = Module -> ()
rnfModule Module
m () -> () -> ()
forall a b. a -> b -> b
`seq` TrName -> ()
rnfTrName TrName
n () -> () -> ()
forall a b. a -> b -> b
`seq` KindRep -> ()
rnfKindRep KindRep
k
type TypeRep :: k -> Type
data TypeRep a where
TrType :: TypeRep Type
TrTyCon :: {
forall k (a :: k). TypeRep a -> Fingerprint
trTyConFingerprint :: {-# UNPACK #-} !Fingerprint
, forall k (a :: k). TypeRep a -> TyCon
trTyCon :: !TyCon
, forall k (a :: k). TypeRep a -> [SomeTypeRep]
trKindVars :: [SomeTypeRep]
, forall k (a :: k). TypeRep a -> TypeRep k
trTyConKind :: !(TypeRep k) }
-> TypeRep (a :: k)
TrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
{
forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> Fingerprint
trAppFingerprint :: {-# UNPACK #-} !Fingerprint
, forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep a
trAppFun :: !(TypeRep (a :: k1 -> k2))
, forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep x
trAppArg :: !(TypeRep (b :: k1))
, forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep k2
trAppKind :: !(TypeRep k2) }
-> TypeRep (a b)
TrFun :: forall (m :: Multiplicity) (r1 :: RuntimeRep) (r2 :: RuntimeRep)
(a :: TYPE r1) (b :: TYPE r2).
{
forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> Fingerprint
trFunFingerprint :: {-# UNPACK #-} !Fingerprint
, forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep m
trFunMul :: !(TypeRep m)
, forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep LiftedRep
trFunArg :: !(TypeRep a)
, forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep b
trFunRes :: !(TypeRep b) }
-> TypeRep (FUN m a b)
type TypeableInstance :: forall k. k -> Type
data TypeableInstance a where
TypeableInstance :: Typeable a => TypeableInstance a
typeableInstance :: forall {k :: Type} (a :: k). TypeRep a -> TypeableInstance a
typeableInstance :: forall {k} (a :: k). TypeRep a -> TypeableInstance a
typeableInstance TypeRep a
rep = TypeRep a
-> (Typeable a => TypeableInstance a) -> TypeableInstance a
forall k (a :: k) r. TypeRep a -> (Typeable a => r) -> r
withTypeable TypeRep a
rep TypeableInstance a
Typeable a => TypeableInstance a
forall {k} (a :: k). Typeable a => TypeableInstance a
TypeableInstance
pattern TypeRep :: forall {k :: Type} (a :: k). () => Typeable @k a => TypeRep @k a
pattern $mTypeRep :: forall {r} {k} {a :: k}.
TypeRep a -> (Typeable a => r) -> ((# #) -> r) -> r
$bTypeRep :: forall {k} (a :: k). Typeable a => TypeRep a
TypeRep <- (typeableInstance -> TypeableInstance)
where TypeRep = TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep
instance Eq (TypeRep a) where
TypeRep a
_ == :: TypeRep a -> TypeRep a -> Bool
== TypeRep a
_ = Bool
True
{-# INLINABLE (==) #-}
instance TestEquality TypeRep where
TypeRep a
a testEquality :: forall (a :: k) (b :: k). TypeRep a -> TypeRep b -> Maybe (a :~: b)
`testEquality` TypeRep b
b
| Just a :~~: b
HRefl <- TypeRep a -> TypeRep b -> Maybe (a :~~: b)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep a
a TypeRep b
b
= (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
| Bool
otherwise
= Maybe (a :~: b)
forall a. Maybe a
Nothing
{-# INLINEABLE testEquality #-}
instance Ord (TypeRep a) where
compare :: TypeRep a -> TypeRep a -> Ordering
compare TypeRep a
_ TypeRep a
_ = Ordering
EQ
{-# INLINABLE compare #-}
data SomeTypeRep where
SomeTypeRep :: forall k (a :: k). !(TypeRep a) %1 -> SomeTypeRep
instance Eq SomeTypeRep where
SomeTypeRep TypeRep a
a == :: SomeTypeRep -> SomeTypeRep -> Bool
== SomeTypeRep TypeRep a
b =
case TypeRep a
a TypeRep a -> TypeRep a -> Maybe (a :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
b of
Just a :~~: a
_ -> Bool
True
Maybe (a :~~: a)
Nothing -> Bool
False
instance Ord SomeTypeRep where
SomeTypeRep TypeRep a
a compare :: SomeTypeRep -> SomeTypeRep -> Ordering
`compare` SomeTypeRep TypeRep a
b =
TypeRep a -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep a
a Fingerprint -> Fingerprint -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` TypeRep a -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep a
b
pattern Fun :: forall k (fun :: k). ()
=> forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
(arg :: TYPE r1) (res :: TYPE r2).
(k ~ Type, fun ~~ (arg -> res))
=> TypeRep arg
-> TypeRep res
-> TypeRep fun
pattern $mFun :: forall {r} {k} {fun :: k}.
TypeRep fun
-> (forall {arg} {res}.
(k ~ *, fun ~~ (arg -> res)) =>
TypeRep arg -> TypeRep res -> r)
-> ((# #) -> r)
-> r
$bFun :: forall k (fun :: k) arg res.
(k ~ *, fun ~~ (arg -> res)) =>
TypeRep arg -> TypeRep res -> TypeRep fun
Fun arg res <- TrFun {trFunArg = arg, trFunRes = res, trFunMul = (eqTypeRep trMany -> Just HRefl)}
where Fun TypeRep arg
arg TypeRep res
res = TypeRep 'Many -> TypeRep arg -> TypeRep res -> TypeRep (arg -> res)
forall (m :: Multiplicity) a b.
TypeRep m -> TypeRep a -> TypeRep b -> TypeRep (a %m -> b)
mkTrFun TypeRep 'Many
trMany TypeRep arg
arg TypeRep res
res
typeRepFingerprint :: TypeRep a -> Fingerprint
typeRepFingerprint :: forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep a
TrType = Fingerprint
fpTYPELiftedRep
typeRepFingerprint (TrTyCon {trTyConFingerprint :: forall k (a :: k). TypeRep a -> Fingerprint
trTyConFingerprint = Fingerprint
fpr}) = Fingerprint
fpr
typeRepFingerprint (TrApp {trAppFingerprint :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> Fingerprint
trAppFingerprint = Fingerprint
fpr}) = Fingerprint
fpr
typeRepFingerprint (TrFun {trFunFingerprint :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> Fingerprint
trFunFingerprint = Fingerprint
fpr}) = Fingerprint
fpr
mkTrType :: TypeRep Type
mkTrType :: TypeRep (*)
mkTrType = TypeRep (*)
TrType
mkTrCon :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
mkTrCon :: forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
mkTrCon TyCon
tc [SomeTypeRep]
kind_vars = TrTyCon
{ trTyConFingerprint :: Fingerprint
trTyConFingerprint = Fingerprint
fpr
, trTyCon :: TyCon
trTyCon = TyCon
tc
, trKindVars :: [SomeTypeRep]
trKindVars = [SomeTypeRep]
kind_vars
, trTyConKind :: TypeRep k
trTyConKind = TypeRep k
kind }
where
fpr_tc :: Fingerprint
fpr_tc = TyCon -> Fingerprint
tyConFingerprint TyCon
tc
fpr_kvs :: [Fingerprint]
fpr_kvs = (SomeTypeRep -> Fingerprint) -> [SomeTypeRep] -> [Fingerprint]
forall a b. (a -> b) -> [a] -> [b]
map SomeTypeRep -> Fingerprint
someTypeRepFingerprint [SomeTypeRep]
kind_vars
fpr :: Fingerprint
fpr = [Fingerprint] -> Fingerprint
fingerprintFingerprints (Fingerprint
fpr_tcFingerprint -> [Fingerprint] -> [Fingerprint]
forall a. a -> [a] -> [a]
:[Fingerprint]
fpr_kvs)
kind :: TypeRep k
kind = SomeTypeRep -> TypeRep k
forall {k} (a :: k). SomeTypeRep -> TypeRep a
unsafeCoerceRep (SomeTypeRep -> TypeRep k) -> SomeTypeRep -> TypeRep k
forall a b. (a -> b) -> a -> b
$ TyCon -> [SomeTypeRep] -> SomeTypeRep
tyConKind TyCon
tc [SomeTypeRep]
kind_vars
fpTYPELiftedRep :: Fingerprint
fpTYPELiftedRep :: Fingerprint
fpTYPELiftedRep = [Fingerprint] -> Fingerprint
fingerprintFingerprints
[ TyCon -> Fingerprint
tyConFingerprint TyCon
tyConTYPE
, [Fingerprint] -> Fingerprint
fingerprintFingerprints
[ TyCon -> Fingerprint
tyConFingerprint TyCon
tyCon'BoxedRep
, TyCon -> Fingerprint
tyConFingerprint TyCon
tyCon'Lifted
]
]
{-# NOINLINE fpTYPELiftedRep #-}
trTYPE :: TypeRep TYPE
trTYPE :: TypeRep TYPE
trTYPE = TypeRep TYPE
forall {k} (a :: k). Typeable a => TypeRep a
typeRep
trLiftedRep :: TypeRep ('BoxedRep 'Lifted)
trLiftedRep :: TypeRep LiftedRep
trLiftedRep = TypeRep LiftedRep
forall {k} (a :: k). Typeable a => TypeRep a
typeRep
trMany :: TypeRep 'Many
trMany :: TypeRep 'Many
trMany = TypeRep 'Many
forall {k} (a :: k). Typeable a => TypeRep a
typeRep
mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep (a :: k1 -> k2)
-> TypeRep (b :: k1)
-> TypeRep (a b)
mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp TypeRep a
a TypeRep b
b
| Just a :~~: TYPE
HRefl <- TypeRep a
a TypeRep a -> TypeRep TYPE -> Maybe (a :~~: TYPE)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep TYPE
trTYPE
, Just b :~~: LiftedRep
HRefl <- TypeRep b
b TypeRep b -> TypeRep LiftedRep -> Maybe (b :~~: LiftedRep)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep LiftedRep
trLiftedRep
= TypeRep (a b)
TypeRep (*)
TrType
| TrFun {trFunRes :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep b
trFunRes = TypeRep b
res_kind} <- TypeRep a -> TypeRep (k1 -> k2)
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
a
= TrApp
{ trAppFingerprint :: Fingerprint
trAppFingerprint = Fingerprint
fpr
, trAppFun :: TypeRep a
trAppFun = TypeRep a
a
, trAppArg :: TypeRep b
trAppArg = TypeRep b
b
, trAppKind :: TypeRep k2
trAppKind = TypeRep b
TypeRep k2
res_kind }
| Bool
otherwise = String -> TypeRep (a b)
forall a. HasCallStack => String -> a
error (String
"Ill-kinded type application: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep (k1 -> k2) -> String
forall a. Show a => a -> String
show (TypeRep a -> TypeRep (k1 -> k2)
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
a))
where
fpr_a :: Fingerprint
fpr_a = TypeRep a -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep a
a
fpr_b :: Fingerprint
fpr_b = TypeRep b -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep b
b
fpr :: Fingerprint
fpr = [Fingerprint] -> Fingerprint
fingerprintFingerprints [Fingerprint
fpr_a, Fingerprint
fpr_b]
mkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep (a :: k1 -> k2)
-> TypeRep (b :: k1)
-> TypeRep (a b)
mkTrAppChecked :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrAppChecked rep :: TypeRep a
rep@(TrApp {trAppFun :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep a
trAppFun = TypeRep a
p, trAppArg :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep x
trAppArg = x :: TypeRep b
x@TypeRep b
TypeRep :: TypeRep x})
(TypeRep b
y :: TypeRep y)
| TrTyCon {trTyCon :: forall k (a :: k). TypeRep a -> TyCon
trTyCon=TyCon
con} <- TypeRep a
p
, TyCon
con TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TyCon
funTyCon
, Just (IsTYPE TypeRep r
TypeRep) <- TypeRep k1 -> Maybe (IsTYPE k1)
forall a. TypeRep a -> Maybe (IsTYPE a)
isTYPE (TypeRep b -> TypeRep k1
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep b
x)
, Just (IsTYPE (TypeRep r
TypeRep :: TypeRep ry)) <- TypeRep k1 -> Maybe (IsTYPE k1)
forall a. TypeRep a -> Maybe (IsTYPE a)
isTYPE (TypeRep b -> TypeRep k1
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep b
y)
, Just (->) b :~~: a
HRefl <- forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: TYPE r -> *). Typeable a => TypeRep a
typeRep @((->) x :: TYPE ry -> Type) TypeRep ((->) b) -> TypeRep a -> Maybe ((->) b :~~: a)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a
rep
= TypeRep 'Many -> TypeRep b -> TypeRep b -> TypeRep (b -> b)
forall (m :: Multiplicity) a b.
TypeRep m -> TypeRep a -> TypeRep b -> TypeRep (a %m -> b)
mkTrFun TypeRep 'Many
trMany TypeRep b
TypeRep b
x TypeRep b
TypeRep b
y
mkTrAppChecked TypeRep a
a TypeRep b
b = TypeRep a -> TypeRep b -> TypeRep (a b)
forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp TypeRep a
a TypeRep b
b
pattern App :: forall k2 (t :: k2). ()
=> forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b)
=> TypeRep a -> TypeRep b -> TypeRep t
pattern $mApp :: forall {r} {k2} {t :: k2}.
TypeRep t
-> (forall {k1} {a :: k1 -> k2} {b :: k1}.
(t ~ a b) =>
TypeRep a -> TypeRep b -> r)
-> ((# #) -> r)
-> r
$bApp :: forall k2 (t :: k2) k1 (a :: k1 -> k2) (b :: k1).
(t ~ a b) =>
TypeRep a -> TypeRep b -> TypeRep t
App f x <- (splitApp -> IsApp f x)
where App TypeRep a
f TypeRep b
x = TypeRep a -> TypeRep b -> TypeRep (a b)
forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrAppChecked TypeRep a
f TypeRep b
x
data AppOrCon (a :: k) where
IsApp :: forall k k' (f :: k' -> k) (x :: k'). ()
=> TypeRep f %1 -> TypeRep x %1 -> AppOrCon (f x)
IsCon :: NotApplication a => TyCon %1 -> [SomeTypeRep] %1 -> AppOrCon a
type family NotApplication (x :: k) :: Constraint where
NotApplication (f a)
= TypeError
( 'Text "Cannot match this TypeRep with Con or Con': it is an application:"
':$$: 'Text " " ':<>: 'ShowType (f a)
)
NotApplication _
= ()
splitApp :: forall k (a :: k). ()
=> TypeRep a
-> AppOrCon a
splitApp :: forall k (a :: k). TypeRep a -> AppOrCon a
splitApp TypeRep a
TrType = TypeRep TYPE -> TypeRep LiftedRep -> AppOrCon (*)
forall k m (a :: m -> k) (x :: m).
TypeRep a -> TypeRep x -> AppOrCon (a x)
IsApp TypeRep TYPE
TypeRep TYPE
trTYPE TypeRep LiftedRep
trLiftedRep
splitApp (TrApp {trAppFun :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep a
trAppFun = TypeRep a
f, trAppArg :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep x
trAppArg = TypeRep b
x}) = TypeRep a -> TypeRep b -> AppOrCon (a b)
forall k m (a :: m -> k) (x :: m).
TypeRep a -> TypeRep x -> AppOrCon (a x)
IsApp TypeRep a
f TypeRep b
x
splitApp rep :: TypeRep a
rep@(TrFun {trFunArg :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep LiftedRep
trFunArg=TypeRep a
a, trFunRes :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep b
trFunRes=TypeRep b
b}) = TypeRep (FUN m a) -> TypeRep b -> AppOrCon (a %m -> b)
forall k m (a :: m -> k) (x :: m).
TypeRep a -> TypeRep x -> AppOrCon (a x)
IsApp (TypeRep (FUN m) -> TypeRep a -> TypeRep (FUN m a)
forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp TypeRep (FUN m)
TypeRep (FUN m)
arr TypeRep a
a) TypeRep b
b
where arr :: TypeRep (FUN m)
arr = TypeRep (a %m -> b) -> TypeRep (FUN m)
forall (m :: Multiplicity) a b.
TypeRep (a %m -> b) -> TypeRep (FUN m)
bareArrow TypeRep a
TypeRep (a %m -> b)
rep
splitApp (TrTyCon{trTyCon :: forall k (a :: k). TypeRep a -> TyCon
trTyCon = TyCon
con, trKindVars :: forall k (a :: k). TypeRep a -> [SomeTypeRep]
trKindVars = [SomeTypeRep]
kinds})
= case (Any :~: Any) -> NotApplication a :~: (() :: Constraint)
forall a b. a -> b
unsafeCoerce Any :~: Any
forall {k} (a :: k). a :~: a
Refl :: NotApplication a :~: (() :: Constraint) of
NotApplication a :~: (() :: Constraint)
Refl -> TyCon -> [SomeTypeRep] -> AppOrCon a
forall {k} (a :: k).
NotApplication a =>
TyCon -> [SomeTypeRep] -> AppOrCon a
IsCon TyCon
con [SomeTypeRep]
kinds
withTypeable :: forall k (a :: k) rep (r :: TYPE rep). ()
=> TypeRep a -> (Typeable a => r) -> r
withTypeable :: forall k (a :: k) r. TypeRep a -> (Typeable a => r) -> r
withTypeable TypeRep a
rep Typeable a => r
k = forall (cls :: Constraint) meth r.
WithDict cls meth =>
meth -> (cls => r) -> r
withDict @(Typeable a) TypeRep a
rep r
Typeable a => r
k
pattern Con :: forall k (a :: k). ()
=> NotApplication a
=> TyCon -> TypeRep a
pattern $mCon :: forall {r} {k} {a :: k}.
TypeRep a -> (NotApplication a => TyCon -> r) -> ((# #) -> r) -> r
Con con <- (splitApp -> IsCon con _)
pattern Con' :: forall k (a :: k). ()
=> NotApplication a
=> TyCon -> [SomeTypeRep] -> TypeRep a
pattern $mCon' :: forall {r} {k} {a :: k}.
TypeRep a
-> (NotApplication a => TyCon -> [SomeTypeRep] -> r)
-> ((# #) -> r)
-> r
Con' con ks <- (splitApp -> IsCon con ks)
{-# COMPLETE App, Con #-}
{-# COMPLETE App, Con' #-}
someTypeRepTyCon :: SomeTypeRep -> TyCon
someTypeRepTyCon :: SomeTypeRep -> TyCon
someTypeRepTyCon (SomeTypeRep TypeRep a
t) = TypeRep a -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon TypeRep a
t
typeRepTyCon :: TypeRep a -> TyCon
typeRepTyCon :: forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon TypeRep a
TrType = TyCon
tyConTYPE
typeRepTyCon (TrTyCon {trTyCon :: forall k (a :: k). TypeRep a -> TyCon
trTyCon = TyCon
tc}) = TyCon
tc
typeRepTyCon (TrApp {trAppFun :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep a
trAppFun = TypeRep a
a}) = TypeRep a -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon TypeRep a
a
typeRepTyCon (TrFun {}) = TypeRep (->) -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (TypeRep (->) -> TyCon) -> TypeRep (->) -> TyCon
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> * -> *). Typeable a => TypeRep a
typeRep @(->)
eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep a
a TypeRep b
b
| TypeRep a -> TypeRep b -> Bool
forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Bool
sameTypeRep TypeRep a
a TypeRep b
b = (a :~~: b) -> Maybe (a :~~: b)
forall a. a -> Maybe a
Just ((Any :~~: Any) -> a :~~: b
forall a b. a -> b
unsafeCoerce Any :~~: Any
forall {k1} (a :: k1). a :~~: a
HRefl)
| Bool
otherwise = Maybe (a :~~: b)
forall a. Maybe a
Nothing
{-# INLINABLE eqTypeRep #-}
sameTypeRep :: forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Bool
sameTypeRep :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Bool
sameTypeRep TypeRep a
a TypeRep b
b = TypeRep a -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep a
a Fingerprint -> Fingerprint -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep b -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep b
b
typeRepKind :: TypeRep (a :: k) -> TypeRep k
typeRepKind :: forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
TrType = TypeRep k
TypeRep (*)
TrType
typeRepKind (TrTyCon {trTyConKind :: forall k (a :: k). TypeRep a -> TypeRep k
trTyConKind = TypeRep k
kind}) = TypeRep k
kind
typeRepKind (TrApp {trAppKind :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep k2
trAppKind = TypeRep k
kind}) = TypeRep k
kind
typeRepKind (TrFun {}) = forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Type
tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep
tyConKind :: TyCon -> [SomeTypeRep] -> SomeTypeRep
tyConKind (TyCon Word64#
_ Word64#
_ Module
_ TrName
_ Int#
nKindVars# KindRep
kindRep) [SomeTypeRep]
kindVars =
let kindVarsArr :: A.Array KindBndr SomeTypeRep
kindVarsArr :: Array KindBndr SomeTypeRep
kindVarsArr = (KindBndr, KindBndr) -> [SomeTypeRep] -> Array KindBndr SomeTypeRep
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (KindBndr
0, Int# -> KindBndr
I# (Int#
nKindVars# Int# -> Int# -> Int#
-# Int#
1#)) [SomeTypeRep]
kindVars
in Array KindBndr SomeTypeRep -> KindRep -> SomeTypeRep
instantiateKindRep Array KindBndr SomeTypeRep
kindVarsArr KindRep
kindRep
instantiateKindRep :: A.Array KindBndr SomeTypeRep -> KindRep -> SomeTypeRep
instantiateKindRep :: Array KindBndr SomeTypeRep -> KindRep -> SomeTypeRep
instantiateKindRep Array KindBndr SomeTypeRep
vars = KindRep -> SomeTypeRep
go
where
go :: KindRep -> SomeTypeRep
go :: KindRep -> SomeTypeRep
go (KindRepTyConApp TyCon
tc [KindRep]
args)
= let n_kind_args :: KindBndr
n_kind_args = TyCon -> KindBndr
tyConKindArgs TyCon
tc
([KindRep]
kind_args, [KindRep]
ty_args) = KindBndr -> [KindRep] -> ([KindRep], [KindRep])
forall a. KindBndr -> [a] -> ([a], [a])
splitAt KindBndr
n_kind_args [KindRep]
args
tycon_app :: SomeTypeRep
tycon_app = TypeRep Any -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep Any -> SomeTypeRep) -> TypeRep Any -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ TyCon -> [SomeTypeRep] -> TypeRep Any
forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
mkTrCon TyCon
tc ((KindRep -> SomeTypeRep) -> [KindRep] -> [SomeTypeRep]
forall a b. (a -> b) -> [a] -> [b]
map KindRep -> SomeTypeRep
go [KindRep]
kind_args)
applyTy :: SomeTypeRep -> KindRep -> SomeTypeRep
applyTy :: SomeTypeRep -> KindRep -> SomeTypeRep
applyTy (SomeTypeRep TypeRep a
acc) KindRep
ty
| SomeTypeRep TypeRep a
ty' <- KindRep -> SomeTypeRep
go KindRep
ty
= TypeRep (Any a) -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep (Any a) -> SomeTypeRep) -> TypeRep (Any a) -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ TypeRep Any -> TypeRep a -> TypeRep (Any a)
forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp (TypeRep a -> TypeRep Any
forall a b. a -> b
unsafeCoerce TypeRep a
acc) TypeRep a
ty'
in (SomeTypeRep -> KindRep -> SomeTypeRep)
-> SomeTypeRep -> [KindRep] -> SomeTypeRep
forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' SomeTypeRep -> KindRep -> SomeTypeRep
applyTy SomeTypeRep
tycon_app [KindRep]
ty_args
go (KindRepVar KindBndr
var)
= Array KindBndr SomeTypeRep
vars Array KindBndr SomeTypeRep -> KindBndr -> SomeTypeRep
forall i e. Ix i => Array i e -> i -> e
A.! KindBndr
var
go (KindRepApp KindRep
f KindRep
a)
= TypeRep (Any Any) -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep (Any Any) -> SomeTypeRep)
-> TypeRep (Any Any) -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ TypeRep Any -> TypeRep Any -> TypeRep (Any Any)
forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp (SomeTypeRep -> TypeRep Any
forall {k} (a :: k). SomeTypeRep -> TypeRep a
unsafeCoerceRep (SomeTypeRep -> TypeRep Any) -> SomeTypeRep -> TypeRep Any
forall a b. (a -> b) -> a -> b
$ KindRep -> SomeTypeRep
go KindRep
f) (SomeTypeRep -> TypeRep Any
forall {k} (a :: k). SomeTypeRep -> TypeRep a
unsafeCoerceRep (SomeTypeRep -> TypeRep Any) -> SomeTypeRep -> TypeRep Any
forall a b. (a -> b) -> a -> b
$ KindRep -> SomeTypeRep
go KindRep
a)
go (KindRepFun KindRep
a KindRep
b)
= TypeRep (Any -> Any) -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep (Any -> Any) -> SomeTypeRep)
-> TypeRep (Any -> Any) -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ TypeRep 'Many -> TypeRep Any -> TypeRep Any -> TypeRep (Any -> Any)
forall (m :: Multiplicity) a b.
TypeRep m -> TypeRep a -> TypeRep b -> TypeRep (a %m -> b)
mkTrFun TypeRep 'Many
trMany (SomeTypeRep -> TypeRep Any
forall {k} (a :: k). SomeTypeRep -> TypeRep a
unsafeCoerceRep (SomeTypeRep -> TypeRep Any) -> SomeTypeRep -> TypeRep Any
forall a b. (a -> b) -> a -> b
$ KindRep -> SomeTypeRep
go KindRep
a) (SomeTypeRep -> TypeRep Any
forall {k} (a :: k). SomeTypeRep -> TypeRep a
unsafeCoerceRep (SomeTypeRep -> TypeRep Any) -> SomeTypeRep -> TypeRep Any
forall a b. (a -> b) -> a -> b
$ KindRep -> SomeTypeRep
go KindRep
b)
go (KindRepTYPE (BoxedRep Levity
Lifted)) = TypeRep (*) -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep (*)
TrType
go (KindRepTYPE RuntimeRep
r) = SomeKindedTypeRep (*) -> SomeTypeRep
forall k. SomeKindedTypeRep k -> SomeTypeRep
unkindedTypeRep (SomeKindedTypeRep (*) -> SomeTypeRep)
-> SomeKindedTypeRep (*) -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ SomeKindedTypeRep (RuntimeRep -> *)
tYPE SomeKindedTypeRep (RuntimeRep -> *)
-> SomeKindedTypeRep RuntimeRep -> SomeKindedTypeRep (*)
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` RuntimeRep -> SomeKindedTypeRep RuntimeRep
runtimeRepTypeRep RuntimeRep
r
go (KindRepTypeLitS TypeLitSort
sort Addr#
s)
= TypeLitSort -> String -> SomeTypeRep
mkTypeLitFromString TypeLitSort
sort (Addr# -> String
unpackCStringUtf8# Addr#
s)
go (KindRepTypeLitD TypeLitSort
sort String
s)
= TypeLitSort -> String -> SomeTypeRep
mkTypeLitFromString TypeLitSort
sort String
s
tYPE :: SomeKindedTypeRep (RuntimeRep -> *)
tYPE = forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @(RuntimeRep -> Type) @TYPE
unsafeCoerceRep :: SomeTypeRep -> TypeRep a
unsafeCoerceRep :: forall {k} (a :: k). SomeTypeRep -> TypeRep a
unsafeCoerceRep (SomeTypeRep TypeRep a
r) = TypeRep a -> TypeRep a
forall a b. a -> b
unsafeCoerce TypeRep a
r
unkindedTypeRep :: SomeKindedTypeRep k -> SomeTypeRep
unkindedTypeRep :: forall k. SomeKindedTypeRep k -> SomeTypeRep
unkindedTypeRep (SomeKindedTypeRep TypeRep a
x) = TypeRep a -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep a
x
data SomeKindedTypeRep k where
SomeKindedTypeRep :: forall k (a :: k). TypeRep a
%1 -> SomeKindedTypeRep k
kApp :: SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k
-> SomeKindedTypeRep k'
kApp :: forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
kApp (SomeKindedTypeRep TypeRep a
f) (SomeKindedTypeRep TypeRep a
a) =
TypeRep (a a) -> SomeKindedTypeRep k'
forall k (m :: k). TypeRep m -> SomeKindedTypeRep k
SomeKindedTypeRep (TypeRep a -> TypeRep a -> TypeRep (a a)
forall k1 k2 (a :: k1 -> k2) (b :: k1).
TypeRep a -> TypeRep b -> TypeRep (a b)
mkTrApp TypeRep a
f TypeRep a
a)
kindedTypeRep :: forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep :: forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep = TypeRep a -> SomeKindedTypeRep k
forall k (m :: k). TypeRep m -> SomeKindedTypeRep k
SomeKindedTypeRep (forall (a :: k). Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a)
buildList :: forall k. Typeable k
=> [SomeKindedTypeRep k]
-> SomeKindedTypeRep [k]
buildList :: forall k.
Typeable k =>
[SomeKindedTypeRep k] -> SomeKindedTypeRep [k]
buildList = (SomeKindedTypeRep k
-> SomeKindedTypeRep [k] -> SomeKindedTypeRep [k])
-> SomeKindedTypeRep [k]
-> [SomeKindedTypeRep k]
-> SomeKindedTypeRep [k]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr SomeKindedTypeRep k
-> SomeKindedTypeRep [k] -> SomeKindedTypeRep [k]
forall {k}.
Typeable k =>
SomeKindedTypeRep k
-> SomeKindedTypeRep [k] -> SomeKindedTypeRep [k]
cons SomeKindedTypeRep [k]
nil
where
nil :: SomeKindedTypeRep [k]
nil = forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @[k] @'[]
cons :: SomeKindedTypeRep k
-> SomeKindedTypeRep [k] -> SomeKindedTypeRep [k]
cons SomeKindedTypeRep k
x SomeKindedTypeRep [k]
rest = TypeRep (':) -> SomeKindedTypeRep (k -> [k] -> [k])
forall k (m :: k). TypeRep m -> SomeKindedTypeRep k
SomeKindedTypeRep (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: k -> [k] -> [k]). Typeable a => TypeRep a
typeRep @'(:)) SomeKindedTypeRep (k -> [k] -> [k])
-> SomeKindedTypeRep k -> SomeKindedTypeRep ([k] -> [k])
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` SomeKindedTypeRep k
x SomeKindedTypeRep ([k] -> [k])
-> SomeKindedTypeRep [k] -> SomeKindedTypeRep [k]
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` SomeKindedTypeRep [k]
rest
runtimeRepTypeRep :: RuntimeRep -> SomeKindedTypeRep RuntimeRep
runtimeRepTypeRep :: RuntimeRep -> SomeKindedTypeRep RuntimeRep
runtimeRepTypeRep RuntimeRep
r =
case RuntimeRep
r of
BoxedRep Levity
Lifted -> TypeRep LiftedRep -> SomeKindedTypeRep RuntimeRep
forall k (m :: k). TypeRep m -> SomeKindedTypeRep k
SomeKindedTypeRep TypeRep LiftedRep
trLiftedRep
BoxedRep Levity
v -> forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @_ @'BoxedRep
SomeKindedTypeRep (Levity -> RuntimeRep)
-> SomeKindedTypeRep Levity -> SomeKindedTypeRep RuntimeRep
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` Levity -> SomeKindedTypeRep Levity
levityTypeRep Levity
v
VecRep VecCount
c VecElem
e -> forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @_ @'VecRep
SomeKindedTypeRep (VecCount -> VecElem -> RuntimeRep)
-> SomeKindedTypeRep VecCount
-> SomeKindedTypeRep (VecElem -> RuntimeRep)
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` VecCount -> SomeKindedTypeRep VecCount
vecCountTypeRep VecCount
c
SomeKindedTypeRep (VecElem -> RuntimeRep)
-> SomeKindedTypeRep VecElem -> SomeKindedTypeRep RuntimeRep
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` VecElem -> SomeKindedTypeRep VecElem
vecElemTypeRep VecElem
e
TupleRep [RuntimeRep]
rs -> forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @_ @'TupleRep
SomeKindedTypeRep ([RuntimeRep] -> RuntimeRep)
-> SomeKindedTypeRep [RuntimeRep] -> SomeKindedTypeRep RuntimeRep
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` [SomeKindedTypeRep RuntimeRep] -> SomeKindedTypeRep [RuntimeRep]
forall k.
Typeable k =>
[SomeKindedTypeRep k] -> SomeKindedTypeRep [k]
buildList ((RuntimeRep -> SomeKindedTypeRep RuntimeRep)
-> [RuntimeRep] -> [SomeKindedTypeRep RuntimeRep]
forall a b. (a -> b) -> [a] -> [b]
map RuntimeRep -> SomeKindedTypeRep RuntimeRep
runtimeRepTypeRep [RuntimeRep]
rs)
SumRep [RuntimeRep]
rs -> forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @_ @'SumRep
SomeKindedTypeRep ([RuntimeRep] -> RuntimeRep)
-> SomeKindedTypeRep [RuntimeRep] -> SomeKindedTypeRep RuntimeRep
forall k k'.
SomeKindedTypeRep (k -> k')
-> SomeKindedTypeRep k -> SomeKindedTypeRep k'
`kApp` [SomeKindedTypeRep RuntimeRep] -> SomeKindedTypeRep [RuntimeRep]
forall k.
Typeable k =>
[SomeKindedTypeRep k] -> SomeKindedTypeRep [k]
buildList ((RuntimeRep -> SomeKindedTypeRep RuntimeRep)
-> [RuntimeRep] -> [SomeKindedTypeRep RuntimeRep]
forall a b. (a -> b) -> [a] -> [b]
map RuntimeRep -> SomeKindedTypeRep RuntimeRep
runtimeRepTypeRep [RuntimeRep]
rs)
RuntimeRep
IntRep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'IntRep
RuntimeRep
Int8Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Int8Rep
RuntimeRep
Int16Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Int16Rep
RuntimeRep
Int32Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Int32Rep
RuntimeRep
Int64Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Int64Rep
RuntimeRep
WordRep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'WordRep
RuntimeRep
Word8Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Word8Rep
RuntimeRep
Word16Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Word16Rep
RuntimeRep
Word32Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Word32Rep
RuntimeRep
Word64Rep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'Word64Rep
RuntimeRep
AddrRep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'AddrRep
RuntimeRep
FloatRep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'FloatRep
RuntimeRep
DoubleRep -> Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep @'DoubleRep
where
rep :: forall (a :: RuntimeRep). Typeable a => SomeKindedTypeRep RuntimeRep
rep :: Typeable LiftedRep => SomeKindedTypeRep RuntimeRep
rep = forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @RuntimeRep @a
levityTypeRep :: Levity -> SomeKindedTypeRep Levity
levityTypeRep :: Levity -> SomeKindedTypeRep Levity
levityTypeRep Levity
c =
case Levity
c of
Levity
Lifted -> Typeable 'Lifted => SomeKindedTypeRep Levity
rep @'Lifted
Levity
Unlifted -> Typeable 'Lifted => SomeKindedTypeRep Levity
rep @'Unlifted
where
rep :: forall (a :: Levity). Typeable a => SomeKindedTypeRep Levity
rep :: Typeable 'Lifted => SomeKindedTypeRep Levity
rep = forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @Levity @a
vecCountTypeRep :: VecCount -> SomeKindedTypeRep VecCount
vecCountTypeRep :: VecCount -> SomeKindedTypeRep VecCount
vecCountTypeRep VecCount
c =
case VecCount
c of
VecCount
Vec2 -> forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep @'Vec2
VecCount
Vec4 -> forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep @'Vec4
VecCount
Vec8 -> forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep @'Vec8
VecCount
Vec16 -> forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep @'Vec16
VecCount
Vec32 -> forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep @'Vec32
VecCount
Vec64 -> forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep @'Vec64
where
rep :: forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep :: forall (a :: VecCount). Typeable a => SomeKindedTypeRep VecCount
rep = forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @VecCount @a
vecElemTypeRep :: VecElem -> SomeKindedTypeRep VecElem
vecElemTypeRep :: VecElem -> SomeKindedTypeRep VecElem
vecElemTypeRep VecElem
e =
case VecElem
e of
VecElem
Int8ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Int8ElemRep
VecElem
Int16ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Int16ElemRep
VecElem
Int32ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Int32ElemRep
VecElem
Int64ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Int64ElemRep
VecElem
Word8ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Word8ElemRep
VecElem
Word16ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Word16ElemRep
VecElem
Word32ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Word32ElemRep
VecElem
Word64ElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'Word64ElemRep
VecElem
FloatElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'FloatElemRep
VecElem
DoubleElemRep -> forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep @'DoubleElemRep
where
rep :: forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep :: forall (a :: VecElem). Typeable a => SomeKindedTypeRep VecElem
rep = forall k (a :: k). Typeable a => SomeKindedTypeRep k
kindedTypeRep @VecElem @a
bareArrow :: forall (m :: Multiplicity) (r1 :: RuntimeRep) (r2 :: RuntimeRep)
(a :: TYPE r1) (b :: TYPE r2). ()
=> TypeRep (FUN m a b)
-> TypeRep (FUN m :: TYPE r1 -> TYPE r2 -> Type)
bareArrow :: forall (m :: Multiplicity) a b.
TypeRep (a %m -> b) -> TypeRep (FUN m)
bareArrow (TrFun Fingerprint
_ TypeRep m
m TypeRep a
a TypeRep b
b) =
TyCon -> [SomeTypeRep] -> TypeRep (FUN m)
forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
mkTrCon TyCon
funTyCon [TypeRep m -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep m
m, TypeRep r1 -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep r1
rep1, TypeRep r2 -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep r2
rep2]
where
rep1 :: TypeRep r1
rep1 = TypeRep (TYPE r1) -> TypeRep r1
TypeRep (*) -> TypeRep LiftedRep
getRuntimeRep (TypeRep (TYPE r1) -> TypeRep r1)
-> TypeRep (TYPE r1) -> TypeRep r1
forall a b. (a -> b) -> a -> b
$ TypeRep a -> TypeRep (TYPE r1)
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
TypeRep a
a :: TypeRep r1
rep2 :: TypeRep r2
rep2 = TypeRep (TYPE r2) -> TypeRep r2
TypeRep (*) -> TypeRep LiftedRep
getRuntimeRep (TypeRep (TYPE r2) -> TypeRep r2)
-> TypeRep (TYPE r2) -> TypeRep r2
forall a b. (a -> b) -> a -> b
$ TypeRep b -> TypeRep (TYPE r2)
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep b
TypeRep b
b :: TypeRep r2
bareArrow TypeRep (a %m -> b)
_ = String -> TypeRep (FUN m)
forall a. HasCallStack => String -> a
error String
"Data.Typeable.Internal.bareArrow: impossible"
data IsTYPE (a :: Type) where
IsTYPE :: forall (r :: RuntimeRep). TypeRep r %1 -> IsTYPE (TYPE r)
isTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a)
isTYPE :: forall a. TypeRep a -> Maybe (IsTYPE a)
isTYPE TypeRep a
TrType = IsTYPE a -> Maybe (IsTYPE a)
forall a. a -> Maybe a
Just (TypeRep LiftedRep -> IsTYPE (*)
TypeRep LiftedRep -> IsTYPE (*)
IsTYPE TypeRep LiftedRep
trLiftedRep)
isTYPE (TrApp {trAppFun :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep a
trAppFun=TypeRep a
f, trAppArg :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep x
trAppArg=TypeRep b
r})
| Just a :~~: TYPE
HRefl <- TypeRep a
f TypeRep a -> TypeRep TYPE -> Maybe (a :~~: TYPE)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: RuntimeRep -> *). Typeable a => TypeRep a
typeRep @TYPE
= IsTYPE a -> Maybe (IsTYPE a)
forall a. a -> Maybe a
Just (TypeRep b -> IsTYPE (TYPE b)
TypeRep LiftedRep -> IsTYPE (*)
IsTYPE TypeRep b
TypeRep b
r)
isTYPE TypeRep a
_ = Maybe (IsTYPE a)
forall a. Maybe a
Nothing
getRuntimeRep :: forall (r :: RuntimeRep). TypeRep (TYPE r) -> TypeRep r
getRuntimeRep :: TypeRep (*) -> TypeRep LiftedRep
getRuntimeRep TypeRep (TYPE r)
TrType = TypeRep r
TypeRep LiftedRep
trLiftedRep
getRuntimeRep (TrApp {trAppArg :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep x
trAppArg=TypeRep b
r}) = TypeRep b
TypeRep r
r
getRuntimeRep TypeRep (TYPE r)
_ = String -> TypeRep r
forall a. HasCallStack => String -> a
error String
"Data.Typeable.Internal.getRuntimeRep: impossible"
class Typeable (a :: k) where
typeRep# :: TypeRep a
typeRep :: Typeable a => TypeRep a
typeRep :: forall {k} (a :: k). Typeable a => TypeRep a
typeRep = TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep#
typeOf :: Typeable a => a -> TypeRep a
typeOf :: forall a. Typeable a => a -> TypeRep a
typeOf a
_ = TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep
someTypeRep :: forall proxy a. Typeable a => proxy a -> SomeTypeRep
someTypeRep :: forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep proxy a
_ = TypeRep a -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep a)
{-# INLINE typeRep #-}
someTypeRepFingerprint :: SomeTypeRep -> Fingerprint
someTypeRepFingerprint :: SomeTypeRep -> Fingerprint
someTypeRepFingerprint (SomeTypeRep TypeRep a
t) = TypeRep a -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep a
t
instance Show (TypeRep (a :: k)) where
showsPrec :: KindBndr -> TypeRep a -> String -> String
showsPrec = KindBndr -> TypeRep a -> String -> String
forall k (a :: k). KindBndr -> TypeRep a -> String -> String
showTypeable
showTypeable :: Int -> TypeRep (a :: k) -> ShowS
showTypeable :: forall k (a :: k). KindBndr -> TypeRep a -> String -> String
showTypeable KindBndr
_ TypeRep a
TrType = Char -> String -> String
showChar Char
'*'
showTypeable KindBndr
_ TypeRep a
rep
| TyCon -> Bool
isListTyCon TyCon
tc, [SomeTypeRep
ty] <- [SomeTypeRep]
tys =
Char -> String -> String
showChar Char
'[' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeTypeRep -> String -> String
forall a. Show a => a -> String -> String
shows SomeTypeRep
ty (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
']'
| TyCon -> Bool
isTupleTyCon TyCon
tc,
Just * :~~: k
_ <- TypeRep (*)
TrType TypeRep (*) -> TypeRep k -> Maybe (* :~~: k)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
`eqTypeRep` TypeRep a -> TypeRep k
forall k (a :: k). TypeRep a -> TypeRep k
typeRepKind TypeRep a
rep =
Char -> String -> String
showChar Char
'(' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [SomeTypeRep] -> String -> String
forall a. Show a => (String -> String) -> [a] -> String -> String
showArgs (Char -> String -> String
showChar Char
',') [SomeTypeRep]
tys (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
')'
where (TyCon
tc, [SomeTypeRep]
tys) = TypeRep a -> (TyCon, [SomeTypeRep])
forall {k} (a :: k). TypeRep a -> (TyCon, [SomeTypeRep])
splitApps TypeRep a
rep
showTypeable KindBndr
_ (TrTyCon {trTyCon :: forall k (a :: k). TypeRep a -> TyCon
trTyCon = TyCon
tycon, trKindVars :: forall k (a :: k). TypeRep a -> [SomeTypeRep]
trKindVars = []})
= TyCon -> String -> String
showTyCon TyCon
tycon
showTypeable KindBndr
p (TrTyCon {trTyCon :: forall k (a :: k). TypeRep a -> TyCon
trTyCon = TyCon
tycon, trKindVars :: forall k (a :: k). TypeRep a -> [SomeTypeRep]
trKindVars = [SomeTypeRep]
args})
= Bool -> (String -> String) -> String -> String
showParen (KindBndr
p KindBndr -> KindBndr -> Bool
forall a. Ord a => a -> a -> Bool
> KindBndr
9) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
TyCon -> String -> String
showTyCon TyCon
tycon (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> String -> String
showChar Char
' ' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String -> String) -> [SomeTypeRep] -> String -> String
forall a. Show a => (String -> String) -> [a] -> String -> String
showArgs (Char -> String -> String
showChar Char
' ') [SomeTypeRep]
args
showTypeable KindBndr
p (TrFun {trFunArg :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep LiftedRep
trFunArg = TypeRep a
x, trFunRes :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep b
trFunRes = TypeRep b
r})
= Bool -> (String -> String) -> String -> String
showParen (KindBndr
p KindBndr -> KindBndr -> Bool
forall a. Ord a => a -> a -> Bool
> KindBndr
8) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
KindBndr -> TypeRep a -> String -> String
forall a. Show a => KindBndr -> a -> String -> String
showsPrec KindBndr
9 TypeRep a
x (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" -> " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindBndr -> TypeRep b -> String -> String
forall a. Show a => KindBndr -> a -> String -> String
showsPrec KindBndr
8 TypeRep b
r
showTypeable KindBndr
p (TrApp {trAppFun :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep a
trAppFun = TypeRep a
f, trAppArg :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep x
trAppArg = TypeRep b
x})
= Bool -> (String -> String) -> String -> String
showParen (KindBndr
p KindBndr -> KindBndr -> Bool
forall a. Ord a => a -> a -> Bool
> KindBndr
9) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
KindBndr -> TypeRep a -> String -> String
forall a. Show a => KindBndr -> a -> String -> String
showsPrec KindBndr
8 TypeRep a
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Char -> String -> String
showChar Char
' ' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
KindBndr -> TypeRep b -> String -> String
forall a. Show a => KindBndr -> a -> String -> String
showsPrec KindBndr
10 TypeRep b
x
instance Show SomeTypeRep where
showsPrec :: KindBndr -> SomeTypeRep -> String -> String
showsPrec KindBndr
p (SomeTypeRep TypeRep a
ty) = KindBndr -> TypeRep a -> String -> String
forall a. Show a => KindBndr -> a -> String -> String
showsPrec KindBndr
p TypeRep a
ty
splitApps :: TypeRep a -> (TyCon, [SomeTypeRep])
splitApps :: forall {k} (a :: k). TypeRep a -> (TyCon, [SomeTypeRep])
splitApps = [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])
forall {k} (a :: k).
[SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])
go []
where
go :: [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])
go :: forall {k} (a :: k).
[SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])
go [SomeTypeRep]
xs (TrTyCon {trTyCon :: forall k (a :: k). TypeRep a -> TyCon
trTyCon = TyCon
tc})
= (TyCon
tc, [SomeTypeRep]
xs)
go [SomeTypeRep]
xs (TrApp {trAppFun :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep a
trAppFun = TypeRep a
f, trAppArg :: forall m k2 (a :: m -> k2) (x :: m). TypeRep (a x) -> TypeRep x
trAppArg = TypeRep b
x})
= [SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])
forall {k} (a :: k).
[SomeTypeRep] -> TypeRep a -> (TyCon, [SomeTypeRep])
go (TypeRep b -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep b
x SomeTypeRep -> [SomeTypeRep] -> [SomeTypeRep]
forall a. a -> [a] -> [a]
: [SomeTypeRep]
xs) TypeRep a
f
go [] (TrFun {trFunArg :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep LiftedRep
trFunArg = TypeRep a
a, trFunRes :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep b
trFunRes = TypeRep b
b, trFunMul :: forall (m :: Multiplicity) a b.
TypeRep (LiftedRep %m -> b) -> TypeRep m
trFunMul = TypeRep m
mul})
| Just 'Many :~~: m
HRefl <- TypeRep 'Many -> TypeRep m -> Maybe ('Many :~~: m)
forall k1 k2 (a :: k1) (b :: k2).
TypeRep a -> TypeRep b -> Maybe (a :~~: b)
eqTypeRep TypeRep 'Many
trMany TypeRep m
mul = (TyCon
funTyCon, [TypeRep a -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep a
a, TypeRep b -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep b
b])
| Bool
otherwise = String -> (TyCon, [SomeTypeRep])
forall a. String -> a
errorWithoutStackTrace String
"Data.Typeable.Internal.splitApps: Only unrestricted functions are supported"
go [SomeTypeRep]
_ (TrFun {})
= String -> (TyCon, [SomeTypeRep])
forall a. String -> a
errorWithoutStackTrace String
"Data.Typeable.Internal.splitApps: Impossible 1"
go [] TypeRep a
TrType = (TyCon
tyConTYPE, [TypeRep LiftedRep -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep TypeRep LiftedRep
trLiftedRep])
go [SomeTypeRep]
_ TypeRep a
TrType
= String -> (TyCon, [SomeTypeRep])
forall a. String -> a
errorWithoutStackTrace String
"Data.Typeable.Internal.splitApps: Impossible 2"
tyConRuntimeRep :: TyCon
tyConRuntimeRep :: TyCon
tyConRuntimeRep = String -> String -> String -> KindBndr -> KindRep -> TyCon
mkTyCon String
ghcPrimPackage String
"GHC.Types" String
"RuntimeRep" KindBndr
0
(RuntimeRep -> KindRep
KindRepTYPE (Levity -> RuntimeRep
BoxedRep Levity
Lifted))
tyConTYPE :: TyCon
tyConTYPE :: TyCon
tyConTYPE = String -> String -> String -> KindBndr -> KindRep -> TyCon
mkTyCon String
ghcPrimPackage String
"GHC.Prim" String
"TYPE" KindBndr
0
(KindRep -> KindRep -> KindRep
KindRepFun
(TyCon -> [KindRep] -> KindRep
KindRepTyConApp TyCon
tyConRuntimeRep [])
(RuntimeRep -> KindRep
KindRepTYPE (Levity -> RuntimeRep
BoxedRep Levity
Lifted))
)
tyConLevity :: TyCon
tyConLevity :: TyCon
tyConLevity = String -> String -> String -> KindBndr -> KindRep -> TyCon
mkTyCon String
ghcPrimPackage String
"GHC.Types" String
"Levity" KindBndr
0
(RuntimeRep -> KindRep
KindRepTYPE (Levity -> RuntimeRep
BoxedRep Levity
Lifted))
tyCon'Lifted :: TyCon
tyCon'Lifted :: TyCon
tyCon'Lifted = String -> String -> String -> KindBndr -> KindRep -> TyCon
mkTyCon String
ghcPrimPackage String
"GHC.Types" String
"'Lifted" KindBndr
0
(TyCon -> [KindRep] -> KindRep
KindRepTyConApp TyCon
tyConLevity [])
tyCon'BoxedRep :: TyCon
tyCon'BoxedRep :: TyCon
tyCon'BoxedRep = String -> String -> String -> KindBndr -> KindRep -> TyCon
mkTyCon String
ghcPrimPackage String
"GHC.Types" String
"'BoxedRep" KindBndr
0
(KindRep -> KindRep -> KindRep
KindRepFun (TyCon -> [KindRep] -> KindRep
KindRepTyConApp TyCon
tyConLevity []) (TyCon -> [KindRep] -> KindRep
KindRepTyConApp TyCon
tyConRuntimeRep []))
ghcPrimPackage :: String
ghcPrimPackage :: String
ghcPrimPackage = TyCon -> String
tyConPackage (TypeRep Bool -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Bool))
funTyCon :: TyCon
funTyCon :: TyCon
funTyCon = TypeRep (->) -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: * -> * -> *). Typeable a => TypeRep a
typeRep @(->))
isListTyCon :: TyCon -> Bool
isListTyCon :: TyCon -> Bool
isListTyCon TyCon
tc = TyCon
tc TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep [] -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (TypeRep []
forall {k} (a :: k). Typeable a => TypeRep a
typeRep :: TypeRep [])
isTupleTyCon :: TyCon -> Bool
isTupleTyCon :: TyCon -> Bool
isTupleTyCon TyCon
tc
| (Char
'(':Char
',':String
_) <- TyCon -> String
tyConName TyCon
tc = Bool
True
| Bool
otherwise = Bool
False
isOperatorTyCon :: TyCon -> Bool
isOperatorTyCon :: TyCon -> Bool
isOperatorTyCon TyCon
tc
| Char
symb : String
_ <- TyCon -> String
tyConName TyCon
tc
, Char
symb Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` String
"!#$%&*+./<=>?@\\^|-~:" = Bool
True
| Bool
otherwise = Bool
False
showTyCon :: TyCon -> ShowS
showTyCon :: TyCon -> String -> String
showTyCon TyCon
tycon = Bool -> (String -> String) -> String -> String
showParen (TyCon -> Bool
isOperatorTyCon TyCon
tycon) (TyCon -> String -> String
forall a. Show a => a -> String -> String
shows TyCon
tycon)
showArgs :: Show a => ShowS -> [a] -> ShowS
showArgs :: forall a. Show a => (String -> String) -> [a] -> String -> String
showArgs String -> String
_ [] = String -> String
forall a. a -> a
id
showArgs String -> String
_ [a
a] = KindBndr -> a -> String -> String
forall a. Show a => KindBndr -> a -> String -> String
showsPrec KindBndr
10 a
a
showArgs String -> String
sep (a
a:[a]
as) = KindBndr -> a -> String -> String
forall a. Show a => KindBndr -> a -> String -> String
showsPrec KindBndr
10 a
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
sep (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [a] -> String -> String
forall a. Show a => (String -> String) -> [a] -> String -> String
showArgs String -> String
sep [a]
as
rnfTypeRep :: TypeRep a -> ()
rnfTypeRep :: forall {k} (a :: k). TypeRep a -> ()
rnfTypeRep !TypeRep a
_ = ()
rnfSomeTypeRep :: SomeTypeRep -> ()
rnfSomeTypeRep :: SomeTypeRep -> ()
rnfSomeTypeRep (SomeTypeRep TypeRep a
r) = TypeRep a -> ()
forall {k} (a :: k). TypeRep a -> ()
rnfTypeRep TypeRep a
r
pattern KindRepTypeLit :: TypeLitSort -> String -> KindRep
pattern $mKindRepTypeLit :: forall {r}.
KindRep -> (TypeLitSort -> String -> r) -> ((# #) -> r) -> r
$bKindRepTypeLit :: TypeLitSort -> String -> KindRep
KindRepTypeLit sort t <- (getKindRepTypeLit -> Just (sort, t))
where
KindRepTypeLit TypeLitSort
sort String
t = TypeLitSort -> String -> KindRep
KindRepTypeLitD TypeLitSort
sort String
t
{-# COMPLETE KindRepTyConApp, KindRepVar, KindRepApp, KindRepFun,
KindRepTYPE, KindRepTypeLit #-}
getKindRepTypeLit :: KindRep -> Maybe (TypeLitSort, String)
getKindRepTypeLit :: KindRep -> Maybe (TypeLitSort, String)
getKindRepTypeLit (KindRepTypeLitS TypeLitSort
sort Addr#
t) = (TypeLitSort, String) -> Maybe (TypeLitSort, String)
forall a. a -> Maybe a
Just (TypeLitSort
sort, Addr# -> String
unpackCStringUtf8# Addr#
t)
getKindRepTypeLit (KindRepTypeLitD TypeLitSort
sort String
t) = (TypeLitSort, String) -> Maybe (TypeLitSort, String)
forall a. a -> Maybe a
Just (TypeLitSort
sort, String
t)
getKindRepTypeLit KindRep
_ = Maybe (TypeLitSort, String)
forall a. Maybe a
Nothing
mkTyCon# :: Addr#
-> Addr#
-> Addr#
-> Int#
-> KindRep
-> TyCon
mkTyCon# :: Addr# -> Addr# -> Addr# -> Int# -> KindRep -> TyCon
mkTyCon# Addr#
pkg Addr#
modl Addr#
name Int#
n_kinds KindRep
kind_rep
| Fingerprint (W64# Word64#
hi) (W64# Word64#
lo) <- Fingerprint
fingerprint
= Word64# -> Word64# -> Module -> TrName -> Int# -> KindRep -> TyCon
TyCon Word64#
hi Word64#
lo Module
mod (Addr# -> TrName
TrNameS Addr#
name) Int#
n_kinds KindRep
kind_rep
where
mod :: Module
mod = TrName -> TrName -> Module
Module (Addr# -> TrName
TrNameS Addr#
pkg) (Addr# -> TrName
TrNameS Addr#
modl)
fingerprint :: Fingerprint
fingerprint :: Fingerprint
fingerprint = String -> String -> String -> Fingerprint
mkTyConFingerprint (Addr# -> String
unpackCStringUtf8# Addr#
pkg)
(Addr# -> String
unpackCStringUtf8# Addr#
modl)
(Addr# -> String
unpackCStringUtf8# Addr#
name)
mkTyCon :: String
-> String
-> String
-> Int
-> KindRep
-> TyCon
mkTyCon :: String -> String -> String -> KindBndr -> KindRep -> TyCon
mkTyCon String
pkg String
modl String
name (I# Int#
n_kinds) KindRep
kind_rep
| Fingerprint (W64# Word64#
hi) (W64# Word64#
lo) <- Fingerprint
fingerprint
= Word64# -> Word64# -> Module -> TrName -> Int# -> KindRep -> TyCon
TyCon Word64#
hi Word64#
lo Module
mod (String -> TrName
TrNameD String
name) Int#
n_kinds KindRep
kind_rep
where
mod :: Module
mod = TrName -> TrName -> Module
Module (String -> TrName
TrNameD String
pkg) (String -> TrName
TrNameD String
modl)
fingerprint :: Fingerprint
fingerprint :: Fingerprint
fingerprint = String -> String -> String -> Fingerprint
mkTyConFingerprint String
pkg String
modl String
name
mkTyConFingerprint :: String
-> String
-> String
-> Fingerprint
mkTyConFingerprint :: String -> String -> String -> Fingerprint
mkTyConFingerprint String
pkg_name String
mod_name String
tycon_name =
[Fingerprint] -> Fingerprint
fingerprintFingerprints
[ String -> Fingerprint
fingerprintString String
pkg_name
, String -> Fingerprint
fingerprintString String
mod_name
, String -> Fingerprint
fingerprintString String
tycon_name
]
mkTypeLitTyCon :: String -> TyCon -> TyCon
mkTypeLitTyCon :: String -> TyCon -> TyCon
mkTypeLitTyCon String
name TyCon
kind_tycon
= String -> String -> String -> KindBndr -> KindRep -> TyCon
mkTyCon String
"base" String
"GHC.TypeLits" String
name KindBndr
0 KindRep
kind
where kind :: KindRep
kind = TyCon -> [KindRep] -> KindRep
KindRepTyConApp TyCon
kind_tycon []
typeNatTypeRep :: forall a. KnownNat a => TypeRep a
typeNatTypeRep :: forall (a :: Nat). KnownNat a => TypeRep a
typeNatTypeRep = String -> TyCon -> TypeRep a
forall k (a :: k). Typeable k => String -> TyCon -> TypeRep a
typeLitTypeRep (Nat -> String
forall a. Show a => a -> String
show (Proxy# a -> Nat
forall (n :: Nat). KnownNat n => Proxy# n -> Nat
natVal' (forall (a :: Nat). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @a))) TyCon
tcNat
typeSymbolTypeRep :: forall a. KnownSymbol a => TypeRep a
typeSymbolTypeRep :: forall (a :: Symbol). KnownSymbol a => TypeRep a
typeSymbolTypeRep = String -> TyCon -> TypeRep a
forall k (a :: k). Typeable k => String -> TyCon -> TypeRep a
typeLitTypeRep (String -> String
forall a. Show a => a -> String
show (Proxy# a -> String
forall (n :: Symbol). KnownSymbol n => Proxy# n -> String
symbolVal' (forall {k} (a :: k). Proxy# a
forall (a :: Symbol). Proxy# a
proxy# @a))) TyCon
tcSymbol
typeCharTypeRep :: forall a. KnownChar a => TypeRep a
typeCharTypeRep :: forall (a :: Char). KnownChar a => TypeRep a
typeCharTypeRep = String -> TyCon -> TypeRep a
forall k (a :: k). Typeable k => String -> TyCon -> TypeRep a
typeLitTypeRep (Char -> String
forall a. Show a => a -> String
show (Proxy# a -> Char
forall (n :: Char). KnownChar n => Proxy# n -> Char
charVal' (forall (a :: Char). Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @a))) TyCon
tcChar
mkTypeLitFromString :: TypeLitSort -> String -> SomeTypeRep
mkTypeLitFromString :: TypeLitSort -> String -> SomeTypeRep
mkTypeLitFromString TypeLitSort
TypeLitSymbol String
s =
TypeRep Symbol -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep Symbol -> SomeTypeRep) -> TypeRep Symbol -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ (String -> TyCon -> TypeRep Symbol
forall k (a :: k). Typeable k => String -> TyCon -> TypeRep a
typeLitTypeRep String
s TyCon
tcSymbol :: TypeRep Symbol)
mkTypeLitFromString TypeLitSort
TypeLitNat String
s =
TypeRep Nat -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep Nat -> SomeTypeRep) -> TypeRep Nat -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ (String -> TyCon -> TypeRep Nat
forall k (a :: k). Typeable k => String -> TyCon -> TypeRep a
typeLitTypeRep String
s TyCon
tcNat :: TypeRep Nat)
mkTypeLitFromString TypeLitSort
TypeLitChar String
s =
TypeRep Char -> SomeTypeRep
forall m (a :: m). TypeRep a -> SomeTypeRep
SomeTypeRep (TypeRep Char -> SomeTypeRep) -> TypeRep Char -> SomeTypeRep
forall a b. (a -> b) -> a -> b
$ (String -> TyCon -> TypeRep Char
forall k (a :: k). Typeable k => String -> TyCon -> TypeRep a
typeLitTypeRep String
s TyCon
tcChar :: TypeRep Char)
tcSymbol :: TyCon
tcSymbol :: TyCon
tcSymbol = TypeRep Symbol -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Symbol)
tcNat :: TyCon
tcNat :: TyCon
tcNat = TypeRep Nat -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Nat)
tcChar :: TyCon
tcChar :: TyCon
tcChar = TypeRep Char -> TyCon
forall k (a :: k). TypeRep a -> TyCon
typeRepTyCon (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Char)
typeLitTypeRep :: forall k (a :: k). (Typeable k) =>
String -> TyCon -> TypeRep a
typeLitTypeRep :: forall k (a :: k). Typeable k => String -> TyCon -> TypeRep a
typeLitTypeRep String
nm TyCon
kind_tycon = TyCon -> [SomeTypeRep] -> TypeRep a
forall k (a :: k). TyCon -> [SomeTypeRep] -> TypeRep a
mkTrCon (String -> TyCon -> TyCon
mkTypeLitTyCon String
nm TyCon
kind_tycon) []
mkTrFun :: forall (m :: Multiplicity) (r1 :: RuntimeRep) (r2 :: RuntimeRep)
(a :: TYPE r1) (b :: TYPE r2).
TypeRep m -> TypeRep a -> TypeRep b -> TypeRep ((FUN m a b) :: Type)
mkTrFun :: forall (m :: Multiplicity) a b.
TypeRep m -> TypeRep a -> TypeRep b -> TypeRep (a %m -> b)
mkTrFun TypeRep m
mul TypeRep a
arg TypeRep b
res = TrFun
{ trFunFingerprint :: Fingerprint
trFunFingerprint = Fingerprint
fpr
, trFunMul :: TypeRep m
trFunMul = TypeRep m
mul
, trFunArg :: TypeRep a
trFunArg = TypeRep a
arg
, trFunRes :: TypeRep b
trFunRes = TypeRep b
res }
where fpr :: Fingerprint
fpr = [Fingerprint] -> Fingerprint
fingerprintFingerprints [ TypeRep m -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep m
mul
, TypeRep a -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep a
arg
, TypeRep b -> Fingerprint
forall k (a :: k). TypeRep a -> Fingerprint
typeRepFingerprint TypeRep b
res]