3051cac · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

Merge pull request #869 from david-christiansen/dynamic-lib-search

3051cacEdwin Brady13 years ago

src/Idris/AbsSyntax.hs+4−1

compare with master

unifiedsplit

@@ -66,10 +66,13 @@ addFlag tgt f = do i <- getIState; putIState $ i { idris_cgflags = nub $ (tgt, f

66addDyLib :: [String] -> Idris (Either DynamicLib String)

67addDyLib libs = do i <- getIState

68 let ls = idris_dynamic_libs i

69+ let importdirs = opt_importdirs (idris_options i)

69 case mapMaybe (findDyLib ls) libs of

70 case mapMaybe (findDyLib ls) libs of

70 x:_ -> return (Left x)

71 x:_ -> return (Left x)

71 [] -> do

72 [] -> do

73+ handle <- lift . lift .

72− handle <- lift . lift $ mapM (\l -> catchIO (tryLoadLib l) (\_ -> return Nothing)) $ libs

74+ mapM (\l -> catchIO (tryLoadLib importdirs l)

75+ (\_ -> return Nothing)) $ libs

73 case msum handle of

76 case msum handle of

74 Nothing -> return (Right $ "Could not load dynamic alternatives \"" ++

77 Nothing -> return (Right $ "Could not load dynamic alternatives \"" ++

75 concat (intersperse "," libs) ++ "\"")

78 concat (intersperse "," libs) ++ "\"")

src/Idris/REPL.hs+3−2

@@ -895,8 +895,9 @@ process h fn (Missing n)

895 _ -> iPrintError $ "Ambiguous name"

896process h fn (DynamicLink l)

897 = do i <- getIState

898+ let importdirs = opt_importdirs (idris_options i)

898− let lib = trim l

899+ lib = trim l

899− handle <- lift . lift $ tryLoadLib lib

900+ handle <- lift . lift $ tryLoadLib importdirs lib

900 case handle of

901 case handle of

901 Nothing -> iPrintError $ "Could not load dynamic lib \"" ++ l ++ "\""

902 Nothing -> iPrintError $ "Could not load dynamic lib \"" ++ l ++ "\""

902 Just x -> do let libs = idris_dynamic_libs i

903 Just x -> do let libs = idris_dynamic_libs i

src/Util/DynamicLinker.hs+32−16

@@ -1,7 +1,7 @@

1-- | Platform-specific dynamic linking support. Add new platforms to this file

2-- through conditional compilation.

3{-# LANGUAGE ExistentialQuantification, CPP #-}

4−module Util.DynamicLinker where

4+module Util.DynamicLinker (ForeignFun(..), DynamicLib(..), tryLoadLib, tryLoadFn) where

6#ifdef IDRIS_FFI

7import Foreign.LibFFI

@@ -9,11 +9,13 @@ import Foreign.Ptr (Ptr(), nullPtr, FunPtr, nullFunPtr, castPtrToFunPtr)

9import System.Directory

10#ifndef WINDOWS

11import System.Posix.DynamicLinker

12+import System.FilePath.Posix ((</>))

12#else

13#else

13import qualified Control.Exception as Exception (catch, IOException)

14import qualified Control.Exception as Exception (catch, IOException)

14import System.Win32.DLL

15import System.Win32.DLL

15import System.Win32.Types

16import System.Win32.Types

16type DL = HMODULE

17type DL = HMODULE

18+import System.FilePath.Windows ((</>))

17#endif

19#endif

19hostDynamicLibExt :: String

21hostDynamicLibExt :: String

@@ -45,14 +47,27 @@ data DynamicLib = Lib { lib_name :: String

45instance Eq DynamicLib where

47instance Eq DynamicLib where

46 (Lib a _) == (Lib b _) = a == b

48 (Lib a _) == (Lib b _) = a == b

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+

48#ifndef WINDOWS

64#ifndef WINDOWS

49−tryLoadLib :: String -> IO (Maybe DynamicLib)

65+tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)

50−tryLoadLib lib = do exactName <- doesFileExist lib

66+tryLoadLib dirs lib = do filename <- libFileName dirs lib

51− let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt

52− handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]

67+ handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]

53− if undl handle == nullPtr

68+ if undl handle == nullPtr

54− then return Nothing

69+ then return Nothing

55− else return . Just $ Lib lib handle

70+ else return . Just $ Lib lib handle

58tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)

73tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)

@@ -61,13 +76,12 @@ tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn

61 then return Nothing

76 then return Nothing

62 else return . Just $ Fun fn cFn

77 else return . Just $ Fun fn cFn

63#else

78#else

64−tryLoadLib :: String -> IO (Maybe DynamicLib)

79+tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)

65−tryLoadLib lib = do exactName <- doesFileExist lib

80+tryLoadLib dirs lib = do filename <- libFileName dirs lib

66− let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt

67− handle <- Exception.catch (loadLibrary filename) nullPtrOnException

81+ handle <- Exception.catch (loadLibrary filename) nullPtrOnException

68− if handle == nullPtr

82+ if handle == nullPtr

69− then return Nothing

83+ then return Nothing

70− else return . Just $ Lib lib handle

84+ else return . Just $ Lib lib handle

71 where nullPtrOnException :: Exception.IOException -> IO DL

85 where nullPtrOnException :: Exception.IOException -> IO DL

72 nullPtrOnException e = return nullPtr

86 nullPtrOnException e = return nullPtr

73 -- `show e` will however give broken error message

87 -- `show e` will however give broken error message

@@ -90,7 +104,9 @@ tryLoadLib :: String -> IO (Maybe DynamicLib)

90tryLoadLib lib = do putStrLn $ "WARNING: Cannot load '" ++ lib ++ "' at compile time because Idris was compiled without libffi support."

104tryLoadLib lib = do putStrLn $ "WARNING: Cannot load '" ++ lib ++ "' at compile time because Idris was compiled without libffi support."

91 return Nothing

105 return Nothing

106

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

94#endif

110#endif

111

112