Change interface, update some stuff, new example...

1 files changed, 45 insertions, 0 deletions

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