[commit: ghc] master: Expose purgeObj in ObjLink (c2bd62e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/c2bd62ed62d2fae126819136d428989a7b4ddc79/ghc

>---------------------------------------------------------------

commit c2bd62ed62d2fae126819136d428989a7b4ddc79
Author: Jon Coens <jcoens at fb.com>
Date:   Tue Jan 10 14:28:54 2017 -0500

    Expose purgeObj in ObjLink
    
    Test Plan: Rebuild GHC under 7.10.2.
    
    Reviewers: niteria, simonmar, austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2948


>---------------------------------------------------------------

c2bd62ed62d2fae126819136d428989a7b4ddc79
 libraries/ghci/GHCi/ObjLink.hs | 21 ++++++++++++++++++---
 1 file changed, 18 insertions(+), 3 deletions(-)

diff --git a/libraries/ghci/GHCi/ObjLink.hs b/libraries/ghci/GHCi/ObjLink.hs
index 05a0a16..d7dbdd3 100644
--- a/libraries/ghci/GHCi/ObjLink.hs
+++ b/libraries/ghci/GHCi/ObjLink.hs
@@ -16,6 +16,7 @@ module GHCi.ObjLink
   , loadArchive
   , loadObj
   , unloadObj
+  , purgeObj
   , lookupSymbol
   , lookupClosure
   , resolveObjs
@@ -25,6 +26,7 @@ module GHCi.ObjLink
   )  where
 
 import GHCi.RemoteTypes
+import Control.Exception (throwIO, ErrorCall(..))
 import Control.Monad    ( when )
 import Foreign.C
 import Foreign.Marshal.Alloc ( free )
@@ -109,19 +111,31 @@ loadArchive :: String -> IO ()
 loadArchive str = do
    withFilePath str $ \c_str -> do
      r <- c_loadArchive c_str
-     when (r == 0) (error ("loadArchive " ++ show str ++ ": failed"))
+     when (r == 0) (throwIO (ErrorCall ("loadArchive " ++ show str ++ ": failed")))
 
 loadObj :: String -> IO ()
 loadObj str = do
    withFilePath str $ \c_str -> do
      r <- c_loadObj c_str
-     when (r == 0) (error ("loadObj " ++ show str ++ ": failed"))
+     when (r == 0) (throwIO (ErrorCall ("loadObj " ++ show str ++ ": failed")))
 
+-- | @unloadObj@ drops the given dynamic library from the symbol table
+-- as well as enables the library to be removed from memory during
+-- a future major GC.
 unloadObj :: String -> IO ()
 unloadObj str =
    withFilePath str $ \c_str -> do
      r <- c_unloadObj c_str
-     when (r == 0) (error ("unloadObj " ++ show str ++ ": failed"))
+     when (r == 0) (throwIO (ErrorCall ("unloadObj " ++ show str ++ ": failed")))
+
+-- | @purgeObj@ drops the symbols for the dynamic library from the symbol
+-- table. Unlike 'unloadObj', the library will not be dropped memory during
+-- a future major GC.
+purgeObj :: String -> IO ()
+purgeObj str =
+   withFilePath str $ \c_str -> do
+     r <- c_purgeObj c_str
+     when (r == 0) (throwIO (ErrorCall ("purgeObj " ++ show str ++ ": failed")))
 
 addLibrarySearchPath :: String -> IO (Ptr ())
 addLibrarySearchPath str =
@@ -153,6 +167,7 @@ foreign import ccall unsafe "initLinker_"             c_initLinker_
 foreign import ccall unsafe "lookupSymbol"            c_lookupSymbol            :: CString -> IO (Ptr a)
 foreign import ccall unsafe "loadArchive"             c_loadArchive             :: CFilePath -> IO Int
 foreign import ccall unsafe "loadObj"                 c_loadObj                 :: CFilePath -> IO Int
+foreign import ccall unsafe "purgeObj"                c_purgeObj                :: CFilePath -> IO Int
 foreign import ccall unsafe "unloadObj"               c_unloadObj               :: CFilePath -> IO Int
 foreign import ccall unsafe "resolveObjs"             c_resolveObjs             :: IO Int
 foreign import ccall unsafe "addLibrarySearchPath"    c_addLibrarySearchPath    :: CFilePath -> IO (Ptr ())