From acfa0090d68a21be6c83815f484142b4eb814f4a Mon Sep 17 00:00:00 2001 From: Alex AUVOLAT Date: Tue, 13 May 2014 22:44:50 +0200 Subject: Change interface, update some stuff, new example... --- src/kahn_th.ml | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 src/kahn_th.ml (limited to 'src/kahn_th.ml') diff --git a/src/kahn_th.ml b/src/kahn_th.ml new file mode 100644 index 0000000..b6fccad --- /dev/null +++ b/src/kahn_th.ml @@ -0,0 +1,45 @@ + +module Th: S = struct + type 'a process = (unit -> 'a) + + type 'a channel = { q: 'a Queue.t ; m: Mutex.t; } + type 'a in_port = 'a channel + type 'a out_port = 'a channel + + let new_channel () = + let q = { q = Queue.create (); m = Mutex.create (); } in + q, q + + let io_read () = "" + let io_write s = print_string s; flush stdout + + let put v c () = + Mutex.lock c.m; + Queue.push v c.q; + Mutex.unlock c.m; + Thread.yield () + + let rec get c () = + try + Mutex.lock c.m; + let v = Queue.pop c.q in + Mutex.unlock c.m; + v + with Queue.Empty -> + Mutex.unlock c.m; + Thread.yield (); + get c () + + let doco l () = + let ths = List.map (fun f -> Thread.create f ()) l in + List.iter (fun th -> Thread.join th) ths + + let return v = (fun () -> v) + + let bind e e' () = + let v = e () in + Thread.yield (); + e' v () + + let run e = e () +end -- cgit v1.2.3