diff options
Diffstat (limited to 'libraries/base/GHC/StaticPtr.hs')
| -rw-r--r-- | libraries/base/GHC/StaticPtr.hs | 33 |
1 files changed, 14 insertions, 19 deletions
diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index b58564e1d2..efaabf2dd2 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -24,9 +24,9 @@ -- -- To solve such concern, the references provided by this module offer a key -- that can be used to locate the values on each process. Each process maintains --- a global and immutable table of references which can be looked up with a --- given key. This table is known as the Static Pointer Table. The reference can --- then be dereferenced to obtain the value. +-- a global table of references which can be looked up with a given key. This +-- table is known as the Static Pointer Table. The reference can then be +-- dereferenced to obtain the value. -- ----------------------------------------------------------------------------- @@ -48,7 +48,6 @@ import Foreign.Ptr (castPtr) import GHC.Exts (addrToAny#) import GHC.Ptr (Ptr(..), nullPtr) import GHC.Fingerprint (Fingerprint(..)) -import System.IO.Unsafe (unsafePerformIO) -- | A reference to a value of type 'a'. @@ -74,8 +73,15 @@ staticKey (StaticPtr k _ _) = k -- This function is unsafe because the program behavior is undefined if the type -- of the returned 'StaticPtr' does not match the expected one. -- -unsafeLookupStaticPtr :: StaticKey -> Maybe (StaticPtr a) -unsafeLookupStaticPtr k = unsafePerformIO $ sptLookup k +unsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a)) +unsafeLookupStaticPtr (Fingerprint w1 w2) = do + ptr@(Ptr addr) <- withArray [w1,w2] (hs_spt_lookup . castPtr) + if (ptr == nullPtr) + then return Nothing + else case addrToAny# addr of + (# spe #) -> return (Just spe) + +foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) -- | Miscelaneous information available for debugging purposes. data StaticPtrInfo = StaticPtrInfo @@ -96,20 +102,9 @@ data StaticPtrInfo = StaticPtrInfo staticPtrInfo :: StaticPtr a -> StaticPtrInfo staticPtrInfo (StaticPtr _ n _) = n --- | Like 'unsafeLookupStaticPtr' but evaluates in 'IO'. -sptLookup :: StaticKey -> IO (Maybe (StaticPtr a)) -sptLookup (Fingerprint w1 w2) = do - ptr@(Ptr addr) <- withArray [w1,w2] (hs_spt_lookup . castPtr) - if (ptr == nullPtr) - then return Nothing - else case addrToAny# addr of - (# spe #) -> return (Just spe) - -foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a) - -- | A list of all known keys. -staticPtrKeys :: [StaticKey] -staticPtrKeys = unsafePerformIO $ do +staticPtrKeys :: IO [StaticKey] +staticPtrKeys = do keyCount <- hs_spt_key_count allocaArray (fromIntegral keyCount) $ \p -> do count <- hs_spt_keys p keyCount |