From acfa0090d68a21be6c83815f484142b4eb814f4a Mon Sep 17 00:00:00 2001
From: Alex AUVOLAT <alex.auvolat@ens.fr>
Date: Tue, 13 May 2014 22:44:50 +0200
Subject: Change interface, update some stuff, new example...

---
 src/kahn.ml | 167 ++----------------------------------------------------------
 1 file changed, 4 insertions(+), 163 deletions(-)

(limited to 'src/kahn.ml')

diff --git a/src/kahn.ml b/src/kahn.ml
index a02ee24..08eac19 100644
--- a/src/kahn.ml
+++ b/src/kahn.ml
@@ -3,17 +3,18 @@ module type S = sig
 	type 'a in_port
 	type 'a out_port
 
-	val io_read: unit -> string
-	val io_write: string -> unit
-
 	val new_channel: unit -> 'a in_port * 'a out_port
 	val put: 'a -> 'a out_port -> unit process
 	val get: 'a in_port -> 'a process
 
+	val select: ('a in_port * ('a -> 'b)) list -> 'b process
+	val select_default: ('a in_port * ('a -> 'b)) list -> (unit -> 'b) -> 'b process
+
 	val doco: unit process list -> unit process
 
 	val return: 'a -> 'a process
 	val bind: 'a process -> ('a -> 'b process) -> 'b process
+	val bind_io: 'a process -> ('a -> 'b process) -> 'b process
 
 	val run: 'a process -> 'a
 end
@@ -49,163 +50,3 @@ module Lib (K : S) = struct
 end
 
 
-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
-
-module Seq: S = struct
-	type 'a process = (('a -> unit) option) -> unit
-
-	type 'a channel = 'a Queue.t
-	type 'a in_port = 'a channel
-	type 'a out_port = 'a channel
-
-	type task = unit -> unit
-
-	let tasks = Queue.create ()
-
-	let io_read () = ""
-	let io_write s = print_string s; flush stdout
-
-	let new_channel () =
-		let q = Queue.create () in
-		q, q
-
-	let put x c =
-		fun cont ->
-			Queue.push x c;
-			match cont with
-			| None -> ()
-			| Some cont ->	Queue.push cont tasks
-
-	let rec get c =
-		fun cont ->
-			try
-				let v = Queue.pop c in
-				match cont with
-				| None -> ()
-				| Some cont -> Queue.push (fun () -> cont v) tasks
-			with Queue.Empty ->
-				Queue.push (fun () -> get c cont) tasks
-
-	let doco l =
-		fun cont ->
-			List.iter (fun proc -> Queue.push (fun () -> proc None) tasks) l;
-			match cont with
-			| None -> ()
-			| Some cont -> Queue.push cont tasks
-
-	let return v =
-		fun cont ->
-			match cont with
-			| None -> ()
-			| Some cont -> Queue.push (fun () -> cont v) tasks
-
-	let bind e f =
-		fun cont ->
-			Queue.push (fun () -> e (Some (fun r -> f r cont))) tasks
-		
-	let run e =
-		let ret = ref None in
-		e (Some (fun v -> ret := Some v));
-		while not (Queue.is_empty tasks) do
-			let task = Queue.pop tasks in
-			task ()
-		done;
-		match !ret with
-		| Some k -> k
-		| None -> assert false
-
-end
-
-
-module Pipe: S = struct
-	type 'a process = unit -> 'a
-
-	type 'a in_port = in_channel
-	type 'a out_port = out_channel
-
-	let children = ref []
-
-	let io_read () = ""
-	let io_write s = print_string s; flush stdout
-
-	let new_channel =
-		fun () ->
-			let i, o = Unix.pipe () in
-			Unix.in_channel_of_descr i, Unix.out_channel_of_descr o
-
-	let get c =
-		fun () -> Marshal.from_channel c
-
-	let put x c =
-		fun () -> Marshal.to_channel c x []
-
-
-	let return v =
-		fun () -> v
-
-	let bind e f =
-		fun () -> f (e ()) ()
-
-	let run p =
-		let v = p() in
-		List.iter
-			(fun x -> try ignore(Unix.waitpid [] x) with _ -> ())
-			!children;
-		v
-
-	let doco l =
-		fun () ->
-			List.iter (fun p ->
-				let i = Unix.fork () in
-				if i = 0 then begin
-					children := [];
-					run p;
-					exit 0
-				end else begin
-					children := i::!children
-				end)
-			l
-end
-- 
cgit v1.2.3