-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Typeable
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.ST
import Hugs.IOExts
+ -- For the Typeable instance
+import Hugs.Array ( Array )
+import Hugs.ConcBase ( MVar )
#endif
#ifdef __GLASGOW_HASKELL__
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"
--
-------------------------------------------------------------
+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<n> 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_TYPEABLE0((),unitTc,"()")
+INSTANCE_TYPEABLE2(STRef,stRefTc,"STRef")
+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+#endif
+
#ifndef __NHC__
INSTANCE_TYPEABLE2((,),pairTc,",")
INSTANCE_TYPEABLE3((,,),tup3Tc,",,")
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")
-------------------------------------------------------
--
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")
#ifdef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE0(RealWorld,realWorldTc,"RealWorld")
-INSTANCE_TYPEABLE0(Word,wordTc,"Word" )
-INSTANCE_TYPEABLE1(MVar,mvarTc,"MVar" )
#endif
---------------------------------------------
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) }