<div><div><div>I played a bit the the bracket function that timeout uses, but got strange results (both on Windows and OSX).</div><div><br></div><div>Ugly code fragment follows:</div><div><br></div><div>-%&lt;-------------------------------------------------------------------------------------------------</div>
<div><br></div><div>import Prelude hiding (catch)</div><div><br></div><div>import Control.Concurrent</div><div>import Control.Concurrent.MVar</div><div>import Control.Exception</div><div>import System.IO</div><div>import Data.Char</div>
<div><br></div><div>withThread a b = bracket (forkIO a) kill (const b)</div><div>&nbsp;&nbsp; &nbsp;where</div><div>&nbsp;&nbsp; &nbsp; &nbsp;kill id = do</div><div>&nbsp;&nbsp; &nbsp; &nbsp; &nbsp;putStrLn (&quot;Killing &quot;++show id++&quot;\n&quot;)</div><div>&nbsp;&nbsp; &nbsp; &nbsp; &nbsp;killThread id</div>
<div>&nbsp;&nbsp; &nbsp; &nbsp; &nbsp;putStrLn (&quot;Killed &quot;++show id++&quot;\n&quot;)</div><div><br></div><div>race a b = do</div><div>&nbsp;&nbsp; &nbsp;v &lt;- newEmptyMVar</div><div>&nbsp;&nbsp; &nbsp;let t x = x &gt;&gt;= putMVar v</div><div>&nbsp;&nbsp; &nbsp;withThread (t a) $ withThread (t b) $ takeMVar v</div>
<div><br></div><div>forkPut :: IO a -&gt; MVar a -&gt; IO ThreadId</div><div>forkPut act v = forkIO ((act &gt;&gt;= putMVar v) `catch` uhandler `catch` bhandler)</div><div>&nbsp;where</div><div>&nbsp;&nbsp; uhandler (ErrorCall &quot;Prelude.undefined&quot;) = return ()</div>
<div>&nbsp;&nbsp; uhandler err &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = throw err</div><div>&nbsp;&nbsp; bhandler BlockedOnDeadMVar &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = return ()</div><div><br></div><div>sleep n = do</div><div>&nbsp;&nbsp;tid &lt;- myThreadId</div><div>&nbsp;&nbsp;putStrLn (&quot;Sleeping &quot;++show n++&quot; sec on &quot;++show tid++&quot;\n&quot;)</div>
<div>&nbsp;&nbsp;threadDelay (n*1000000)</div><div>&nbsp;&nbsp;putStrLn (&quot;Slept &quot;++show n++&quot; sec on &quot;++show tid++&quot;\n&quot;)</div><div><br></div><div>f = sleep 2 `race` sleep 3</div><div><br></div><div>g = f `race` sleep 1</div>
<div><br></div><div>main = do</div><div>&nbsp;&nbsp;hSetBuffering stdout LineBuffering</div><div>&nbsp;&nbsp;g</div><div>&nbsp;&nbsp;</div><div>-%&lt;-------------------------------------------------------------------------------------------------</div>
<div><br></div><div>Here&#39;s the output when running with GHCI:</div><div>&nbsp;</div><div>C:\temp&gt;runghc racetest</div><div>Sleeping 1 sec on ThreadId 26</div><div>Sleeping 2 sec on ThreadId 27</div><div>Sleeping 3 sec on ThreadId 28</div>
<div>Slept 1 sec on ThreadId 26</div><div>Killing ThreadId 26</div><div>Killed ThreadId 26</div><div>Killing ThreadId 25</div><div>Killed ThreadId 25</div><div>Killing ThreadId 28</div><div>Killed ThreadId 28</div><div><br>
</div><div>Fine, all threads got killed.&nbsp;</div><div><br></div><div>Here&#39;s the output from an EXE compiled with GHC -threaded, but run without +RTS -N2</div><div><br></div><div>C:\temp&gt; racetest</div><div>Sleeping 1 sec on ThreadId 5</div>
<div>Sleeping 3 sec on ThreadId 7</div><div>Sleeping 2 sec on ThreadId 6</div><div>Slept 1 sec on ThreadId 5</div><div>Killing ThreadId 5</div><div>Killed ThreadId 5</div><div>Killing ThreadId 4</div><div>Killed ThreadId 4</div>
<div>Killing ThreadId 7</div><div><br></div><div>So "Killed ThreadId 7&quot; is not printed here. What did I do wrong?</div><div><br></div><div>Here&#39;s the output from an EXE compiled with GHC -threaded, but run with +RTS -N2</div>
<div><br></div><div>C:\temp&gt; racetest +RTS -N2</div><div>Sleeping 1 sec on ThreadId 5</div><div>Sleeping 3 sec on ThreadId 7</div><div>Sleeping 2 sec on ThreadId 6</div><div>Slept 1 sec on ThreadId 5</div><div><br></div>
<div>Killing ThreadId 5</div><div>Killed ThreadId 5</div><div>Killing ThreadId 4</div><div>Killed ThreadId 4</div><div>Killing ThreadId 7</div><div>Killed ThreadId 7</div><div><br></div><div>This works again.&nbsp;</div><div><br>
</div><div>Is this intended behavior?</div><div><br></div><div>Cheers,</div><div>Peter Verswyvelen</div><div>CTO - Anygma</div><div><br></div><div class="gmail_quote">On Fri, Dec 19, 2008 at 10:48 AM, Simon Marlow <span dir="ltr">&lt;<a href="mailto:marlowsd@gmail.com">marlowsd@gmail.com</a>&gt;</span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">Sounds like you should use an exception handler so that when the parent dies it also kills its children. &nbsp;Be very careful with race conditions ;-)<br>

<br>
For a good example of how to do this sort of thing, see<br>
<br>
<a href="http://www.haskell.org/ghc/docs/latest/html/libraries/base/System-Timeout.html" target="_blank">http://www.haskell.org/ghc/docs/latest/html/libraries/base/System-Timeout.html</a><br>
<br>
the docs are sadly missing the source links at the moment, I&#39;m not sure why, but you can find the source in<br>
<br>
<a href="http://darcs.haskell.org/packages/base/System/Timeout.hs" target="_blank">http://darcs.haskell.org/packages/base/System/Timeout.hs</a><br>
<br>
Cheers,<br>
 &nbsp; &nbsp; &nbsp; &nbsp;Simon<br>
<br>
Conal Elliott wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div class="Ih2E3d">
(I&#39;m broadening the discussion to include haskell-cafe.)<br>
<br>
Andy -- What do you mean by &quot;handling all thread forking locally&quot;?<br>
<br>
 &nbsp;- Conal<br>
<br></div><div><div></div><div class="Wj3C7c">
On Thu, Dec 18, 2008 at 1:57 PM, Andy Gill &lt;<a href="mailto:andygill@ku.edu" target="_blank">andygill@ku.edu</a> &lt;mailto:<a href="mailto:andygill@ku.edu" target="_blank">andygill@ku.edu</a>&gt;&gt; wrote:<br>
<br>
 &nbsp; &nbsp;Conal, et. al,<br>
<br>
 &nbsp; &nbsp;I was looking for exactly this about 6~9 months ago. I got the<br>
 &nbsp; &nbsp;suggestion to pose it as a challenge<br>
 &nbsp; &nbsp;to the community by Duncan Coutts. What you need is thread groups,<br>
 &nbsp; &nbsp; where for a ThreadId, you can send a signal<br>
 &nbsp; &nbsp;to all its children, even missing generations if needed. <br>
 &nbsp; &nbsp;I know of no way to fix this at the Haskell level without handling<br>
 &nbsp; &nbsp;all thread forking locally. <br>
 &nbsp; &nbsp;Perhaps a ICFP paper about the pending implementation :-) but I&#39;m<br>
 &nbsp; &nbsp;not sure about the research content here.<br>
<br>
 &nbsp; &nbsp;Again, there is something deep about values with lifetimes. <br>
 &nbsp; &nbsp;Andy Gill<br>
<br>
<br>
 &nbsp; &nbsp;On Dec 18, 2008, at 3:43 PM, Conal Elliott wrote:<br>
<br>
</div></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div><div></div><div class="Wj3C7c">
 &nbsp; &nbsp;I realized in the shower this morning that there&#39;s a serious flaw<br>
 &nbsp; &nbsp;in my unamb implementation as described in<br>
 &nbsp; &nbsp;<a href="http://conal.net/blog/posts/functional-concurrency-with-unambiguous-choice" target="_blank">http://conal.net/blog/posts/functional-concurrency-with-unambiguous-choice</a>.  &nbsp; &nbsp;I&#39;m looking for ideas for fixing the flaw. &nbsp;Here&#39;s the code for<br>

 &nbsp; &nbsp;racing computations:<br>
<br>
 &nbsp; &nbsp; &nbsp; &nbsp;race :: IO a -&gt; IO a -&gt; IO a<br>
 &nbsp; &nbsp; &nbsp; &nbsp;a `race` b = do v &nbsp;&lt;- newEmptyMVar<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;ta &lt;- forkPut a v<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;tb &lt;- forkPut b v<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;x &nbsp;&lt;- takeMVar &nbsp;v<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;killThread ta<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;killThread tb<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;return x<br>
<br>
 &nbsp; &nbsp; &nbsp; &nbsp;forkPut :: IO a -&gt; MVar a -&gt; IO ThreadId<br>
 &nbsp; &nbsp; &nbsp; &nbsp;forkPut act v = forkIO ((act &gt;&gt;= putMVar v) `catch` uhandler<br>
 &nbsp; &nbsp;`catch` bhandler)<br>
 &nbsp; &nbsp; &nbsp; &nbsp; where<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; uhandler (ErrorCall &quot;Prelude.undefined&quot;) = return ()<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; uhandler err &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = throw err<br>
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; bhandler BlockedOnDeadMVar &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = return ()<br>
<br>
 &nbsp; &nbsp;The problem is that each of the threads ta and tb may have spawned<br>
 &nbsp; &nbsp;other threads, directly or indirectly. &nbsp;When I kill them, they<br>
 &nbsp; &nbsp;don&#39;t get a chance to kill their sub-threads.<br>
<br>
 &nbsp; &nbsp;Perhaps I want some form of garbage collection of threads, perhaps<br>
 &nbsp; &nbsp;akin to Henry Baker&#39;s paper &quot;The Incremental Garbage Collection of<br>
 &nbsp; &nbsp;Processes&quot;. &nbsp;As with memory GC, dropping one consumer would<br>
 &nbsp; &nbsp;sometimes result is cascading de-allocations. &nbsp;That cascade is<br>
 &nbsp; &nbsp;missing from my implementation.<br>
<br>
 &nbsp; &nbsp;Or maybe there&#39;s a simple and dependable manual solution,<br>
 &nbsp; &nbsp;enhancing the method above.<br>
<br>
 &nbsp; &nbsp;Any ideas?<br>
<br>
 &nbsp; &nbsp; &nbsp; - Conal<br>
<br>
<br>
 &nbsp; &nbsp;_______________________________________________<br>
 &nbsp; &nbsp;Reactive mailing list<br></div></div>
 &nbsp; &nbsp;<a href="mailto:Reactive@haskell.org" target="_blank">Reactive@haskell.org</a> &lt;mailto:<a href="mailto:Reactive@haskell.org" target="_blank">Reactive@haskell.org</a>&gt;<div class="Ih2E3d"><br>
 &nbsp; &nbsp;<a href="http://www.haskell.org/mailman/listinfo/reactive" target="_blank">http://www.haskell.org/mailman/listinfo/reactive</a><br>
</div></blockquote>
<br>
<br>
<br>
------------------------------------------------------------------------<br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">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>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org" target="_blank">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></div>