git.iko.soy/Idris-dev
on 4afee31 help sign in
Idris-dev/src/Util/DynamicLinker.hs
71 lines 2.4 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
6import Foreign.LibFFI
7import Foreign.Ptr (nullPtr, FunPtr, nullFunPtr,castPtrToFunPtr)
8import System.Directory
9#ifndef WINDOWS
10import System.Posix.DynamicLinker
11#else
12import System.Win32.DLL
13import System.Win32.Types
14type DL = HMODULE
15#endif
17hostDynamicLibExt :: String
18#ifdef LINUX
19hostDynamicLibExt = "so"
20#elif MACOSX
21hostDynamicLibExt = "dylib"
22#elif WINDOWS
23hostDynamicLibExt = "dll"
24#else
25hostDynamicLibExt = error $ unwords
26 [ "Undefined file extension for dynamic libraries"
27 , "in Idris' Util.DynamicLinker."
28 ]
29#endif
31data ForeignFun = forall a. Fun { fun_name :: String
32 , fun_handle :: FunPtr a
33 }
35data DynamicLib = Lib { lib_name :: String
36 , lib_handle :: DL
37 }
39instance Eq DynamicLib where
40 (Lib a _) == (Lib b _) = a == b
42#ifndef WINDOWS
43tryLoadLib :: String -> IO (Maybe DynamicLib)
44tryLoadLib lib = do exactName <- doesFileExist lib
45 let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt
46 handle <- dlopen filename [RTLD_NOW, RTLD_GLOBAL]
47 if undl handle == nullPtr
48 then return Nothing
49 else return . Just $ Lib lib handle
52tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
53tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn
54 if cFn == nullFunPtr
55 then return Nothing
56 else return . Just $ Fun fn cFn
57#else
58tryLoadLib :: String -> IO (Maybe DynamicLib)
59tryLoadLib lib = do exactName <- doesFileExist lib
60 let filename = if exactName then lib else lib ++ "." ++ hostDynamicLibExt
61 handle <- loadLibrary filename
62 if handle == nullPtr
63 then return Nothing
64 else return . Just $ Lib lib handle
66tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
67tryLoadFn fn (Lib _ h) = do cFn <- getProcAddress h fn
68 if cFn == nullPtr
69 then return Nothing
70 else return . Just $ Fun fn (castPtrToFunPtr cFn)
71#endif