X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FTypeable.hs;h=46369525305c21a38a31d2e8f6eab7b539a0a93c;hb=641f8d5964b2b02f4cd7b9081adf6596c6f4d4d7;hp=7f0e974e56d5c9f6173de6a759f38f8f217d2e25;hpb=3e23aaae1a1f07fd28f1092d0f79e13d66b72f09;p=haskell-directory.git diff --git a/Data/Typeable.hs b/Data/Typeable.hs index 7f0e974..4636952 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 @@ -94,18 +94,33 @@ import GHC.Show import GHC.Err import GHC.Num import GHC.Float -import GHC.Real( rem, Ratio ) -import GHC.IOBase -import GHC.ST -- So we can give Typeable instance for ST -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__ -import Hugs.Prelude -import Hugs.IO -import Hugs.IORef -import Hugs.IOExts +import Hugs.Prelude ( Key(..), TypeRep(..), TyCon(..), Ratio, + Exception, ArithException, IOException, + ArrayException, AsyncException, Handle, + Ptr, FunPtr, ForeignPtr, StablePtr ) +import Hugs.IORef ( IORef, newIORef, readIORef, writeIORef ) +import Hugs.IOExts ( unsafePerformIO, unsafeCoerce ) + -- For the Typeable instance +import Hugs.Array ( Array ) +import Hugs.ConcBase ( MVar ) #endif #ifdef __GLASGOW_HASKELL__ @@ -118,8 +133,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" @@ -458,16 +474,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") + +#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 -INSTANCE_TYPEABLE0((),unitTc,"()") + #ifndef __NHC__ INSTANCE_TYPEABLE2((,),pairTc,",") INSTANCE_TYPEABLE3((,,),tup3Tc,",,") @@ -495,11 +532,13 @@ 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") ------------------------------------------------------- -- @@ -512,6 +551,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") @@ -531,8 +573,6 @@ INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep") #ifdef __GLASGOW_HASKELL__ INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld") -INSTANCE_TYPEABLE0(Word,wordTc,"Word" ) -INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" ) #endif --------------------------------------------- @@ -550,7 +590,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) }