@@ -10,6 +10,10 @@ import Debug.Trace
1010
1111import Util.DynamicLinker
1212
13+import Control.Monad.Trans
14+import Control.Monad
15+import Data.Maybe
16+
1317
1418-- | Attempt to perform a side effect. Return either Just the next step in
1519-- evaluation (after performing the side effect through IO), or Nothing if no
@@ -41,8 +45,7 @@ call (FFun name argTypes retType) args = undefined
4145foreignFromTT :: TT Name -> Maybe Foreign
4246foreignFromTT t = case (unApply t) of
4347 (_, [(Constant (Str name)), args, ret]) ->
44− do trace (show $ unList args) $ return ()
45− argTy <- unList args
48+ do argTy <- unList args
4649 argFTy <- sequence $ map getFTy argTy
4750 retFTy <- getFTy ret
4851 return $ FFun name argFTy retFTy
@@ -67,9 +70,29 @@ unList tm = case unApply tm of
6770 return $ x:rest
6871 (f, args) -> Nothing
6972
73+toConst :: TT Name -> Maybe Const
74+toConst (Constant c) = Just c
75+toConst _ = Nothing
76+
7077stepForeign :: [TT Name] -> Idris (TT Name)
71−stepForeign (ty:fn:args) = do iputStrLn $ "FOREIGN CALL " ++ show (ty:fn:args)
72− iputStrLn $ show $ foreignFromTT fn
78+stepForeign (ty:fn:args) = do iputStrLn $ show $ foreignFromTT fn
79+ iputStrLn $ show $ sequence $ map toConst args
7380 iputStrLn ""
7481 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