Trac #9878: Have StaticPointers support dynamic loading.

Summary:
A mutex is used to protect the SPT.

unsafeLookupStaticPtr and staticPtrKeys in GHC.StaticPtr are made
monadic.

SPT entries are removed in a destructor function of modules.

Authored-by: Facundo Domínguez <facundo.dominguez@tweag.io>
Authored-by: Alexander Vershilov <alexander.vershilov@tweag.io>

Test Plan: ./validate

Reviewers: austin, simonpj, hvr

Subscribers: carter, thomie, qnikst, mboes

Differential Revision: https://phabricator.haskell.org/D587

GHC Trac Issues: #9878

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