Remove Control.Parallel*, now in package parallel

[haskell-directory.git] / Data / Typeable.hs

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index 7b89b58..7a8b733 100644 (file)
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -25,15 +25,6 @@
 -- 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
@@ -49,6 +40,7 @@ module Data.Typeable
        -- * Type representations
        TypeRep,        -- abstract, instance of: Eq, Show, Typeable
        TyCon,          -- abstract, instance of: Eq, Show, Typeable
+       showsTypeRep,
 
        -- * Construction of type representations
        mkTyCon,        -- :: String  -> TyCon
@@ -62,6 +54,7 @@ module Data.Typeable
        typeRepTyCon,   -- :: TypeRep -> TyCon
        typeRepArgs,    -- :: TypeRep -> [TypeRep]
        tyConString,    -- :: TyCon   -> String
+       typeRepKey,     -- :: TypeRep -> IO Int
 
        -- * The other Typeable classes
        -- | /Note:/ The general instances are provided for GHC only.
@@ -113,7 +106,10 @@ import GHC.ST              ( ST )
 import GHC.STRef       ( STRef )
 import GHC.Ptr          ( Ptr, FunPtr )
 import GHC.ForeignPtr   ( ForeignPtr )
-import GHC.Stable       ( StablePtr )
+import GHC.Stable      ( StablePtr, newStablePtr, freeStablePtr,
+                         deRefStablePtr, castStablePtrToPtr,
+                         castPtrToStablePtr )
+import GHC.Exception   ( block )
 import GHC.Arr         ( Array, STArray )
 
 #endif
@@ -169,9 +165,21 @@ data TyCon = TyCon !Key String
 
 instance Eq TyCon where
   (TyCon t1 _) == (TyCon t2 _) = t1 == t2
-
 #endif
 
+-- | Returns a unique integer associated with a 'TypeRep'.  This can
+-- be used for making a mapping ('Data.IntMap.IntMap') with TypeReps
+-- as the keys, for example.  It is guaranteed that @t1 == t2@ if and only if
+-- @typeRepKey t1 == typeRepKey t2@.
+--
+-- It is in the 'IO' monad because the actual value of the key may
+-- vary from run to run of the program.  You should only rely on
+-- the equality property, not any actual key value.  The relative ordering
+-- of keys has no meaning either.
+--
+typeRepKey :: TypeRep -> IO Int
+typeRepKey (TypeRep (Key i) _ _) = return i
+
        -- 
        -- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,")
        --                                 [fTy,fTy,fTy])
@@ -273,6 +281,9 @@ instance Show TypeRep where
            showChar ' '      . 
            showArgs tys
 
+showsTypeRep :: TypeRep -> ShowS
+showsTypeRep = shows
+
 instance Show TyCon where
   showsPrec _ (TyCon _ s) = showString s
 
@@ -602,14 +613,33 @@ data Cache = Cache { next_key :: !(IORef Key),    -- Not used by GHC (calls genSym
                     ap_tbl   :: !(HT.HashTable KeyPr Key) }
 
 {-# NOINLINE cache #-}
+#ifdef __GLASGOW_HASKELL__
+foreign import ccall unsafe "RtsTypeable.h getOrSetTypeableStore"
+    getOrSetTypeableStore :: Ptr a -> IO (Ptr a)
+#endif
+
 cache :: Cache
 cache = unsafePerformIO $ do
                empty_tc_tbl <- HT.new (==) HT.hashString
                empty_ap_tbl <- HT.new (==) hashKP
                key_loc      <- newIORef (Key 1) 
-               return (Cache { next_key = key_loc,
-                               tc_tbl = empty_tc_tbl, 
-                               ap_tbl = empty_ap_tbl })
+               let ret = Cache {       next_key = key_loc,
+                                       tc_tbl = empty_tc_tbl, 
+                                       ap_tbl = empty_ap_tbl }
+#ifdef __GLASGOW_HASKELL__
+               block $ do
+                       stable_ref <- newStablePtr ret
+                       let ref = castStablePtrToPtr stable_ref
+                       ref2 <- getOrSetTypeableStore ref
+                       if ref==ref2
+                               then deRefStablePtr stable_ref
+                               else do
+                                       freeStablePtr stable_ref
+                                       deRefStablePtr
+                                               (castPtrToStablePtr ref2)
+#else
+               return ret
+#endif
 
 newKey :: IORef Key -> IO Key
 #ifdef __GLASGOW_HASKELL__
@@ -621,16 +651,6 @@ newKey kloc = do { k@(Key i) <- readIORef kloc ;
 #endif
 
 #ifdef __GLASGOW_HASKELL__
--- In GHC we use the RTS's genSym function to get a new unique,
--- because in GHCi we might have two copies of the Data.Typeable
--- library running (one in the compiler and one in the running
--- program), and we need to make sure they don't share any keys.  
---
--- This is really a hack.  A better solution would be to centralise the
--- whole mutable state used by this module, i.e. both hashtables.  But
--- the current solution solves the immediate problem, which is that
--- dynamics generated in one world with one type were erroneously
--- being recognised by the other world as having a different type.
 foreign import ccall unsafe "genSymZh"
   genSym :: IO Int
 #endif