@@ -409,10 +409,7 @@ data Foreign = FFun String [FType] FType deriving Show
409call :: Foreign -> [ExecVal] -> Exec (Maybe ExecVal)
409call :: Foreign -> [ExecVal] -> Exec (Maybe ExecVal)
410call (FFun name argTypes retType) args =
410call (FFun name argTypes retType) args =
411 do fn <- findForeign name
411 do fn <- findForeign name
413− Nothing -> return Nothing
414− Just f -> do res <- call' f args retType
412+ maybe (return Nothing) (\f -> Just . ioWrap <$> call' f args retType) fn
415− return . Just . ioWrap $ res
416 where call' :: ForeignFun -> [ExecVal] -> FType -> Exec ExecVal
413 where call' :: ForeignFun -> [ExecVal] -> FType -> Exec ExecVal
417 call' (Fun _ h) args (FArith (ATInt ITNative)) = do
414 call' (Fun _ h) args (FArith (ATInt ITNative)) = do
418 res <- execIO $ callFFI h retCInt (prepArgs args)
415 res <- execIO $ callFFI h retCInt (prepArgs args)
@@ -440,10 +437,9 @@ call (FFun name argTypes retType) args =
440-- lift $ free res
437-- lift $ free res
441 return (EConstant (Str hStr))
438 return (EConstant (Str hStr))
443− call' (Fun _ h) args FPtr = do res <- execIO $ callFFI h (retPtr retVoid) (prepArgs args)
440+ call' (Fun _ h) args FPtr = EPtr <$> (execIO $ callFFI h (retPtr retVoid) (prepArgs args))
445− call' (Fun _ h) args FUnit = do res <- execIO $ callFFI h retVoid (prepArgs args)
441+ call' (Fun _ h) args FUnit = do _ <- execIO $ callFFI h retVoid (prepArgs args)
446− return (EP Ref unitCon EErased)
442+ return $ EP Ref unitCon EErased
447-- call' (Fun _ h) args other = fail ("Unsupported foreign return type " ++ show other)
443-- call' (Fun _ h) args other = fail ("Unsupported foreign return type " ++ show other)
@@ -511,21 +507,16 @@ toConst (Constant c) = Just c
511toConst _ = Nothing
507toConst _ = Nothing
513stepForeign :: [ExecVal] -> Exec (Maybe ExecVal)
509stepForeign :: [ExecVal] -> Exec (Maybe ExecVal)
514−stepForeign (ty:fn:args) = do let ffun = foreignFromTT fn
510+stepForeign (ty:fn:args) = let ffun = foreignFromTT fn
515− f' <- case (call <$> ffun) of
511+ in case (call <$> ffun) of
516− Just f -> f args
512+ Just f -> f args
517− Nothing -> return Nothing
513+ Nothing -> return Nothing
519stepForeign _ = fail "Tried to call foreign function that wasn't mkForeignPrim"
514stepForeign _ = fail "Tried to call foreign function that wasn't mkForeignPrim"
521−mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
516+mapMaybeM :: (Functor m, Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
522mapMaybeM f [] = return []
517mapMaybeM f [] = return []
523mapMaybeM f (x:xs) = do rest <- mapMaybeM f xs
518mapMaybeM f (x:xs) = do rest <- mapMaybeM f xs
524− x' <- f x
519+ maybe rest (:rest) <$> f x
526− Just x'' -> return (x'':rest)
527− Nothing -> return rest
529findForeign :: String -> Exec (Maybe ForeignFun)
520findForeign :: String -> Exec (Maybe ForeignFun)
530findForeign fn = do est <- getExecState
521findForeign fn = do est <- getExecState
531 let libs = exec_dynamic_libs est
522 let libs = exec_dynamic_libs est