git.iko.soy/Idris-dev
on master help sign in
Find foreign funcs in libs
054c04eDavid Christiansen
src/Core/Execute.hs+28−5
compare with master
unifiedsplit
@@ -10,6 +10,10 @@ import Debug.Trace
10
10
11import Util.DynamicLinker
11import Util.DynamicLinker
12
12
13+import Control.Monad.Trans
14+import Control.Monad
15+import Data.Maybe
16+
13
17
14-- | Attempt to perform a side effect. Return either Just the next step in
18-- | Attempt to perform a side effect. Return either Just the next step in
15-- evaluation (after performing the side effect through IO), or Nothing if no
19-- evaluation (after performing the side effect through IO), or Nothing if no
@@ -41,8 +45,7 @@ call (FFun name argTypes retType) args = undefined
41foreignFromTT :: TT Name -> Maybe Foreign
45foreignFromTT :: TT Name -> Maybe Foreign
42foreignFromTT t = case (unApply t) of
46foreignFromTT t = case (unApply t) of
43 (_, [(Constant (Str name)), args, ret]) ->
47 (_, [(Constant (Str name)), args, ret]) ->
44− do trace (show $ unList args) $ return ()
45− argTy <- unList args
48+ do argTy <- unList args
46 argFTy <- sequence $ map getFTy argTy
49 argFTy <- sequence $ map getFTy argTy
47 retFTy <- getFTy ret
50 retFTy <- getFTy ret
48 return $ FFun name argFTy retFTy
51 return $ FFun name argFTy retFTy
@@ -67,9 +70,29 @@ unList tm = case unApply tm of
67 return $ x:rest
70 return $ x:rest
68 (f, args) -> Nothing
71 (f, args) -> Nothing
69
72
73+toConst :: TT Name -> Maybe Const
74+toConst (Constant c) = Just c
75+toConst _ = Nothing
76+
70stepForeign :: [TT Name] -> Idris (TT Name)
77stepForeign :: [TT Name] -> Idris (TT Name)
71−stepForeign (ty:fn:args) = do iputStrLn $ "FOREIGN CALL " ++ show (ty:fn:args)
78+stepForeign (ty:fn:args) = do iputStrLn $ show $ foreignFromTT fn
72− iputStrLn $ show $ foreignFromTT fn
79+ iputStrLn $ show $ sequence $ map toConst args
73 iputStrLn ""
80 iputStrLn ""
74 return $ mkApp (P Bound (UN "mkForeign") Erased) args
81 return $ mkApp (P Bound (UN "mkForeign") Erased) args
75−stepForeign _ = fail "Tried to call foreign function that wasn't mkForeign"
82+stepForeign _ = fail "Tried to call foreign function that wasn't mkForeign"
83+
84+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
85+mapMaybeM f [] = return []
86+mapMaybeM f (x:xs) = do rest <- mapMaybeM f xs
87+ x' <- f x
88+ case x' of
89+ Just x'' -> return (x'':rest)
90+ Nothing -> return rest
91+
92+findForeign :: String -> Idris (Maybe ForeignFun)
93+findForeign fn = do i <- getIState
94+ let libs = idris_dynamic_libs i
95+ fns <- mapMaybeM (lift . tryLoadFn fn) libs
96+ case fns of
97+ [f] -> return (Just f)
98+ _ -> return Nothing
src/Util/DynamicLinker.hs+11−2
@@ -1,10 +1,10 @@
1-- | Platform-specific dynamic linking support. Add new platforms to this file
1-- | Platform-specific dynamic linking support. Add new platforms to this file
2-- through conditional compilation.
2-- through conditional compilation.
3−
3+{-# LANGUAGE ExistentialQuantification #-}
4module Util.DynamicLinker where
4module Util.DynamicLinker where
5
5
6import Foreign.LibFFI
6import Foreign.LibFFI
7−import Foreign.Ptr (nullPtr)
7+import Foreign.Ptr (nullPtr, FunPtr, nullFunPtr)
8import System.Posix.DynamicLinker
8import System.Posix.DynamicLinker
9
9
10data DynamicLib = Lib { lib_name :: String
10data DynamicLib = Lib { lib_name :: String
@@ -17,3 +17,12 @@ tryLoadLib lib = do handle <- dlopen lib [RTLD_NOW]
17 then return Nothing
17 then return Nothing
18 else return . Just $ Lib lib handle
18 else return . Just $ Lib lib handle
19
19
20+data ForeignFun = forall a. Fun { fun_name :: String
21+ , fun_handle :: FunPtr a
22+ }
23+
24+tryLoadFn :: String -> DynamicLib -> IO (Maybe ForeignFun)
25+tryLoadFn fn (Lib _ h) = do cFn <- dlsym h fn
26+ if cFn == nullFunPtr
27+ then return Nothing
28+ else return . Just $ Fun fn cFn