summaryrefslogtreecommitdiff
path: root/src/kahn_pipe.ml
diff options
context:
space:
mode:
Diffstat (limited to 'src/kahn_pipe.ml')
-rw-r--r--src/kahn_pipe.ml26
1 files changed, 12 insertions, 14 deletions
diff --git a/src/kahn_pipe.ml b/src/kahn_pipe.ml
index 2df8bc5..6e467ab 100644
--- a/src/kahn_pipe.ml
+++ b/src/kahn_pipe.ml
@@ -6,12 +6,11 @@ module Pipe: S = struct
type 'a in_port = in_channel
type 'a out_port = out_channel
- let new_channel =
- fun () ->
+ let new_channel () =
let i, o = Unix.pipe () in
Unix.in_channel_of_descr i, Unix.out_channel_of_descr o
- let get (c : 'a in_port) : 'a =
+ let get c =
fun () -> Marshal.from_channel c
let put x c =
@@ -60,17 +59,16 @@ module Pipe: S = struct
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
+ let launch p =
+ let pid = Unix.fork() in
+ if pid = 0 then begin
+ run p;
+ exit 0
+ end else
+ pid
+ in
+ let children = List.map launch l in
+ List.iter
(fun i -> try ignore(Unix.waitpid [] i) with _ -> ())
children
end