Movatterモバイル変換

{-# 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 StandaloneDeriving #-}{-# LANGUAGE UndecidableInstances #-}{-# LANGUAGE TypeApplications #-}{-# LANGUAGE TypeFamilies #-}------------------------------------------------------------------------------- |-- Module      :  Data.Typeable.Internal-- Copyright   :  (c) The University of Glasgow, CWI 2001--2011-- License     :  BSD-style (see the file libraries/base/LICENSE)---- The representations of the types TyCon and TypeRep, and the-- function mkTyCon which is used by derived instances of Typeable to-- construct a TyCon.-------------------------------------------------------------------------------moduleData.Typeable.Internal(-- * Typeable and kind polymorphism---- #kind_instantiation-- * MiscellaneousFingerprint(..),-- * Typeable classTypeable(..),withTypeable,-- * ModuleModule,-- AbstractmoduleName,modulePackage,rnfModule,-- * TyConTyCon,-- AbstracttyConPackage,tyConModule,tyConName,tyConKindArgs,tyConKindRep,tyConFingerprint,KindRep(..,KindRepTypeLit),TypeLitSort(..),rnfTyCon,-- * TypeRepTypeRep,patternApp,patternCon,patternCon',patternFun,typeRep,typeOf,typeRepTyCon,typeRepFingerprint,rnfTypeRep,eqTypeRep,typeRepKind,splitApps,-- * SomeTypeRepSomeTypeRep(..),someTypeRep,someTypeRepTyCon,someTypeRepFingerprint,rnfSomeTypeRep,-- * Construction-- | These are for internal use onlymkTrType,mkTrCon,mkTrApp,mkTrAppChecked,mkTrFun,mkTyCon,mkTyCon#,typeSymbolTypeRep,typeNatTypeRep,)whereimportGHC.BaseimportqualifiedGHC.ArrasAimportGHC.Types(TYPE)importData.Type.EqualityimportGHC.List(splitAt,foldl',elem)importGHC.WordimportGHC.ShowimportGHC.TypeLits(KnownSymbol,symbolVal',AppendSymbol)importGHC.TypeNats(KnownNat,natVal')importUnsafe.Coerce(unsafeCoerce)importGHC.Fingerprint.Typeimport{-# SOURCE#-}GHC.Fingerprint-- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable-- 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"{- **********************************************************************                                                                      *                The TyCon type*                                                                      ********************************************************************** -}modulePackage::Module->StringmodulePackage(Modulep_)=trNameStringpmoduleName::Module->StringmoduleName(Module_m)=trNameStringmtyConPackage::TyCon->StringtyConPackage(TyCon__m___)=modulePackagemtyConModule::TyCon->StringtyConModule(TyCon__m___)=moduleNamemtyConName::TyCon->StringtyConName(TyCon___n__)=trNameStringntrNameString::TrName->StringtrNameString(TrNameSs)=unpackCStringUtf8#strNameString(TrNameDs)=styConFingerprint::TyCon->FingerprinttyConFingerprint(TyConhilo____)=Fingerprint(W64#hi)(W64#lo)tyConKindArgs::TyCon->InttyConKindArgs(TyCon____n_)=I#ntyConKindRep::TyCon->KindReptyConKindRep(TyCon_____k)=k-- | Helper to fully evaluate 'TyCon' for use as @NFData(rnf)@ implementation---- @since 4.8.0.0rnfModule::Module->()rnfModule(Modulepm)=rnfTrNamep`seq`rnfTrNamemrnfTrName::TrName->()rnfTrName(TrNameS_)=()rnfTrName(TrNameDn)=rnfStringnrnfKindRep::KindRep->()rnfKindRep(KindRepTyConApptcargs)=rnfTyContc`seq`rnfListrnfKindRepargsrnfKindRep(KindRepVar_)=()rnfKindRep(KindRepAppab)=rnfKindRepa`seq`rnfKindRepbrnfKindRep(KindRepFunab)=rnfKindRepa`seq`rnfKindRepbrnfKindRep(KindRepTYPErr)=rnfRuntimeReprrrnfKindRep(KindRepTypeLitS__)=()rnfKindRep(KindRepTypeLitD_t)=rnfStringtrnfRuntimeRep::RuntimeRep->()rnfRuntimeRep(VecRep!_!_)=()rnfRuntimeRep!_=()rnfList::(a->())->[a]->()rnfList_[]=()rnfListforce(x:xs)=forcex`seq`rnfListforcexsrnfString::[Char]->()rnfString=rnfList(`seq`())rnfTyCon::TyCon->()rnfTyCon(TyCon__mn_k)=rnfModulem`seq`rnfTrNamen`seq`rnfKindRepk{- **********************************************************************                                                                      *                The TypeRep type*                                                                      ********************************************************************** -}-- | A concrete representation of a (monomorphic) type.-- 'TypeRep' supports reasonably efficient equality.dataTypeRep(a::k)where-- The TypeRep of Type. See Note [Kind caching], Wrinkle 2TrType::TypeRepTypeTrTyCon::{-- See Note [TypeRep fingerprints]trTyConFingerprint::{-# UNPACK#-}!Fingerprint-- The TypeRep represents the application of trTyCon-- to the kind arguments trKindVars. So for-- 'Just :: Bool -> Maybe Bool, the trTyCon will be-- 'Just and the trKindVars will be [Bool].,trTyCon::!TyCon,trKindVars::[SomeTypeRep],trTyConKind::!(TypeRepk)}-- See Note [Kind caching]->TypeRep(a::k)-- | Invariant: Saturated arrow types (e.g. things of the form @a -> b@)-- are represented with @'TrFun' a b@, not @TrApp (TrApp funTyCon a) b@.TrApp::forallk1k2(a::k1->k2)(b::k1).{-- See Note [TypeRep fingerprints]trAppFingerprint::{-# UNPACK#-}!Fingerprint-- 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)),trAppKind::!(TypeRepk2)}-- See Note [Kind caching]->TypeRep(ab)-- | @TrFun fpr a b@ represents a function type @a -> b@. We use this for-- the sake of efficiency as functions are quite ubiquitous.TrFun::forall(r1::RuntimeRep)(r2::RuntimeRep)(a::TYPEr1)(b::TYPEr2).{-- See Note [TypeRep fingerprints]trFunFingerprint::{-# UNPACK#-}!Fingerprint-- The TypeRep represents a function from trFunArg to-- trFunRes.,trFunArg::!(TypeRepa),trFunRes::!(TypeRepb)}->TypeRep(a->b){- Note [TypeRep fingerprints]   ~~~~~~~~~~~~~~~~~~~~~~~~~~~We store a Fingerprint of each TypeRep in its constructor. This allowsus to test whether two TypeReps are equal in constant time, rather thanhaving 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, indeserialization 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 endsup 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 witha large amount of extra allocation deserializing very deep nests.See #14337.It is quite possible to speed up deserialization by structuring that processvery carefully. Unfortunately, that doesn't help dynApply or anything elsethat may use typeRepKind. Since caching the kind isn't terribly expensive, itseems 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, ratherthan being stored as a thunk that will strip the (j ->) off of j -> k ifand when it is forced.Wrinkle 2:We need to be able to represent TypeRep Type. This is a bit tricky becausetypeRepKind (typeRep @Type) = typeRep @Type, so if we actually cache thetyperep of the kind of Type, we will have a loop. One simple way to do thisis 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 TrTyperepresents an application.-}-- Compare keys for equality-- | @since 2.01instanceEq(TypeRepa)where_==_=True{-# INLINABLE(==)#-}instanceTestEqualityTypeRepwherea`testEquality`b|JustHRefl<-eqTypeRepab=JustRefl|otherwise=Nothing{-# INLINEABLEtestEquality#-}-- | @since 4.4.0.0instanceOrd(TypeRepa)wherecompare__=EQ{-# INLINABLEcompare#-}-- | A non-indexed type representation.dataSomeTypeRepwhereSomeTypeRep::forallk(a::k).!(TypeRepa)->SomeTypeRepinstanceEqSomeTypeRepwhereSomeTypeRepa==SomeTypeRepb=casea`eqTypeRep`bofJust_->TrueNothing->FalseinstanceOrdSomeTypeRepwhereSomeTypeRepa`compare`SomeTypeRepb=typeRepFingerprinta`compare`typeRepFingerprintb-- | The function type constructor.---- For instance,---- @-- typeRep \@(Int -> Char) === Fun (typeRep \@Int) (typeRep \@Char)-- @--patternFun::forallk(fun::k).()=>forall(r1::RuntimeRep)(r2::RuntimeRep)(arg::TYPEr1)(res::TYPEr2).(k~Type,fun~~(arg->res))=>TypeReparg->TypeRepres->TypeRepfunpatternFunargres<-TrFun{trFunArg=arg,trFunRes=res}whereFunargres=mkTrFunargres-- | Observe the 'Fingerprint' of a type representation---- @since 4.8.0.0typeRepFingerprint::TypeRepa->FingerprinttypeRepFingerprintTrType=fpTYPELiftedReptypeRepFingerprint(TrTyCon{trTyConFingerprint=fpr})=fprtypeRepFingerprint(TrApp{trAppFingerprint=fpr})=fprtypeRepFingerprint(TrFun{trFunFingerprint=fpr})=fpr-- For compiler usemkTrType::TypeRepTypemkTrType=TrType-- | Construct a representation for a type constructor-- applied at a monomorphic kind.---- Note that this is unsafe as it allows you to construct-- ill-kinded types.mkTrCon::forallk(a::k).TyCon->[SomeTypeRep]->TypeRepamkTrContckind_vars=TrTyCon{trTyConFingerprint=fpr,trTyCon=tc,trKindVars=kind_vars,trTyConKind=kind}wherefpr_tc=tyConFingerprinttcfpr_kvs=mapsomeTypeRepFingerprintkind_varsfpr=fingerprintFingerprints(fpr_tc:fpr_kvs)kind=unsafeCoerceRep$tyConKindtckind_vars-- The fingerprint of Type. We don't store this in the TrType-- constructor, so we need to build it here.fpTYPELiftedRep::FingerprintfpTYPELiftedRep=fingerprintFingerprints[tyConFingerprinttyConTYPE,typeRepFingerprinttrLiftedRep]-- There is absolutely nothing to gain and everything to lose-- by inlining the worker. The wrapper should inline anyway.{-# NOINLINEfpTYPELiftedRep#-}trTYPE::TypeRepTYPEtrTYPE=typeReptrLiftedRep::TypeRep'LiftedReptrLiftedRep=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.mkTrApp::forallk1k2(a::k1->k2)(b::k1).TypeRep(a::k1->k2)->TypeRep(b::k1)->TypeRep(ab)mkTrAppab-- See Note [Kind caching], Wrinkle 2|JustHRefl<-a`eqTypeRep`trTYPE,JustHRefl<-b`eqTypeRep`trLiftedRep=TrType|TrFun{trFunRes=res_kind}<-typeRepKinda=TrApp{trAppFingerprint=fpr,trAppFun=a,trAppArg=b,trAppKind=res_kind}|otherwise=error("Ill-kinded type application: "++show(typeRepKinda))wherefpr_a=typeRepFingerprintafpr_b=typeRepFingerprintbfpr=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.UnsafemkTrAppChecked::forallk1k2(a::k1->k2)(b::k1).TypeRep(a::k1->k2)->TypeRep(b::k1)->TypeRep(ab)mkTrAppCheckedrep@(TrApp{trAppFun=p,trAppArg=x::TypeRepx})(y::TypeRepy)|TrTyCon{trTyCon=con}<-p,con==funTyCon-- cheap check first,Just(IsTYPE(rx::TypeReprx))<-isTYPE(typeRepKindx),Just(IsTYPE(ry::TypeRepry))<-isTYPE(typeRepKindy),JustHRefl<-withTypeablex$withTypeablerx$withTypeablery$typeRep@((->)x::TYPEry->Type)`eqTypeRep`rep=mkTrFunxymkTrAppCheckedab=mkTrAppab-- | A type application.---- For instance,---- @-- typeRep \@(Maybe Int) === App (typeRep \@Maybe) (typeRep \@Int)-- @---- Note that this will also match a function type,---- @-- typeRep \@(Int# -> Char)--   ===-- App (App arrow (typeRep \@Int#)) (typeRep \@Char)-- @---- where @arrow :: TypeRep ((->) :: TYPE IntRep -> Type -> Type)@.--patternApp::forallk2(t::k2).()=>forallk1(a::k1->k2)(b::k1).(t~ab)=>TypeRepa->TypeRepb->TypeReptpatternAppfx<-(splitApp->IsAppfx)whereAppfx=mkTrAppCheckedfxdataAppOrCon(a::k)whereIsApp::forallkk'(f::k'->k)(x::k').()=>TypeRepf->TypeRepx->AppOrCon(fx)-- See Note [Con evidence]IsCon::IsApplicationa~""=>TyCon->[SomeTypeRep]->AppOrConatypefamilyIsApplication(x::k)::SymbolwhereIsApplication(__)="An error message about this unifying with \"\" "`AppendSymbol`"means that you tried to match a TypeRep with Con or "`AppendSymbol`"Con' when the represented type was known to be an "`AppendSymbol`"application."IsApplication_=""splitApp::forallk(a::k).()=>TypeRepa->AppOrConasplitAppTrType=IsApptrTYPEtrLiftedRepsplitApp(TrApp{trAppFun=f,trAppArg=x})=IsAppfxsplitApprep@(TrFun{trFunArg=a,trFunRes=b})=IsApp(mkTrApparra)bwherearr=bareArrowrepsplitApp(TrTyCon{trTyCon=con,trKindVars=kinds})=caseunsafeCoerceRefl::IsApplicationa:~:""ofRefl->IsConconkinds-- | Use a 'TypeRep' as 'Typeable' evidence.withTypeable::forallk(a::k)rep(r::TYPErep).()=>TypeRepa->(Typeablea=>r)->rwithTypeablerepk=unsafeCoercek'repwherek'::Giftark'=Giftk-- | A helper to satisfy the type checker in 'withTypeable'.newtypeGifta(r::TYPErep)=Gift(Typeablea=>r)-- | Pattern match on a type constructorpatternCon::forallk(a::k).()=>IsApplicationa~""-- See Note [Con evidence]=>TyCon->TypeRepapatternConcon<-(splitApp->IsConcon_)-- | Pattern match on a type constructor including its instantiated kind-- variables.---- For instance,---- @-- App (Con' proxyTyCon ks) intRep = typeRep @(Proxy \@Int)-- @---- will bring into scope,---- @-- proxyTyCon :: TyCon-- ks         == [someTypeRep @Type] :: [SomeTypeRep]-- intRep     == typeRep @Int-- @--patternCon'::forallk(a::k).()=>IsApplicationa~""-- See Note [Con evidence]=>TyCon->[SomeTypeRep]->TypeRepapatternCon'conks<-(splitApp->IsConconks)-- TODO: Remove Fun when #14253 is fixed{-# COMPLETEFun,App,Con#-}{-# COMPLETEFun,App,Con'#-}{- Note [Con evidence]    ~~~~~~~~~~~~~~~~~~~Matching TypeRep t on Con or Con' fakes up evidence that  IsApplication t ~ "".Why should anyone care about the value of strange internal type family?Well, almost nobody cares about it, but the pattern checker does!For example, suppose we have TypeRep (f x) and we want to getTypeRep f and TypeRep x. There is no chance that the Con constructorwill match, because (f x) is not a constructor, but without theIsApplication evidence, omitting it will lead to an incomplete patternwarning. With the evidence, the pattern checker will see thatCon wouldn't typecheck, so everything works out as it should.Why do we use Symbols? We would really like to use something like  type family NotApplication (t :: k) :: Constraint where    NotApplication (f a) = TypeError ...    NotApplication _ = ()Unfortunately, #11503 means that the pattern checker and type checkerwill fail to actually reject the mistaken patterns. So we describe theerror in the result type. It's a horrible hack.-}----------------- Observation ----------------------- | Observe the type constructor of a quantified type representation.someTypeRepTyCon::SomeTypeRep->TyConsomeTypeRepTyCon(SomeTypeRept)=typeRepTyCont-- | Observe the type constructor of a type representationtypeRepTyCon::TypeRepa->TyContypeRepTyConTrType=tyConTYPEtypeRepTyCon(TrTyCon{trTyCon=tc})=tctypeRepTyCon(TrApp{trAppFun=a})=typeRepTyConatypeRepTyCon(TrFun{})=typeRepTyCon$typeRep@(->)-- | Type equality---- @since 4.10eqTypeRep::forallk1k2(a::k1)(b::k2).TypeRepa->TypeRepb->Maybe(a:~~:b)eqTypeRepab|sameTypeRepab=Just(unsafeCoerce#HRefl)|otherwise=Nothing-- We want GHC to inline eqTypeRep to get rid of the Maybe-- in the usual case that it is scrutinized immediately. We-- split eqTypeRep into a worker and wrapper because otherwise-- it's much larger than anything we'd want to inline.{-# INLINABLEeqTypeRep#-}sameTypeRep::forallk1k2(a::k1)(b::k2).TypeRepa->TypeRepb->BoolsameTypeRepab=typeRepFingerprinta==typeRepFingerprintb-----------------------------------------------------------------      Computing kinds----------------------------------------------------------------- | Observe the kind of a type.typeRepKind::TypeRep(a::k)->TypeRepktypeRepKindTrType=TrTypetypeRepKind(TrTyCon{trTyConKind=kind})=kindtypeRepKind(TrApp{trAppKind=kind})=kindtypeRepKind(TrFun{})=typeRep@TypetyConKind::TyCon->[SomeTypeRep]->SomeTypeReptyConKind(TyCon____nKindVars#kindRep)kindVars=letkindVarsArr::A.ArrayKindBndrSomeTypeRepkindVarsArr=A.listArray(0,I#(nKindVars#-#1#))kindVarsininstantiateKindRepkindVarsArrkindRepinstantiateKindRep::A.ArrayKindBndrSomeTypeRep->KindRep->SomeTypeRepinstantiateKindRepvars=gowherego::KindRep->SomeTypeRepgo(KindRepTyConApptcargs)=letn_kind_args=tyConKindArgstc(kind_args,ty_args)=splitAtn_kind_argsargs-- First instantiate tycon kind argumentstycon_app=SomeTypeRep$mkTrContc(mapgokind_args)-- Then apply remaining type argumentsapplyTy::SomeTypeRep->KindRep->SomeTypeRepapplyTy(SomeTypeRepacc)ty|SomeTypeRepty'<-goty=SomeTypeRep$mkTrApp(unsafeCoerceacc)ty'infoldl'applyTytycon_appty_argsgo(KindRepVarvar)=varsA.!vargo(KindRepAppfa)=SomeTypeRep$mkTrApp(unsafeCoerceRep$gof)(unsafeCoerceRep$goa)go(KindRepFunab)=SomeTypeRep$mkTrFun(unsafeCoerceRep$goa)(unsafeCoerceRep$gob)go(KindRepTYPELiftedRep)=SomeTypeRepTrTypego(KindRepTYPEr)=unkindedTypeRep$tYPE`kApp`runtimeRepTypeReprgo(KindRepTypeLitSsorts)=mkTypeLitFromStringsort(unpackCStringUtf8#s)go(KindRepTypeLitDsorts)=mkTypeLitFromStringsortstYPE=kindedTypeRep@(RuntimeRep->Type)@TYPEunsafeCoerceRep::SomeTypeRep->TypeRepaunsafeCoerceRep(SomeTypeRepr)=unsafeCoercerunkindedTypeRep::SomeKindedTypeRepk->SomeTypeRepunkindedTypeRep(SomeKindedTypeRepx)=SomeTypeRepxdataSomeKindedTypeRepkwhereSomeKindedTypeRep::forallk(a::k).TypeRepa->SomeKindedTypeRepkkApp::SomeKindedTypeRep(k->k')->SomeKindedTypeRepk->SomeKindedTypeRepk'kApp(SomeKindedTypeRepf)(SomeKindedTypeRepa)=SomeKindedTypeRep(mkTrAppfa)kindedTypeRep::forallk(a::k).Typeablea=>SomeKindedTypeRepkkindedTypeRep=SomeKindedTypeRep(typeRep@a)buildList::forallk.Typeablek=>[SomeKindedTypeRepk]->SomeKindedTypeRep[k]buildList=foldrconsnilwherenil=kindedTypeRep@[k]@'[]consxrest=SomeKindedTypeRep(typeRep@'(:))`kApp`x`kApp`restruntimeRepTypeRep::RuntimeRep->SomeKindedTypeRepRuntimeRepruntimeRepTypeRepr=caserofLiftedRep->rep@'LiftedRepUnliftedRep->rep@'UnliftedRepVecRepce->kindedTypeRep@_@'VecRep`kApp`vecCountTypeRepc`kApp`vecElemTypeRepeTupleReprs->kindedTypeRep@_@'TupleRep`kApp`buildList(mapruntimeRepTypeReprs)SumReprs->kindedTypeRep@_@'SumRep`kApp`buildList(mapruntimeRepTypeReprs)IntRep->rep@'IntRepWordRep->rep@'WordRepInt64Rep->rep@'Int64RepWord64Rep->rep@'Word64RepAddrRep->rep@'AddrRepFloatRep->rep@'FloatRepDoubleRep->rep@'DoubleRepwhererep::forall(a::RuntimeRep).Typeablea=>SomeKindedTypeRepRuntimeReprep=kindedTypeRep@RuntimeRep@avecCountTypeRep::VecCount->SomeKindedTypeRepVecCountvecCountTypeRepc=casecofVec2->rep@'Vec2Vec4->rep@'Vec4Vec8->rep@'Vec8Vec16->rep@'Vec16Vec32->rep@'Vec32Vec64->rep@'Vec64whererep::forall(a::VecCount).Typeablea=>SomeKindedTypeRepVecCountrep=kindedTypeRep@VecCount@avecElemTypeRep::VecElem->SomeKindedTypeRepVecElemvecElemTypeRepe=caseeofInt8ElemRep->rep@'Int8ElemRepInt16ElemRep->rep@'Int16ElemRepInt32ElemRep->rep@'Int32ElemRepInt64ElemRep->rep@'Int64ElemRepWord8ElemRep->rep@'Word8ElemRepWord16ElemRep->rep@'Word16ElemRepWord32ElemRep->rep@'Word32ElemRepWord64ElemRep->rep@'Word64ElemRepFloatElemRep->rep@'FloatElemRepDoubleElemRep->rep@'DoubleElemRepwhererep::forall(a::VecElem).Typeablea=>SomeKindedTypeRepVecElemrep=kindedTypeRep@VecElem@abareArrow::forall(r1::RuntimeRep)(r2::RuntimeRep)(a::TYPEr1)(b::TYPEr2).()=>TypeRep(a->b)->TypeRep((->)::TYPEr1->TYPEr2->Type)bareArrow(TrFun_ab)=mkTrConfunTyCon[SomeTypeReprep1,SomeTypeReprep2]whererep1=getRuntimeRep$typeRepKinda::TypeRepr1rep2=getRuntimeRep$typeRepKindb::TypeRepr2bareArrow_=error"Data.Typeable.Internal.bareArrow: impossible"dataIsTYPE(a::Type)whereIsTYPE::forall(r::RuntimeRep).TypeRepr->IsTYPE(TYPEr)-- | Is a type of the form @TYPE rep@?isTYPE::TypeRep(a::Type)->Maybe(IsTYPEa)isTYPETrType=Just(IsTYPEtrLiftedRep)isTYPE(TrApp{trAppFun=f,trAppArg=r})|JustHRefl<-f`eqTypeRep`typeRep@TYPE=Just(IsTYPEr)isTYPE_=NothinggetRuntimeRep::forall(r::RuntimeRep).TypeRep(TYPEr)->TypeReprgetRuntimeRepTrType=trLiftedRepgetRuntimeRep(TrApp{trAppArg=r})=rgetRuntimeRep_=error"Data.Typeable.Internal.getRuntimeRep: impossible"-----------------------------------------------------------------      The Typeable class and friends----------------------------------------------------------------- | The class 'Typeable' allows a concrete representation of a type to-- be calculated.classTypeable(a::k)wheretypeRep#::TypeRepatypeRep::Typeablea=>TypeRepatypeRep=typeRep#typeOf::Typeablea=>a->TypeRepatypeOf_=typeRep-- | Takes a value of type @a@ and returns a concrete representation-- of that type.---- @since 4.7.0.0someTypeRep::forallproxya.Typeablea=>proxya->SomeTypeRepsomeTypeRep_=SomeTypeRep(typeRep::TypeRepa){-# INLINEtypeRep#-}someTypeRepFingerprint::SomeTypeRep->FingerprintsomeTypeRepFingerprint(SomeTypeRept)=typeRepFingerprintt----------------- Showing TypeReps ---------------------- This follows roughly the precedence structure described in Note [Precedence-- in types].instanceShow(TypeRep(a::k))whereshowsPrec=showTypeableshowTypeable::Int->TypeRep(a::k)->ShowSshowTypeable_TrType=showChar'*'showTypeable_rep|isListTyContc,[ty]<-tys=showChar'['.showsty.showChar']'|isTupleTyContc=showChar'('.showArgs(showChar',')tys.showChar')'where(tc,tys)=splitAppsrepshowTypeable_(TrTyCon{trTyCon=tycon,trKindVars=[]})=showTyContyconshowTypeablep(TrTyCon{trTyCon=tycon,trKindVars=args})=showParen(p>9)$showTyContycon.showChar' '.showArgs(showChar' ')argsshowTypeablep(TrFun{trFunArg=x,trFunRes=r})=showParen(p>8)$showsPrec9x.showString" -> ".showsPrec8rshowTypeablep(TrApp{trAppFun=f,trAppArg=x})=showParen(p>9)$showsPrec8f.showChar' '.showsPrec10x-- | @since 4.10.0.0instanceShowSomeTypeRepwhereshowsPrecp(SomeTypeRepty)=showsPrecptysplitApps::TypeRepa->(TyCon,[SomeTypeRep])splitApps=go[]wherego::[SomeTypeRep]->TypeRepa->(TyCon,[SomeTypeRep])goxs(TrTyCon{trTyCon=tc})=(tc,xs)goxs(TrApp{trAppFun=f,trAppArg=x})=go(SomeTypeRepx:xs)fgo[](TrFun{trFunArg=a,trFunRes=b})=(funTyCon,[SomeTypeRepa,SomeTypeRepb])go_(TrFun{})=errorWithoutStackTrace"Data.Typeable.Internal.splitApps: Impossible 1"go[]TrType=(tyConTYPE,[SomeTypeReptrLiftedRep])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::TyContyConTYPE=mkTyCon(tyConPackageliftedRepTyCon)"GHC.Prim""TYPE"0(KindRepFun(KindRepTyConAppliftedRepTyCon[])(KindRepTYPELiftedRep))whereliftedRepTyCon=typeRepTyCon(typeRep@RuntimeRep)funTyCon::TyConfunTyCon=typeRepTyCon(typeRep@(->))isListTyCon::TyCon->BoolisListTyContc=tc==typeRepTyCon(typeRep::TypeRep[])isTupleTyCon::TyCon->BoolisTupleTyContc|('(':',':_)<-tyConNametc=True|otherwise=False-- This is only an approximation. We don't have the general-- character-classification machinery here, so we just do our best.-- This should work for promoted Haskell 98 data constructors and-- for TypeOperators type constructors that begin with ASCII-- characters, but it will miss Unicode operators.---- If we wanted to catch Unicode as well, we ought to consider moving-- GHC.Lexeme from ghc-boot-th to base. Then we could just say:----   startsVarSym symb || startsConSym symb---- But this is a fair deal of work just for one corner case, so I think I'll-- leave it like this unless someone shouts.isOperatorTyCon::TyCon->BoolisOperatorTyContc|symb:_<-tyConNametc,symb`elem`"!#$%&*+./<=>?@\\^|-~:"=True|otherwise=FalseshowTyCon::TyCon->ShowSshowTyContycon=showParen(isOperatorTyContycon)(showstycon)showArgs::Showa=>ShowS->[a]->ShowSshowArgs_[]=idshowArgs_[a]=showsPrec10ashowArgssep(a:as)=showsPrec10a.sep.showArgssepas-- | Helper to fully evaluate 'TypeRep' for use as @NFData(rnf)@ implementation---- @since 4.8.0.0rnfTypeRep::TypeRepa->()-- 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---- @since 4.10.0.0rnfSomeTypeRep::SomeTypeRep->()rnfSomeTypeRep(SomeTypeRepr)=rnfTypeRepr{- **********************************************************                                                          **       TyCon/TypeRep definitions for type literals        **              (Symbol and Nat)                            **                                                          ********************************************************** -}patternKindRepTypeLit::TypeLitSort->String->KindReppatternKindRepTypeLitsortt<-(getKindRepTypeLit->Just(sort,t))whereKindRepTypeLitsortt=KindRepTypeLitDsortt{-# COMPLETEKindRepTyConApp,KindRepVar,KindRepApp,KindRepFun,KindRepTYPE,KindRepTypeLit#-}getKindRepTypeLit::KindRep->Maybe(TypeLitSort,String)getKindRepTypeLit(KindRepTypeLitSsortt)=Just(sort,unpackCStringUtf8#t)getKindRepTypeLit(KindRepTypeLitDsortt)=Just(sort,t)getKindRepTypeLit_=Nothing-- | Exquisitely unsafe.mkTyCon#::Addr#-- ^ package name->Addr#-- ^ module name->Addr#-- ^ the name of the type constructor->Int#-- ^ number of kind variables->KindRep-- ^ kind representation->TyCon-- ^ A unique 'TyCon' objectmkTyCon#pkgmodlnamen_kindskind_rep|Fingerprint(W64#hi)(W64#lo)<-fingerprint=TyConhilomod(TrNameSname)n_kindskind_repwheremod=Module(TrNameSpkg)(TrNameSmodl)fingerprint::Fingerprintfingerprint=mkTyConFingerprint(unpackCStringUtf8#pkg)(unpackCStringUtf8#modl)(unpackCStringUtf8#name)-- it is extremely important that this fingerprint computation-- remains in sync with that in TcTypeable to ensure that type-- equality is correct.-- | Exquisitely unsafe.mkTyCon::String-- ^ package name->String-- ^ module name->String-- ^ the name of the type constructor->Int-- ^ number of kind variables->KindRep-- ^ kind representation->TyCon-- ^ A unique 'TyCon' object-- Used when the strings are dynamically allocated,-- eg from binary deserialisationmkTyConpkgmodlname(I#n_kinds)kind_rep|Fingerprint(W64#hi)(W64#lo)<-fingerprint=TyConhilomod(TrNameDname)n_kindskind_repwheremod=Module(TrNameDpkg)(TrNameDmodl)fingerprint::Fingerprintfingerprint=mkTyConFingerprintpkgmodlname-- This must match the computation done in TcTypeable.mkTyConRepTyConRHS.mkTyConFingerprint::String-- ^ package name->String-- ^ module name->String-- ^ tycon name->FingerprintmkTyConFingerprintpkg_namemod_nametycon_name=fingerprintFingerprints[fingerprintStringpkg_name,fingerprintStringmod_name,fingerprintStringtycon_name]mkTypeLitTyCon::String->TyCon->TyConmkTypeLitTyConnamekind_tycon=mkTyCon"base""GHC.TypeLits"name0kindwherekind=KindRepTyConAppkind_tycon[]-- | Used to make `'Typeable' instance for things of kind NattypeNatTypeRep::KnownNata=>Proxy#a->TypeRepatypeNatTypeRepp=typeLitTypeRep(show(natVal'p))tcNat-- | Used to make `'Typeable' instance for things of kind SymboltypeSymbolTypeRep::KnownSymbola=>Proxy#a->TypeRepatypeSymbolTypeRepp=typeLitTypeRep(show(symbolVal'p))tcSymbolmkTypeLitFromString::TypeLitSort->String->SomeTypeRepmkTypeLitFromStringTypeLitSymbols=SomeTypeRep$(typeLitTypeRepstcSymbol::TypeRepSymbol)mkTypeLitFromStringTypeLitNats=SomeTypeRep$(typeLitTypeRepstcSymbol::TypeRepNat)tcSymbol::TyContcSymbol=typeRepTyCon(typeRep@Symbol)tcNat::TyContcNat=typeRepTyCon(typeRep@Nat)-- | An internal function, to make representations for type literals.typeLitTypeRep::forallk(a::k).(Typeablek)=>String->TyCon->TypeRepatypeLitTypeRepnmkind_tycon=mkTrCon(mkTypeLitTyConnmkind_tycon)[]-- | For compiler use.mkTrFun::forall(r1::RuntimeRep)(r2::RuntimeRep)(a::TYPEr1)(b::TYPEr2).TypeRepa->TypeRepb->TypeRep((a->b)::Type)mkTrFunargres=TrFun{trFunFingerprint=fpr,trFunArg=arg,trFunRes=res}wherefpr=fingerprintFingerprints[typeRepFingerprintarg,typeRepFingerprintres]{- $kind_instantiationConsider a type like 'Data.Proxy.Proxy',@data Proxy :: forall k. k -> Type@One might think that one could decompose an instantiation of this type like@Proxy Int@ into two applications,@'App' (App a b) c === typeRep @(Proxy Int)@where,@a = typeRep @Proxyb = typeRep @Typec = typeRep @Int@However, this isn't the case. Instead we can only decompose into an applicationand a constructor,@'App' ('Con' proxyTyCon) (typeRep @Int) === typeRep @(Proxy Int)@The reason for this is that 'Typeable' can only represent /kind-monomorphic/types. That is, we must saturate enough of @Proxy@\'s arguments tofully determine its kind. In the particular case of @Proxy@ this means we mustinstantiate the kind variable @k@ such that no @forall@-quantified variablesremain.While it is not possible to decompose the 'Con' above into an application, it ispossible to observe the kind variable instantiations of the constructor with the'Con\'' pattern,@'App' (Con' proxyTyCon kinds) _ === typeRep @(Proxy Int)@Here @kinds@ will be @[typeRep \@Type]@.-}