[MLton] cvs commit: MAIL: Initial port of CML from SML/NJ to MLton.

Stephen Weeks MLton@mlton.org
Sat, 1 May 2004 21:23:14 -0700


> This is an initial port of CML from SML/NJ to MLton.

Excellent.

> There was only one complicated transformation: blocking multiple base
> events. 
...
> To accomplish the same effect in the MLton thread implemenation, we
> have the following:
>       datatype 'a status =
> 	 ENABLED of {prio : int, doitFn : unit -> 'a}
>        | BLOCKED of {transId : trans_id,
> 		     cleanUp : unit -> unit,
> 		     next : unit -> rdy_thread} -> 'a
...
> I'm worried that this implementation might be a little expensive,
> starting a new thread for each blocked event (when there are only
> multiple blocked events in a synchronization group).  But, I don't
> see another way of implementing this behavior in the MLton thread
> model.

I see that a blockFn typically (always?) does an atomicSwitch, which
also creates a thread, so there are actually two thread creations per
blockFn.  Since the blockFns need to do this so that they can put
their thread in some appropriate queue, the only way out I can see
would be to change the type of the queues that are involved to be
queues of thunks that return threads instead of queues of threads.
For example the inQ field of Channel.chan would be changed from

 	inQ: (trans_id * 'a S.thread) Q.t,
to
 	inQ: (trans_id * (unit -> 'a S.thread)) Q.t

Then, the blocker functions would no longer need to grab the thread to
return to, they could simply be passed it.  So you could change them
to

       | BLOCKED of {transId: trans_id,
                     cleanUp: unit -> unit
                     continue: 'a S.Thread.t} -> unit

The blockFns would do the Thread.prepend to build the thread returned
by the thunk -- and now the Thread.prepend would happen only once, for
the thread that actually will start. 

Now ext passes the continue thread to each blockFn, and returns with
the next thread from the ready queus.

fun ext ([], blockFns) : 'a =
   S.atomicSwitch
   (fn (t : 'a S.thread) =>
    let
       val (transId, cleanUp) = TransID.mkFlg ()
       val _ =
	  List.app
	  (fn blockFn =>
	   blockFn {transId = transId,
		    cleanUp = cleanUp,
		    continue = t})
          blockFns
    in
       S.next ()
    end)