X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FTypeable.hs;h=159137c96bba9c119d156d6f5ec73a16793d59b1;hb=d95bc90db44a12ac85e71d570735410eb27f6e30;hp=3e5b7c2011db8cd70d1776818058523bee0060d6;hpb=e339d27dc714a2ddd5043ead2a359b4f6d45e9a7;p=ghc-base.git diff --git a/Data/Typeable.hs b/Data/Typeable.hs index 3e5b7c2..159137c 100644 --- a/Data/Typeable.hs +++ b/Data/Typeable.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Typeable @@ -9,15 +9,24 @@ -- Stability : experimental -- Portability : portable -- --- The Typeable class reifies types to some extent by associating type +-- The 'Typeable' class reifies types to some extent by associating type -- representations to types. These type representations can be compared, -- and one can in turn define a type-safe cast operation. To this end, -- an unsafe cast is guarded by a test for type (representation) --- equivalence. The module Data.Dynamic uses Typeable for an --- implementation of dynamics. The module Data.Generics uses Typeable +-- equivalence. The module "Data.Dynamic" uses Typeable for an +-- implementation of dynamics. The module "Data.Generics" uses Typeable -- and type-safe cast (but not dynamics) to support the \"Scrap your -- boilerplate\" style of generic programming. -- +-- Note, only relevant if you use dynamic linking. If you have a program +-- that is statically linked with Data.Typeable, and then dynamically link +-- a program that also uses Data.Typeable, you'll get two copies of the module. +-- That's fine, but behind the scenes, the module uses a mutable variable to +-- allocate unique Ids to type constructors. So in the situation described, +-- there'll be two separate Id allocators, which aren't comparable to each other. +-- This can lead to chaos. (It's a bug that we will fix.) None of +-- this matters if you aren't using dynamic linking. +-- ----------------------------------------------------------------------------- module Data.Typeable @@ -85,10 +94,21 @@ import GHC.Show import GHC.Err import GHC.Num import GHC.Float -import GHC.Real( rem, Ratio ) -import GHC.IOBase -import GHC.Ptr -- So we can give Typeable instance for Ptr -import GHC.Stable -- So we can give Typeable instance for StablePtr +import GHC.Real ( rem, Ratio ) +import GHC.IOBase (IORef,newIORef,unsafePerformIO) + +-- These imports are so we can define Typeable instances +-- It'd be better to give Typeable instances in the modules themselves +-- but they all have to be compiled before Typeable +import GHC.IOBase ( IO, MVar, Exception, ArithException, IOException, + ArrayException, AsyncException, Handle ) +import GHC.ST ( ST ) +import GHC.STRef ( STRef ) +import GHC.Ptr ( Ptr, FunPtr ) +import GHC.ForeignPtr ( ForeignPtr ) +import GHC.Stable ( StablePtr ) +import GHC.Arr ( Array, STArray ) + #endif #ifdef __HUGS__ @@ -96,6 +116,9 @@ import Hugs.Prelude import Hugs.IO import Hugs.IORef import Hugs.IOExts + -- For the Typeable instance +import Hugs.Array ( Array ) +import Hugs.ConcBase ( MVar ) #endif #ifdef __GLASGOW_HASKELL__ @@ -108,8 +131,9 @@ import NonStdUnsafeCoerce (unsafeCoerce) import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO) import IO (Handle) import Ratio (Ratio) -import NHC.FFI (Ptr,StablePtr) -#else + -- For the Typeable instance +import NHC.FFI ( Ptr,FunPtr,StablePtr,ForeignPtr ) +import Array ( Array ) #endif #include "Typeable.h" @@ -448,13 +472,37 @@ gcast2 x = r -- ------------------------------------------------------------- +INSTANCE_TYPEABLE0((),unitTc,"()") INSTANCE_TYPEABLE1([],listTc,"[]") INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe") INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio") INSTANCE_TYPEABLE2(Either,eitherTc,"Either") INSTANCE_TYPEABLE2((->),funTc,"->") INSTANCE_TYPEABLE1(IO,ioTc,"IO") -INSTANCE_TYPEABLE0((),unitTc,"()") + +#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__) +-- Types defined in GHC.IOBase +INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) +INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception") +INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException") +INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException") +INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException") +INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException") +#endif + +-- Types defined in GHC.Arr +INSTANCE_TYPEABLE2(Array,arrayTc,"Array") + +#ifdef __GLASGOW_HASKELL__ +-- Hugs has these too, but their Typeable instances are defined +-- elsewhere to keep this module within Haskell 98. +-- This is important because every invocation of runhugs or ffihugs +-- uses this module via Data.Dynamic. +INSTANCE_TYPEABLE2(ST,stTc,"ST") +INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef") +INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray") +#endif + #ifndef __NHC__ INSTANCE_TYPEABLE2((,),pairTc,",") INSTANCE_TYPEABLE3((,,),tup3Tc,",,") @@ -478,15 +526,17 @@ instance Typeable6 (,,,,,) where typeOf6 tu = mkTyConApp tup6Tc [] tup7Tc :: TyCon -tup7Tc = mkTyCon ",,,,," +tup7Tc = mkTyCon ",,,,,," instance Typeable7 (,,,,,,) where typeOf7 tu = mkTyConApp tup7Tc [] - #endif /* __NHC__ */ + INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr") -INSTANCE_TYPEABLE1(StablePtr,stableptrTc,"StablePtr") -INSTANCE_TYPEABLE1(IORef,iorefTc,"IORef") +INSTANCE_TYPEABLE1(FunPtr,funPtrTc,"FunPtr") +INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") +INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr") +INSTANCE_TYPEABLE1(IORef,iORefTc,"IORef") ------------------------------------------------------- -- @@ -499,6 +549,9 @@ INSTANCE_TYPEABLE0(Char,charTc,"Char") INSTANCE_TYPEABLE0(Float,floatTc,"Float") INSTANCE_TYPEABLE0(Double,doubleTc,"Double") INSTANCE_TYPEABLE0(Int,intTc,"Int") +#ifndef __NHC__ +INSTANCE_TYPEABLE0(Word,wordTc,"Word" ) +#endif INSTANCE_TYPEABLE0(Integer,integerTc,"Integer") INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering") INSTANCE_TYPEABLE0(Handle,handleTc,"Handle") @@ -517,7 +570,7 @@ INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon") INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep") #ifdef __GLASGOW_HASKELL__ -INSTANCE_TYPEABLE0(Word,wordTc,"Word" ) +INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld") #endif --------------------------------------------- @@ -535,7 +588,7 @@ data KeyPr = KeyPr !Key !Key deriving( Eq ) hashKP :: KeyPr -> Int32 hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime -data Cache = Cache { next_key :: !(IORef Key), +data Cache = Cache { next_key :: !(IORef Key), -- Not used by GHC (calls genSym instead) tc_tbl :: !(HT.HashTable String Key), ap_tbl :: !(HT.HashTable KeyPr Key) }