<div dir="ltr">2008/10/9 Claus Reinke <span dir="ltr">&lt;<a href="mailto:claus.reinke@talk21.com">claus.reinke@talk21.com</a>&gt;</span><br><div class="gmail_quote"><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
<div class="Ih2E3d"><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
I was wondering if it was possible to implement synchronous channels<br>
within STM. In particular, I&#39;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.<br>
</blockquote>
<br></div>
Assuming that retry blocks until something changes, you could associate<br>
a channel with a thread that encapsulates the transaction. Somewhat like this?</blockquote><div><br>You don&#39;t need an additional channel thread: <br><br></div></div>module SyncChan (SyncChan, send, recv, newSyncChan) where<br>
<br>import Control.Concurrent.STM<br>import Control.Monad<br>import Control.Concurrent<br><br>newtype SyncChan a = SC { unSC :: TVar (State a) }<br><br>data State a = Ready | Sent a | Received<br><br>newSyncChan :: STM (SyncChan a)<br>
newSyncChan = SC `fmap` newTVar Ready<br><br>send :: SyncChan a -&gt; a -&gt; IO ()<br>send (SC chan) x = do<br>&nbsp;&nbsp;&nbsp; atomically $ unsafeSend chan x<br>&nbsp;&nbsp;&nbsp; atomically $ waitReceiver chan<br><br>recv :: SyncChan a -&gt; STM a<br>
recv (SC chan) = do<br>&nbsp; s &lt;- readTVar chan<br>&nbsp; case s of<br>&nbsp;&nbsp;&nbsp; Sent s -&gt; writeTVar chan Received &gt;&gt; return s<br>&nbsp;&nbsp;&nbsp; _ -&gt; retry<br><br>unsafeSend chan x = do<br>&nbsp; s &lt;- readTVar chan<br>&nbsp; case s of<br>&nbsp;&nbsp;&nbsp; Ready -&gt; writeTVar chan (Sent x)<br>
&nbsp;&nbsp;&nbsp; _&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -&gt; retry<br><br>waitReceiver chan = do<br>&nbsp; s &lt;- readTVar chan<br>&nbsp; case s of<br>&nbsp;&nbsp;&nbsp; Received -&gt; writeTVar chan Ready<br>&nbsp;&nbsp;&nbsp; _&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -&gt; retry<br><br>x |&gt; f = fmap f x<br><br>test b = do<br>
&nbsp; (x,y) &lt;- atomically $ liftM2 (,) newSyncChan newSyncChan<br>&nbsp; forkIO $ join $ atomically $ -- since recv is in STM you can wait on multiple channels at the same time<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (recv x |&gt; print)&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; `mplus`<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (recv y |&gt; print)<br>&nbsp; if b<br>&nbsp;&nbsp;&nbsp;&nbsp; then send x &#39;a&#39;<br>&nbsp;&nbsp;&nbsp;&nbsp; else send y 1<br><br>as a bonus you can also try to send to the first available among multiple channels:<br>(this formulation uses ExistentialQuantification but it&#39;s just a convenience)<br>
<br>data Sending a = forall b. Sending (SyncChan b) b a<br><br>sendMulti :: [Sending a] -&gt; IO a<br>sendMulti [] = fail &quot;empty&quot;<br>sendMulti xs = do (m,r) &lt;- atomically $ msum $ map sending xs<br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; atomically m<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; return r<br><br>sending :: Sending t -&gt; STM (STM (), t)<br>sending (Sending (SC chan) x k) = do<br>&nbsp; unsafeSend chan x<br>&nbsp; return (waitReceiver chan,k)<br><br><br></div>