2 issues and 1 proposal for runInUnboundThread

[Bas van Dijk]

On Thu, Oct 21, 2010 at 11:29 AM, Simon Marlow <marlowsd at gmail.com> wrote:
> On 14/10/2010 23:00, Bas van Dijk wrote:
>>
>> Hello,
>>
>> I found two small issues in Control.Concurrent:
>>
>> * Both runInBoundThread and runInUnboundThread use throw instead of
>> throwIO. It's nicer to use throwIO in an IO context instead of throw
>> because it guarantees ordering with respect to other IO actions.
>>
>> * runInUnboundThread explicitly checks the blocked status of the
>> current thread which is redundant because mask also performs this
>> check.
>>
>> I also have a new proposal:
>>
>> When you throw an asynchronous exception to a thread which is
>> executing: `runInUnboundThread m`, m will keep executing and there's
>> no way to kill it.
>
>>
>>
>> I propose to catch asynchronous exceptions in runInUnboundThread and
>> throw them to the thread which is executing m. m in turn can decide to
>> catch or ignore them. In case m decides to ignore them or to rethrow
>> them, the exception will be rethrown in the current thread:
>>
>> runInUnboundThread :: IO a ->  IO a
>> runInUnboundThread action = do
>>   bound<- isCurrentThreadBound
>>   if bound
>>     then do
>>       mv<- newEmptyMVar
>>       mask $ \restore ->  do
>>         tid<- forkIO $ Exception.try (restore action)>>= putMVar mv
>>         let wait = takeMVar mv `Exception.catch` \(e :: SomeException) ->
>>                      Exception.throwTo tid e>>  wait
>>         wait>>= unsafeResult
>>     else action
>>
>> unsafeResult :: Either SomeException a ->  IO a
>> unsafeResult = either Exception.throwIO return
>
> I think it's ok, no objections here.  Do you have a use for
> runInUnboundThread, incidentally?

Not really. However I was planning to see if happstack-server could
benefit from runInUnboundThread. Currently it forks threads in the
main thread:

http://patch-tag.com/r/mae/happstack/snapshot/current/content/pretty/happstack-server/src/Happstack/Server/Internal/Listen.hs

Regards,

Bas