Re: [Caml-list] Smart ways to implement worker threads

[Rich Neswold <rich.neswold@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 850 bytes --]

On Thu, Jul 15, 2010 at 1:24 PM, Goswin von Brederlow <goswin-v-b@web.de>wrote:

> It is too bad I don't want to learn CML but use Ocaml. The CML examples
> from the book don't translate into ocaml since the interface is just a
> little bit different and those differences are what throws me off.
>


> So could you give a short example? E.g. the merge sort from the book.
>

You're right: OCaml's syntax differs enough from the text that it's annoying
to cut-n-paste the examples. Fortunately most example are a few lines of
code, so I didn't realize how difficult it could be on a larger example
(like the merge sort example.)

Attached is my translation of the mergeSort from the book. You get to play
with it and see if it works  :)

-- 
Rich

Google Reader: https://www.google.com/reader/shared/rich.neswold
Jabber ID: rich@neswold.homeunix.net

[-- Attachment #1.2: Type: text/html, Size: 1444 bytes --]

[-- Attachment #2: mergesort.ml --]
[-- Type: text/x-ocaml, Size: 1487 bytes --]

open Event

let mySend c d = sync (send c d)
and myRecv c = sync (receive c)

let spawn f =
  ignore (Thread.create f ())

let split (inCh, outCh1, outCh2) =
  let rec loop = function
    | (None, _, _) -> (mySend outCh1 None; mySend outCh2 None)
    | (x, out1, out2) -> (mySend out1 x; loop (myRecv inCh, out2, out1))
  in
    loop (myRecv inCh, outCh1, outCh2)

let merge (inCh1, inCh2, (outCh : int option channel)) =
  let rec copy (fromCh, toCh) =
    let rec loop v =
      begin
	mySend toCh v;
	match v with
	  | Some _ -> loop (myRecv fromCh)
	  | None -> ()
      end
    in
      loop (myRecv fromCh)
  and mergep (from1, from2) =
    match (from1, from2) with
      | (None, None) -> mySend outCh None
      | (_, None) -> (mySend outCh from1; copy (inCh1, outCh))
      | (None, _) -> (mySend outCh from2; copy (inCh2, outCh))
      | (Some a, Some b) ->
	  if a < b then
	    (mySend outCh from1; mergep (myRecv inCh1, from2))
	  else
	    (mySend outCh from2; mergep (from1, myRecv inCh2))
  in
    mergep (myRecv inCh1, myRecv inCh2)

let rec mergeSort () =
  let ch = new_channel() in
  let sort () =
    (match myRecv ch with
       | None -> ()
       | v1 ->
	   begin
	     (match myRecv ch with
		| None -> mySend ch v1
		| v2 ->
		    let ch1 = mergeSort()
		    and ch2 = mergeSort()
		    in
		      begin
			mySend ch1 v1;
			mySend ch2 v2;
			split (ch, ch1, ch2);
			merge (ch1, ch2, ch)
		      end);
	     mySend ch None
	   end)
  in
    (spawn sort; ch)