git.iko.soy/Idris-dev
on 20ffcfd help sign in
Idris-dev/src/Util/DynamicLinker.hs
96 lines 3.2 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 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
12#else
13import qualified Control.Exception as Exception (catch, IOException)
14import System.Win32.DLL
15import System.Win32.Types
16type DL = HMODULE
17#endif
19hostDynamicLibExt :: String
20#ifdef LINUX
21hostDynamicLibExt = "so"
22#elif MACOSX
23hostDynamicLibExt = "dylib"
24#elif WINDOWS
25hostDynamicLibExt = "dll"
26#elif FREEBSD
27hostDynamicLibExt = "so"
28#elif DRAGONFLY
29hostDynamicLibExt = "so"
30#else
31hostDynamicLibExt = error $ unwords
32 [ "Undefined file extension for dynamic libraries"
33 , "in Idris' Util.DynamicLinker."
34 ]
35#endif
37data ForeignFun = forall a. Fun { fun_name :: String
38 , fun_handle :: FunPtr a
39 }
41data DynamicLib = Lib { lib_name :: String
42 , lib_handle :: DL
43 }
45instance Eq DynamicLib where
46 (Lib a _) == (Lib b _) = a == b
48#ifndef WINDOWS
49tryLoadLib :: String -> IO (Maybe DynamicLib)
50tryLoadLib 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
58tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
59tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn
60 if cFn == nullFunPtr
61 then return Nothing
62 else return . Just $ Fun fn cFn
63#else
64tryLoadLib :: String -> IO (Maybe DynamicLib)
65tryLoadLib 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
71 where nullPtrOnException :: Exception.IOException -> IO DL
72 nullPtrOnException e = return nullPtr
73 -- `show e` will however give broken error message
75tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
76tryLoadFn fn (Lib _ h) = do cFn <- getProcAddress h fn
77 if cFn == nullPtr
78 then return Nothing
79 else return . Just $ Fun fn (castPtrToFunPtr cFn)
80#endif
81#else
82-- no libffi, just add stubbs.
84data DynamicLib = Lib { lib_name :: String
85 , lib_handle :: ()
86 }
87 deriving Eq
89tryLoadLib :: String -> IO (Maybe DynamicLib)
90tryLoadLib lib = do putStrLn $ "WARNING: Cannot load '" ++ lib ++ "' at compile time because Idris was compiled without libffi support."
91 return Nothing
94#endif