diff options
author | Alex AUVOLAT <alex.auvolat@ens.fr> | 2014-05-20 11:14:01 +0200 |
---|---|---|
committer | Alex AUVOLAT <alex.auvolat@ens.fr> | 2014-05-20 11:14:01 +0200 |
commit | c5e69a904e79e807c5b075c08ce82183133e7b4c (patch) | |
tree | 4e629a9c2b653660dc438f1c37d58e8fbf3870d6 /src/kahn_pipe.ml | |
parent | acfa0090d68a21be6c83815f484142b4eb814f4a (diff) | |
download | SystemeReseaux-Projet-c5e69a904e79e807c5b075c08ce82183133e7b4c.tar.gz SystemeReseaux-Projet-c5e69a904e79e807c5b075c08ce82183133e7b4c.zip |
Stuff.
Diffstat (limited to 'src/kahn_pipe.ml')
-rw-r--r-- | src/kahn_pipe.ml | 124 |
1 files changed, 62 insertions, 62 deletions
diff --git a/src/kahn_pipe.ml b/src/kahn_pipe.ml index f0bec97..9f3da0a 100644 --- a/src/kahn_pipe.ml +++ b/src/kahn_pipe.ml @@ -1,75 +1,75 @@ open Kahn module Pipe: S = struct - type 'a process = unit -> 'a + type 'a process = unit -> 'a - type 'a in_port = in_channel - type 'a out_port = out_channel + type 'a in_port = in_channel + type 'a out_port = out_channel - let new_channel = - fun () -> - let i, o = Unix.pipe () in - Unix.in_channel_of_descr i, Unix.out_channel_of_descr o + 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 get (c : 'a in_port) : 'a = + fun () -> Marshal.from_channel c - let put x c = - fun () -> - Marshal.to_channel c x []; - flush c - - let try_get block prt_list = - let fds = List.map fst prt_list in - let fds = List.map Unix.descr_of_in_channel fds in - let ok_fds, _, _ = Unix.select fds [] [] - (if block then -1.0 else 0.0) - in - match ok_fds with - | [] -> None - | fd::x -> - let chan, f = - List.find - (fun (s, _) -> Unix.descr_of_in_channel s = fd) - prt_list - in - Some(f (Marshal.from_channel chan)) - - let select prt_list = - fun () -> - match try_get true prt_list with - | Some x -> x - | None -> assert false + let put x c = + fun () -> + Marshal.to_channel c x []; + flush c + + let try_get block prt_list = + let fds = List.map fst prt_list in + let fds = List.map Unix.descr_of_in_channel fds in + let ok_fds, _, _ = Unix.select fds [] [] + (if block then -1.0 else 0.0) + in + match ok_fds with + | [] -> None + | fd::x -> + let chan, f = + List.find + (fun (s, _) -> Unix.descr_of_in_channel s = fd) + prt_list + in + Some(f (Marshal.from_channel chan)) + + let select prt_list = + fun () -> + match try_get true prt_list with + | Some x -> x + | None -> assert false - let select_default prt_list def = - fun () -> - match try_get false prt_list with - | Some x -> x - | None -> def () + let select_default prt_list def = + fun () -> + match try_get false prt_list with + | Some x -> x + | None -> def () - let return v = - fun () -> v + let return v = + fun () -> v - let bind e f = - fun () -> f (e ()) () - let bind_io = bind + let bind e f = + fun () -> f (e ()) () + let bind_io = bind - let run p = - p() + let run p = + p() - let doco l = - fun () -> - let children = - List.map - (fun p -> - match Unix.fork () with - | 0 -> - run p; - exit 0 - | i -> i) - l - in - List.iter - (fun x -> try ignore(Unix.waitpid [] x) with _ -> ()) - children + let doco l = + fun () -> + let children = + List.map + (fun p -> + match Unix.fork () with + | 0 -> + run p; + exit 0 + | i -> i) + l + in + List.iter + (fun i -> try ignore(Unix.waitpid [] i) with _ -> ()) + children end |