[Haskell-cafe] Help with "shootout"

Joel Reymont joelr1 at gmail.com
Tue Jan 3 06:37:09 EST 2006


It seems like the real difference between TChan and the Ch code below  
is that TChan is, basically, [TVar a] whereas Ch is MVar [a], plus  
the order is guaranteed for a TChan.

Now why would it matter so much speed-wise?

This is the CVS code. newTChanIO is exported but undocumented in GHC  
6.4.1. I'm not sure what purpose it serves.

-- | 'TChan' is an abstract type representing an unbounded FIFO channel.
data TChan a = TChan (TVar (TVarList a)) (TVar (TVarList a))

type TVarList a = TVar (TList a)
data TList a = TNil | TCons a (TVarList a)

newTChan :: STM (TChan a)
newTChan = do
   hole <- newTVar TNil
   read <- newTVar hole
   write <- newTVar hole
   return (TChan read write)

newTChanIO :: IO (TChan a)
newTChanIO = do
   hole <- newTVarIO TNil
   read <- newTVarIO hole
   write <- newTVarIO hole
   return (TChan read write)

writeTChan :: TChan a -> a -> STM ()
writeTChan (TChan _read write) a = do
   listend <- readTVar write -- listend == TVar pointing to TNil
   new_listend <- newTVar TNil
   writeTVar listend (TCons a new_listend)
   writeTVar write new_listend

readTChan :: TChan a -> STM a
readTChan (TChan read _write) = do
   listhead <- readTVar read
   head <- readTVar listhead
   case head of
     TNil -> retry
     TCons a tail -> do
         writeTVar read tail
         return a

On Jan 3, 2006, at 11:25 AM, Chris Kuklewicz wrote:

> The latest Ch code is very very short:
>
>> {- Ch : fast unordered channel implementation -}
>> newtype Ch a = Ch (MVar [a], MVar a)
>>
>> newCh = liftM2 (,) (newMVar []) newEmptyMVar >>= return.Ch
>>
>> readCh (Ch (w,r)) = takeMVar w >>= \lst ->
>>   case lst of (x:xs) -> putMVar w xs >> return x
>>               []     -> putMVar w [] >> takeMVar r
>>
>> writeCh (Ch (w,r)) x = do
>>   ok <- tryPutMVar r x -- opportunistic, helps for this problem
>>   unless ok $ takeMVar w >>= \lst -> do
>>     ok <- tryPutMVar r x  -- safe inside take/put
>>     putMVar w $ if ok then lst else (x:lst)
>>
>
> It could be used in general purpose code, note the parametric type "a"
> in "Ch a".  It makes absolutely no guarantees about the order of  
> values.
>  That means that the order they are written is unlikely to be the  
> order
> in which they are read.  Writes to the channel are non-blocking and  
> the
> "MVar [a]" holds some items waiting to be read (in LIFO order).

--
http://wagerlabs.com/







More information about the Haskell-Cafe mailing list