git.iko.soy/Idris-dev
on 7afa310 help sign in
Idris-dev/src/Util/DynamicLinker.hs
116 lines 4.3 kB history raw
1-- | Platform-specific dynamic linking support. Add new platforms to this file
2-- through conditional compilation.
3{-# LANGUAGE ExistentialQuantification, CPP #-}
4module Util.DynamicLinker (ForeignFun(..), DynamicLib(..), tryLoadLib, tryLoadFn) where
6#ifdef IDRIS_FFI
7import Foreign.LibFFI
8import Foreign.Ptr (Ptr(), nullPtr, FunPtr, nullFunPtr, castPtrToFunPtr)
9import System.Directory
10#ifndef WINDOWS
11import System.Posix.DynamicLinker
12import System.FilePath.Posix ((</>))
13#else
14import qualified Control.Exception as Exception (catch, IOException)
15import System.Win32.DLL
16import System.Win32.Types
17import System.FilePath.Windows ((</>))
18type DL = HMODULE
19#endif
21hostDynamicLibExt :: String
22#ifdef LINUX
23hostDynamicLibExt = "so"
24#elif MACOSX
25hostDynamicLibExt = "dylib"
26#elif WINDOWS
27hostDynamicLibExt = "dll"
28#elif FREEBSD
29hostDynamicLibExt = "so"
30#elif DRAGONFLY
31hostDynamicLibExt = "so"
32#else
33hostDynamicLibExt = error $ unwords
34 [ "Undefined file extension for dynamic libraries"
35 , "in Idris' Util.DynamicLinker."
36 ]
37#endif
39data ForeignFun = forall a. Fun { fun_name :: String
40 , fun_handle :: FunPtr a
41 }
43data DynamicLib = Lib { lib_name :: String
44 , lib_handle :: DL
45 }
47instance Eq DynamicLib where
48 (Lib a _) == (Lib b _) = a == b
50firstExisting :: [FilePath] -> IO (Maybe FilePath)
51firstExisting [] = return Nothing
52firstExisting (f:fs) = do exists <- doesFileExist f
53 if exists
54 then return (Just f)
55 else firstExisting fs
57libFileName :: [FilePath] -> String -> IO String
58libFileName 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
64#ifndef WINDOWS
65tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)
66tryLoadLib 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
73tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
74tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn
75 if cFn == nullFunPtr
76 then return Nothing
77 else return . Just $ Fun fn cFn
78#else
79tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)
80tryLoadLib 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
85 where nullPtrOnException :: Exception.IOException -> IO DL
86 nullPtrOnException e = return nullPtr
87 -- `show e` will however give broken error message
89tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
90tryLoadFn fn (Lib _ h) = do cFn <- getProcAddress h fn
91 if cFn == nullPtr
92 then return Nothing
93 else return . Just $ Fun fn (castPtrToFunPtr cFn)
94#endif
95#else
96-- no libffi, just add stubbs.
98data DynamicLib = Lib { lib_name :: String
99 , lib_handle :: ()
100 }
101 deriving Eq
103data ForeignFun = forall a. Fun { fun_name :: String
104 , fun_handle :: ()
105 }
107tryLoadLib :: [FilePath] -> String -> IO (Maybe DynamicLib)
108tryLoadLib fps lib = do putStrLn $ "WARNING: Cannot load '" ++ lib ++ "' at compile time because Idris was compiled without libffi support."
109 return Nothing
111tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
112tryLoadFn fn lib = do putStrLn $ "WARNING: Cannot load '" ++ fn ++ "' at compile time because Idris was compiled without libffi support."
113 return Nothing
114#endif