packages feed

mediawiki2latex-7.6: src/Parallel.hs

module Parallel where
import Control.Concurrent.MVar
import Control.Concurrent
 
(<$>) :: (a -> IO b) -> MVar a -> IO (MVar b)
f <$> x
  = do var <- newEmptyMVar
       _ <- forkOS (go var)
       return var
  where go v
          = do xx <- readMVar x
               result <- f xx
               putMVar v result
 
base :: a -> IO (MVar a)
base = pure . return
 
pure :: IO a -> IO (MVar a)
pure x
  = do var <- newEmptyMVar
       _ <- forkOS (go var)
       return var
  where go v
          = do result <- x
               putMVar v result
 
liftList :: ([a] -> IO b) -> [MVar a] -> IO (MVar b)
liftList f x
  = do var <- newEmptyMVar
       _ <- forkOS (go var)
       return var
  where go v
          = do xx <- mapM readMVar x
               result <- f xx
               putMVar v result
 
liftList2 :: ([a] -> IO b) -> MVar [MVar a] -> IO (MVar b)
liftList2 f x
  = do var <- newEmptyMVar
       _ <- forkOS (go var)
       return var
  where go v
          = do xxx <- readMVar x
               xx <- mapM readMVar xxx
               result <- f xx
               putMVar v result
 
liftA :: (a -> IO b) -> MVar a -> IO (MVar b)
liftA f x = f <$> x
 
liftA2 :: (a -> b -> IO c) -> MVar a -> MVar b -> IO (MVar c)
liftA2 f x y
  = do var <- newEmptyMVar
       _ <- forkOS (go var)
       return var
  where go v
          = do xx <- readMVar x
               yy <- readMVar y
               result <- f xx yy
               putMVar v result
 
liftA3 ::
       (a -> b -> c -> IO d) -> MVar a -> MVar b -> MVar c -> IO (MVar d)
liftA3 f x y z
  = do var <- newEmptyMVar
       _ <- forkOS (go var)
       return var
  where go v
          = do xx <- readMVar x
               yy <- readMVar y
               zz <- readMVar z
               result <- f xx yy zz
               putMVar v result