<div dir="ltr"><br><br><div class="gmail_quote">On Wed, Oct 8, 2008 at 3:10 PM, roger peppe <span dir="ltr"><<a href="mailto:rogpeppe@gmail.com">rogpeppe@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">
I was wondering if it was possible to implement synchronous channels<br>
within STM. In particular, I'd like to have CSP-like send and recv primitives<br>
on a channel that each block until the other side arrives to complete<br>
the transaction.</blockquote><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;"><br>
<br>
I think I've convinced myself that it's not possible, but<br>
anyone care to differ?</blockquote><div><br></div><div>Hi Rog!! (Plan 9/Inferno Rog?)</div><div><br></div><div><a href="http://haskell.org/ghc/docs/latest/html/libraries/stm/Control-Concurrent-STM-TChan.html">http://haskell.org/ghc/docs/latest/html/libraries/stm/Control-Concurrent-STM-TChan.html</a> <-- isn't that it?<br>
</div><div><br></div><div>see writeTChan and readTChan. I assume readTChan is synchronous :-). writeTChan may be asynchronous for all I can tell (haven't looked deeply). </div><div><br></div><div>But I did write a concurrent prime sieve with it:</div>
<div><br></div><div><div>module Main where</div><div><br></div><div>{--</div><div>Haskell Concurrent and sometimes parallel prime sieve of eratosthenes</div><div><leimy2kNOSP@M@<a href="http://mac.com">mac.com</a>></div>
<div>David Leimbach</div><div>May 19, 2008</div><div><br></div><div>Communicates with typed data channels for sieving using the STM monad (Software Transactional Memory) to </div><div>share data between sparks. Sparks are created by forkIO, which can be scheduled to real OS threads.</div>
<div><br></div><div>The algorithm is sloppily contained in sieve :: TChan Int -> TChan Int -> IO () </div><div>which receives a number in the range of [2 .. 10000]. If this is the first number it has received, that</div>
<div>will forever be that spark's number to test for divisibility of subsequent numbers. After this assignment</div><div>it writes this value to the reader spark which prints it and waits for the next number to fall out of the</div>
<div>sieve. (which is why we start with 2)</div><div><br></div><div>This first sieve running spark will forkIO 1 more sieve spark that will be sent as it's first number, the</div><div>first number not evenly divisible by the value of the current sieve spark. </div>
<div><br></div><div>This process continues until the syncVal is received, which terminates the program and shuts down the reader</div><div>as well as the main loop.</div><div>--}</div><div><br></div><div>import Control.Monad.STM</div>
<div>import Control.Monad</div><div>import Control.Concurrent</div><div>import Control.Concurrent.STM.TChan</div><div><br></div><div>import System(getArgs)</div><div><br></div><div>syncVal :: Int</div><div>syncVal = -1</div>
<div><br></div><div>sieve :: TChan Int -> TChan Int -> IO ()</div><div>sieve inChan outChan = do</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> value <- atomically $ readTChan inChan</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> atomically $ writeTChan outChan value</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> newchan <- atomically $ newTChan</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> forkIO $ sieve newchan outChan</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> forever value newchan</div><div> where forever value newchan = do</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> subsequent <- atomically $ readTChan inChan</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> if subsequent `mod` value /= 0 </div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> then</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> do</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> atomically $ writeTChan newchan subsequent</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> forever value newchan</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> else if subsequent == syncVal</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> then</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> do </div><div><span class="Apple-tab-span" style="white-space:pre"> </span> atomically $ writeTChan outChan syncVal</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> return ()</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> else</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> forever value newchan</div><div><br></div><div>reader :: TChan Int -> TChan Char -> IO ()</div>
<div>reader chan syncChan = do </div><div><span class="Apple-tab-span" style="white-space:pre"> </span>x <- atomically $ readTChan chan </div><div><span class="Apple-tab-span" style="white-space:pre"> </span>if x /= syncVal</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> then</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> do </div><div>--<span class="Apple-tab-span" style="white-space:pre"> </span> putStrLn $ show x</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> reader chan syncChan</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> else</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> do</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> atomically $ writeTChan syncChan 'Q'</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> return ()</div><div><br>
</div><div>main :: IO ()</div><div>main = do</div><div> wChannel <- atomically $ newTChan</div><div> rChannel <- atomically $ newTChan</div><div> sChannel <- atomically $ newTChan</div><div> forkIO $ reader rChannel sChannel</div>
<div> forkIO $ sieve wChannel rChannel</div><div> x <- getArgs</div><div> putStrLn ("Searching for primes up to " ++ (head x))</div><div> forM_ [2 .. ((read (head x)) ::Int)] $ \i -> atomically $ writeTChan wChannel i</div>
<div> atomically $ writeTChan wChannel syncVal</div><div> atomically $ readTChan sChannel</div><div> return ()</div><div> </div><div><br></div></div><div><br></div><div><br></div><div> </div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">
<br>
<br>
cheers,<br>
rog.<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</blockquote></div><br></div>