    {-# LANGUAGE CPP, UnboxedTuples, MagicHash #-}
    {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
    --
    --  (c) The University of Glasgow 2002-2006
    --

    -- ---------------------------------------------------------------------------
    --      The dynamic linker for object code (.o .so .dll files)
    -- ---------------------------------------------------------------------------

    -- | Primarily, this module consists of an interface to the C-land
    -- dynamic linker.
    module GHCi.ObjLink
      ( initObjLinker, ShouldRetainCAFs(..)
      , loadDLL
      , loadArchive
      , loadObj
      , unloadObj
      , purgeObj
      , lookupSymbol
      , lookupClosure
      , resolveObjs
      , addLibrarySearchPath
      , removeLibrarySearchPath
      , findSystemLibrary
      )  where

    import Prelude -- See note [Why do we import Prelude here?]
    import GHCi.RemoteTypes
    import Control.Exception (throwIO, ErrorCall(..))
    import Control.Monad    ( when )
    import Foreign.C
    import Foreign.Marshal.Alloc ( free )
    import Foreign          ( nullPtr )
    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 :: ShouldRetainCAFs -> IO ()
    initObjLinker ShouldRetainCAFs
    RetainCAFs = CInt -> IO ()
    c_initLinker_ CInt
    1
    initObjLinker ShouldRetainCAFs
    _ = CInt -> IO ()
    c_initLinker_ CInt
    0

    lookupSymbol :: String -> IO (Maybe (Ptr a))
    lookupSymbol :: forall a. String -> IO (Maybe (Ptr a))
    lookupSymbol String
    str_in = do
       let str :: String
    str = String -> String
    prefixUnderscore String
    str_in
       forall a. String -> (CFilePath -> IO a) -> IO a
    withCAString String
    str forall a b. (a -> b) -> a -> b
    $ \CFilePath
    c_str -> do
         Ptr a
    addr <- forall a. CFilePath -> IO (Ptr a)
    c_lookupSymbol CFilePath
    c_str
         if Ptr a
    addr forall a. Eq a => a -> a -> Bool
    == forall a. Ptr a
    nullPtr
            then forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
            else forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> Maybe a
    Just Ptr a
    addr)

    lookupClosure :: String -> IO (Maybe HValueRef)
    lookupClosure :: String -> IO (Maybe HValueRef)
    lookupClosure String
    str = do
      Maybe (Ptr Any)
    m <- forall a. String -> IO (Maybe (Ptr a))
    lookupSymbol String
    str
      case Maybe (Ptr Any)
    m of
        Maybe (Ptr Any)
    Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
        Just (Ptr Addr#
    addr) -> case forall a. Addr# -> (# a #)
    addrToAny# Addr#
    addr of
          (# Any
    a #) -> forall a. a -> Maybe a
    Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall a. a -> IO (RemoteRef a)
    mkRemoteRef (Any -> HValue
    HValue Any
    a)

    prefixUnderscore :: String -> String
    prefixUnderscore :: String -> String
    prefixUnderscore
     | Bool
    cLeadingUnderscore = (Char
    '_'forall a. a -> [a] -> [a]
    :)
     | Bool
    otherwise          = forall a. a -> a
    id

    -- | loadDLL loads a dynamic library using the OS's native linker
    -- (i.e. dlopen() on Unix, LoadLibrary() on Windows).  It takes either
    -- an absolute pathname to the file, or a relative filename
    -- (e.g. "libfoo.so" or "foo.dll").  In the latter case, loadDLL
    -- searches the standard locations for the appropriate library.
    --
    loadDLL :: String -> IO (Maybe String)
    -- Nothing      => success
    -- Just err_msg => failure
    loadDLL :: String -> IO (Maybe String)
    loadDLL String
    str0 = do
      let
         -- On Windows, addDLL takes a filename without an extension, because
         -- it tries adding both .dll and .drv.  To keep things uniform in the
         -- layers above, loadDLL always takes a filename with an extension, and
         -- we drop it here on Windows only.
         str :: String
    str | Bool
    isWindowsHost = String -> String
    dropExtension String
    str0
             | Bool
    otherwise     = String
    str0
      --
      CFilePath
    maybe_errmsg <- forall a. String -> (CFilePath -> IO a) -> IO a
    withFilePath (String -> String
    normalise String
    str) forall a b. (a -> b) -> a -> b
    $ \CFilePath
    dll -> CFilePath -> IO CFilePath
    c_addDLL CFilePath
    dll
      if CFilePath
    maybe_errmsg forall a. Eq a => a -> a -> Bool
    == forall a. Ptr a
    nullPtr
            then forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
            else do String
    str <- CFilePath -> IO String
    peekCString CFilePath
    maybe_errmsg
                    forall a. Ptr a -> IO ()
    free CFilePath
    maybe_errmsg
                    forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a. a -> Maybe a
    Just String
    str)

    loadArchive :: String -> IO ()
    loadArchive :: String -> IO ()
    loadArchive String
    str = do
       forall a. String -> (CFilePath -> IO a) -> IO a
    withFilePath String
    str forall a b. (a -> b) -> a -> b
    $ \CFilePath
    c_str -> do
         Int
    r <- CFilePath -> IO Int
    c_loadArchive CFilePath
    c_str
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    r forall a. Eq a => a -> a -> Bool
    == Int
    0) (forall e a. Exception e => e -> IO a
    throwIO (String -> ErrorCall
    ErrorCall (String
    "loadArchive " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show String
    str forall a. [a] -> [a] -> [a]
    ++ String
    ": failed")))

    loadObj :: String -> IO ()
    loadObj :: String -> IO ()
    loadObj String
    str = do
       forall a. String -> (CFilePath -> IO a) -> IO a
    withFilePath String
    str forall a b. (a -> b) -> a -> b
    $ \CFilePath
    c_str -> do
         Int
    r <- CFilePath -> IO Int
    c_loadObj CFilePath
    c_str
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    r forall a. Eq a => a -> a -> Bool
    == Int
    0) (forall e a. Exception e => e -> IO a
    throwIO (String -> ErrorCall
    ErrorCall (String
    "loadObj " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show String
    str forall a. [a] -> [a] -> [a]
    ++ String
    ": 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 :: String -> IO ()
    unloadObj String
    str =
       forall a. String -> (CFilePath -> IO a) -> IO a
    withFilePath String
    str forall a b. (a -> b) -> a -> b
    $ \CFilePath
    c_str -> do
         Int
    r <- CFilePath -> IO Int
    c_unloadObj CFilePath
    c_str
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    r forall a. Eq a => a -> a -> Bool
    == Int
    0) (forall e a. Exception e => e -> IO a
    throwIO (String -> ErrorCall
    ErrorCall (String
    "unloadObj " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show String
    str forall a. [a] -> [a] -> [a]
    ++ String
    ": 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 :: String -> IO ()
    purgeObj String
    str =
       forall a. String -> (CFilePath -> IO a) -> IO a
    withFilePath String
    str forall a b. (a -> b) -> a -> b
    $ \CFilePath
    c_str -> do
         Int
    r <- CFilePath -> IO Int
    c_purgeObj CFilePath
    c_str
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    r forall a. Eq a => a -> a -> Bool
    == Int
    0) (forall e a. Exception e => e -> IO a
    throwIO (String -> ErrorCall
    ErrorCall (String
    "purgeObj " forall a. [a] -> [a] -> [a]
    ++ forall a. Show a => a -> String
    show String
    str forall a. [a] -> [a] -> [a]
    ++ String
    ": failed")))

    addLibrarySearchPath :: String -> IO (Ptr ())
    addLibrarySearchPath :: String -> IO (Ptr ())
    addLibrarySearchPath String
    str =
       forall a. String -> (CFilePath -> IO a) -> IO a
    withFilePath String
    str CFilePath -> IO (Ptr ())
    c_addLibrarySearchPath

    removeLibrarySearchPath :: Ptr () -> IO Bool
    removeLibrarySearchPath :: Ptr () -> IO Bool
    removeLibrarySearchPath = Ptr () -> IO Bool
    c_removeLibrarySearchPath

    findSystemLibrary :: String -> IO (Maybe String)
    findSystemLibrary :: String -> IO (Maybe String)
    findSystemLibrary String
    str = do
        CFilePath
    result <- forall a. String -> (CFilePath -> IO a) -> IO a
    withFilePath String
    str CFilePath -> IO CFilePath
    c_findSystemLibrary
        case CFilePath
    result forall a. Eq a => a -> a -> Bool
    == forall a. Ptr a
    nullPtr of
            Bool
    True  -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
            Bool
    False -> do String
    path <- CFilePath -> IO String
    peekFilePath CFilePath
    result
                        forall a. Ptr a -> IO ()
    free CFilePath
    result
                        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. a -> Maybe a
    Just String
    path

    resolveObjs :: IO Bool
    resolveObjs :: IO Bool
    resolveObjs = do
       Int
    r <- IO Int
    c_resolveObjs
       forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    r forall a. Eq a => a -> a -> Bool
    /= Int
    0)

    -- ---------------------------------------------------------------------------
    -- Foreign declarations to RTS entry points which does the real work;
    -- ---------------------------------------------------------------------------

    foreign import ccall unsafe "addDLL"                  c_addDLL                  :: CFilePath -> IO CString
    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
    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 ())
    foreign import ccall unsafe "findSystemLibrary"       c_findSystemLibrary       :: CFilePath -> IO CFilePath
    foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr() -> IO Bool

    -- -----------------------------------------------------------------------------
    -- Configuration

    #include "ghcautoconf.h"

    cLeadingUnderscore :: Bool
    #if defined(LEADING_UNDERSCORE)
    cLeadingUnderscore = True
    #else
    cLeadingUnderscore :: Bool
    cLeadingUnderscore = Bool
    False
    #endif

    isWindowsHost :: Bool
    #if defined(mingw32_HOST_OS)
    isWindowsHost = True
    #else
    isWindowsHost :: Bool
    isWindowsHost = Bool
    False
    #endif