module Control.Concurrent.Futures.Buffer (
Buffer,
newBuf,
putBuf,
getBuf
) where
import Control.Concurrent.Futures.Futures as Futures
import Control.Concurrent.MVar
import System.IO
type Buffer a = (Cell Bool, Cell Bool, Cell a, Cell (Bool -> IO ()))
---Cells
type Cell a = MVar a
cell :: a -> IO (Cell a)
cell a = newMVar a
exchange :: Cell a -> a -> IO a
exchange a b = swapMVar a b
testAndSet :: Cell Bool -> IO t -> IO Bool
testAndSet cell code = do
val <- (exchange cell True)
case val of
True -> return True
False -> do
code
exchange cell False
wait :: Bool -> IO Bool
wait x = do
case x of
True -> return x
otherwise -> return x
newBuf :: IO (Buffer a)
newBuf = do
(h,f) <- Futures.newhandled
(h',f') <- Futures.newhandled
putg <- cell True
getg <- cell f
stored <- cell f'
handler <- cell h
return (putg,getg,stored,handler)
putBuf :: Buffer a -> a -> IO ()
putBuf (putg,getg,stored,handler) val = do
(h,f) <- Futures.newhandled
old_value <- exchange putg f
wait old_value
exchange stored val
old_handler <- exchange handler h
old_handler True
getBuf :: Buffer a -> IO a
getBuf (putg,getg,stored,handler) = do
(h,f) <- Futures.newhandled
(h',f') <- Futures.newhandled
old_value <- exchange getg f
wait old_value
val <- exchange stored f'
old_handler <- exchange handler h
old_handler True
return val