@@ -1,7 +1,7 @@
11-- | Platform-specific dynamic linking support. Add new platforms to this file
22-- through conditional compilation.
33{-# LANGUAGE ExistentialQuantification, CPP #-}
4−module Util.DynamicLinker where
4+module Util.DynamicLinker (ForeignFun(..), DynamicLib(..), tryLoadLib, tryLoadFn) where
55
66#ifdef IDRIS_FFI
77import Foreign.LibFFI
@@ -9,11 +9,13 @@ import Foreign.Ptr (Ptr(), nullPtr, FunPtr, nullFunPtr, castPtrToFunPtr)
99import System.Directory
1010#ifndef WINDOWS
1111import System.Posix.DynamicLinker
12+import System.FilePath.Posix ((</>))
1213#else
1314import qualified Control.Exception as Exception (catch, IOException)
1415import System.Win32.DLL
1516import System.Win32.Types
1617type DL = HMODULE
18+import System.FilePath.Windows ((</>))
1719#endif
1820
1921hostDynamicLibExt :: String
@@ -45,14 +47,27 @@ data DynamicLib = Lib { lib_name :: String
4547instance Eq DynamicLib where
4648 (Lib a _) == (Lib b _) = a == b
4749
50+firstExisting :: [FilePath] -> IO (Maybe FilePath)
51+firstExisting [] = return Nothing
52+firstExisting (f:fs) = do exists <- doesFileExist f
53+ if exists
54+ then return (Just f)
55+ else firstExisting fs
56+
57+libFileName :: [FilePath] -> String -> IO String
58+libFileName dirs lib = do let names = [lib, lib ++ "." ++ hostDynamicLibExt]
59+ cwd <- getCurrentDirectory
60+ found <- firstExisting $
61+ map ("."</>) names ++ [d </> f | d <- cwd:dirs, f <- names]
62+ return $ maybe (lib ++ "." ++ hostDynamicLibExt) id found
63+
4864#ifndef WINDOWS
49−tryLoadLib :: String -> IO (Maybe DynamicLib)
50−tryLoadLib lib = do exactName <- doesFileExist lib
51− let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt
52− handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]
53− if undl handle == nullPtr
54− then return Nothing
55− else return . Just $ Lib lib handle
65+tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)
66+tryLoadLib dirs lib = do filename <- libFileName dirs lib
67+ handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]
68+ if undl handle == nullPtr
69+ then return Nothing
70+ else return . Just $ Lib lib handle
5671
5772
5873tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
@@ -61,13 +76,12 @@ tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn
6176 then return Nothing
6277 else return . Just $ Fun fn cFn
6378#else
64−tryLoadLib :: String -> IO (Maybe DynamicLib)
65−tryLoadLib lib = do exactName <- doesFileExist lib
66− let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt
67− handle <- Exception.catch (loadLibrary filename) nullPtrOnException
68− if handle == nullPtr
69− then return Nothing
70− else return . Just $ Lib lib handle
79+tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)
80+tryLoadLib dirs lib = do filename <- libFileName dirs lib
81+ handle <- Exception.catch (loadLibrary filename) nullPtrOnException
82+ if handle == nullPtr
83+ then return Nothing
84+ else return . Just $ Lib lib handle
7185 where nullPtrOnException :: Exception.IOException -> IO DL
7286 nullPtrOnException e = return nullPtr
7387 -- `show e` will however give broken error message
@@ -90,7 +104,9 @@ tryLoadLib :: String -> IO (Maybe DynamicLib)
90104tryLoadLib lib = do putStrLn $ "WARNING: Cannot load '" ++ lib ++ "' at compile time because Idris was compiled without libffi support."
91105 return Nothing
92106
93−
107+tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
108+tryLoadLib fn lib = do putStrLn $ "WARNING: Cannot load '" ++ fn ++ "' at compile time because Idris was compiled without libffi support."
109+ return Nothing
94110#endif
95111
96112