on master help sign in
Golf down some Maybe / Monad stuff.
commit732d79418898dd2781af70f40655ac14338bf3d0 authorLeif Warner <leif@janrain.com> dateSun 27 Oct 2013, 19:31 (13 years ago) parenta597154
1 file changed+10−19
src/Core/Execute.hs+10−19
src/Core/Execute.hs+10−19
@@ -409,10 +409,7 @@ data Foreign = FFun String [FType] FType deriving Show
409409call :: Foreign -> [ExecVal] -> Exec (Maybe ExecVal)
410410call (FFun name argTypes retType) args =
411411 do fn <- findForeign name
412− case fn of
413− Nothing -> return Nothing
414− Just f -> do res <- call' f args retType
415− return . Just . ioWrap $ res
412+ maybe (return Nothing) (\f -> Just . ioWrap <$> call' f args retType) fn
416413 where call' :: ForeignFun -> [ExecVal] -> FType -> Exec ExecVal
417414 call' (Fun _ h) args (FArith (ATInt ITNative)) = do
418415 res <- execIO $ callFFI h retCInt (prepArgs args)
@@ -440,10 +437,9 @@ call (FFun name argTypes retType) args =
440437-- lift $ free res
441438 return (EConstant (Str hStr))
442439
443− call' (Fun _ h) args FPtr = do res <- execIO $ callFFI h (retPtr retVoid) (prepArgs args)
444− return (EPtr res)
445− call' (Fun _ h) args FUnit = do res <- execIO $ callFFI h retVoid (prepArgs args)
446− return (EP Ref unitCon EErased)
440+ call' (Fun _ h) args FPtr = EPtr <$> (execIO $ callFFI h (retPtr retVoid) (prepArgs args))
441+ call' (Fun _ h) args FUnit = do _ <- execIO $ callFFI h retVoid (prepArgs args)
442+ return $ EP Ref unitCon EErased
447443-- call' (Fun _ h) args other = fail ("Unsupported foreign return type " ++ show other)
448444
449445
@@ -511,21 +507,16 @@ toConst (Constant c) = Just c
511507toConst _ = Nothing
512508
513509stepForeign :: [ExecVal] -> Exec (Maybe ExecVal)
514−stepForeign (ty:fn:args) = do let ffun = foreignFromTT fn
515− f' <- case (call <$> ffun) of
516− Just f -> f args
517− Nothing -> return Nothing
518− return f'
510+stepForeign (ty:fn:args) = let ffun = foreignFromTT fn
511+ in case (call <$> ffun) of
512+ Just f -> f args
513+ Nothing -> return Nothing
519514stepForeign _ = fail "Tried to call foreign function that wasn't mkForeignPrim"
520515
521−mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
516+mapMaybeM :: (Functor m, Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
522517mapMaybeM f [] = return []
523518mapMaybeM f (x:xs) = do rest <- mapMaybeM f xs
524− x' <- f x
525− case x' of
526− Just x'' -> return (x'':rest)
527− Nothing -> return rest
528−
519+ maybe rest (:rest) <$> f x
529520findForeign :: String -> Exec (Maybe ForeignFun)
530521findForeign fn = do est <- getExecState
531522 let libs = exec_dynamic_libs est