[Haskell-cafe] synchronous channels in STM

[Arnar Birgisson]

Hi there,

2008/10/9 David Leimbach <leimy2k at gmail.com>:
> see writeTChan and readTChan.  I assume readTChan is synchronous :-).
>  writeTChan may be asynchronous for all I can tell (haven't looked deeply).

writeTChan is asynchronous, i.e. channels in this case are unbounded buffers.

> But I did write a concurrent prime sieve with it:

I did the same, with the one-place-buffers (the MVars implemented over
STM). Be warned that there is no stop condition, this just keeps
printing primes forever.

import Control.Concurrent (forkIO)
import Control.Concurrent.STM

-- MVars from the STM paper
type MVar a = TVar (Maybe a)

newEmptyMVar :: STM (MVar a)
newEmptyMVar = newTVar Nothing

takeMVar :: MVar a -> STM a
takeMVar mv
 = do v <- readTVar mv
      case v of
        Nothing  -> retry
        Just val -> do writeTVar mv Nothing
                       return val

putMVar :: MVar a -> a -> STM ()
putMVar mv val
 = do v <- readTVar mv
      case v of
        Nothing  -> writeTVar mv (Just val)
        Just _   -> retry

-- Sieve
forever a = do a; forever a

pfilter :: Int -> MVar Int -> MVar Int -> IO ()
pfilter p in_ out =
    forever $ do atomically $ do v <- takeMVar in_
                                 if v `mod` p /= 0
                                    then putMVar out v
                                    else return ()

sieve :: MVar Int -> MVar Int -> IO ()
sieve in_ out =
    do p <- atomically $ takeMVar in_
       atomically $ putMVar out p
       ch <- atomically $ newEmptyMVar
       forkIO $ pfilter p in_ ch
       sieve ch out

feeder :: MVar Int -> IO ()
feeder out = feed' 2
           where
             feed' i = do atomically $ putMVar out i
                          feed' (i+1)

printer :: MVar Int -> IO ()
printer in_ = forever $ do v <- atomically $ takeMVar in_
                           putStrLn $ show v

main :: IO ()
main = do in_ <- atomically newEmptyMVar
          out <- atomically newEmptyMVar
          forkIO $ feeder in_
          forkIO $ printer out
          forkIO $ sieve in_ out
          return ()


cheers,
Arnar