Is it true that an exception is always terminates the thread?

Heka Treep zena.treep at gmail.com
Mon Jan 23 21:11:51 CET 2012


2012/1/23, Edward Z. Yang <ezyang at mit.edu>:
> Excerpts from Heka Treep's message of Mon Jan 23 13:56:47 -0500 2012:
>> adding the message queue (with Chan, MVar or STM) for each process will
>> not
>> help in this kind of imitation.
>
> Why not? Instead of returning a thread ID, send the write end of a Chan
> which the thread is waiting on.  You can send messages (normal or
> errors) using it.
>
> Edward
>

Yes, one can write this:

--------------------------------------------------------------------------------
import Control.Monad.STM
import Control.Concurrent
import Control.Concurrent.STM.TChan

spawn f = do
  mbox <- newTChanIO
  forkIO $ f mbox
  return mbox

(!) = writeTChan

actor mbox = do
  empty <- atomically $ isEmptyTChan mbox
  if empty
    then actor mbox
    else do
      val <- atomically $ readTChan mbox
      putStrLn val
      actor mbox

test = do
  mbox <- spawn actor
  atomically $ mbox ! "1"
  atomically $ mbox ! "2"
  atomically $ mbox ! "3"

-- > test
-- 1
-- 2
-- 3
--------------------------------------------------------------------------------

But there are several problems:

* The @actor@ function is busy checking the channel all the time.

* Caller and callee need to perform synchronizations (for the @Chan@)
or atomically transactions (for the @TChan@).

With exception-like messages one can write:

--------------------------------------------------------------------------------
actor = receive $
  \message -> case message of
    -- ... PM over message constructors ...
--------------------------------------------------------------------------------

and then:

--------------------------------------------------------------------------------
  child <- spawn actor
  child ! MessageCon1
  child ! MessageCon2
  -- ...
--------------------------------------------------------------------------------

where @receive@ is similar to @catch@ and (!) is similar to @throwTo at .

Scheduler will be the one who will wake the actor and give him the
message (well, like the @catch@ function passes an exception to a
thread). No need for busy waiting on the channel or it
synchronization.

I can say that Erlang's concurrency works like this. As well as GHC
exceptions, but they stop threads. I'm just interested in whether it
is their fundamental limitation?



More information about the Glasgow-haskell-users mailing list