Add option to not retain CAFs to the linker API

2 files changed, 24 insertions, 3 deletions

diff --git a/libraries/ghci/GHCi/ObjLink.hs b/libraries/ghci/GHCi/ObjLink.hs
index d422813fa9..05a0a167dc 100644
--- a/libraries/ghci/GHCi/ObjLink.hs
+++ b/libraries/ghci/GHCi/ObjLink.hs
@@ -11,7 +11,7 @@
 -- | Primarily, this module consists of an interface to the C-land
 -- dynamic linker.
 module GHCi.ObjLink
-  ( initObjLinker
+  ( initObjLinker, ShouldRetainCAFs(..)
   , loadDLL
   , loadArchive
   , loadObj
@@ -33,10 +33,31 @@ import GHC.Exts
 import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath )
 import System.FilePath  ( dropExtension, normalise )
 
+
+
+
 -- ---------------------------------------------------------------------------
 -- RTS Linker Interface
 -- ---------------------------------------------------------------------------
 
+data ShouldRetainCAFs
+  = RetainCAFs
+    -- ^ Retain CAFs unconditionally in linked Haskell code.
+    -- Note that this prevents any code from being unloaded.
+    -- It should not be necessary unless you are GHCi or
+    -- hs-plugins, which needs to be able call any function
+    -- in the compiled code.
+  | DontRetainCAFs
+    -- ^ Do not retain CAFs.  Everything reachable from foreign
+    -- exports will be retained, due to the StablePtrs
+    -- created by the module initialisation code.  unloadObj
+    -- frees these StablePtrs, which will allow the CAFs to
+    -- be GC'd and the code to be removed.
+
+initObjLinker :: ShouldRetainCAFs -> IO ()
+initObjLinker RetainCAFs = c_initLinker_ 1
+initObjLinker _ = c_initLinker_ 0
+
 lookupSymbol :: String -> IO (Maybe (Ptr a))
 lookupSymbol str_in = do
    let str = prefixUnderscore str_in
@@ -128,7 +149,7 @@ resolveObjs = do
 -- ---------------------------------------------------------------------------
 
 foreign import ccall unsafe "addDLL"                  c_addDLL                  :: CFilePath -> IO CString
-foreign import ccall unsafe "initLinker"              initObjLinker             :: IO ()
+foreign import ccall unsafe "initLinker_"             c_initLinker_             :: CInt -> IO ()
 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
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index a5774804ac..fefbdc32c1 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -45,7 +45,7 @@ import Unsafe.Coerce
 
 run :: Message a -> IO a
 run m = case m of
-  InitLinker -> initObjLinker
+  InitLinker -> initObjLinker RetainCAFs
   LookupSymbol str -> fmap toRemotePtr <$> lookupSymbol str
   LookupClosure str -> lookupClosure str
   LoadDLL str -> loadDLL str