X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FTypeable.hs;h=159137c96bba9c119d156d6f5ec73a16793d59b1;hb=b1f2e321ceac8fcfc1f0756e2f5c2585fbd00b3c;hp=ff2b304a685c7e9150ef6dcbbbf702646b4b8da7;hpb=d4039901986f6991c23f0469a40148e8150b0f1e;p=ghc-base.git

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index ff2b304..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
@@ -39,13 +48,13 @@ module Data.Typeable
 	mkTyConApp,	-- :: TyCon   -> [TypeRep] -> TypeRep
 	mkAppTy,	-- :: TypeRep -> TypeRep   -> TypeRep
 	mkFunTy,	-- :: TypeRep -> TypeRep   -> TypeRep
-	splitTyConApp,	-- :: TypeRep -> (TyCon, [TypeRep])
-	funResultTy,	-- :: TypeRep -> TypeRep   -> Maybe TypeRep
 
 	-- * Observation of type representations
-	typerepTyCon,	-- :: TypeRep -> TyCon
-	typerepArgs,	-- :: TypeRep -> [TypeRep]
-	tyconString,	-- :: TyCon   -> String
+	splitTyConApp,	-- :: TypeRep -> (TyCon, [TypeRep])
+	funResultTy,	-- :: TypeRep -> TypeRep   -> Maybe TypeRep
+	typeRepTyCon,	-- :: TypeRep -> TyCon
+	typeRepArgs,	-- :: TypeRep -> [TypeRep]
+	tyConString,	-- :: TyCon   -> String
 
 	-- * The other Typeable classes
 	-- | /Note:/ The general instances are provided for GHC only.
@@ -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"
@@ -211,16 +235,16 @@ mkTyCon str = TyCon (mkTyConKey str) str
 ----------------- Observation ---------------------
 
 -- | Observe the type constructor of a type representation
-typerepTyCon :: TypeRep -> TyCon
-typerepTyCon (TypeRep _ tc _) = tc
+typeRepTyCon :: TypeRep -> TyCon
+typeRepTyCon (TypeRep _ tc _) = tc
 
 -- | Observe the argument types of a type representation
-typerepArgs :: TypeRep -> [TypeRep]
-typerepArgs (TypeRep _ _ args) = args
+typeRepArgs :: TypeRep -> [TypeRep]
+typeRepArgs (TypeRep _ _ args) = args
 
 -- | Observe string encoding of a type representation
-tyconString :: TyCon   -> String
-tyconString  (TyCon _ str) = str
+tyConString :: TyCon   -> String
+tyConString  (TyCon _ str) = str
 
 ----------------- Showing TypeReps --------------------
 
@@ -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<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_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,"Foreign.Ptr.Ptr")
-INSTANCE_TYPEABLE1(StablePtr,stableptrTc,"Foreign.StablePtr.StablePtr")
-INSTANCE_TYPEABLE1(IORef,iorefTc,"Data.IORef.IORef")
+
+INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
+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) }