X-Git-Url: https://git.xandkar.net/?p=dups.git;a=blobdiff_plain;f=dups.ml;h=b83b4be0e1708102abffb4f033594311023a69d6;hp=6628d99a4260ccecd0f2be5077ad557c3d99cc1d;hb=2a390e5aa565c7d2b12c748b72af487c250687b9;hpb=eb6d0f387ce3495e4263d8dd0866bd0d41e476bc diff --git a/dups.ml b/dups.ml index 6628d99..b83b4be 100644 --- a/dups.ml +++ b/dups.ml @@ -283,22 +283,21 @@ end = struct end let lord t ~njobs ~vassals ~ic ~ocs = - eprintf "[debug] [lord] started\n%!"; let active_vassals = ref njobs in let results = Queue.create () in let rec dispatch () = - match Ipc.recv ic with - | ((Exiting i) : ('input, 'output) msg_from_vassal) -> + match ((Ipc.recv ic) : ('input, 'output) msg_from_vassal) with + | Exiting i -> close_out ocs.(i); decr active_vassals; if !active_vassals = 0 then () else dispatch () - | ((Ready i) : ('input, 'output) msg_from_vassal) -> + | Ready i -> Ipc.send ocs.(i) (Job (next t)); dispatch () - | ((Result (i, result)) : ('input, 'output) msg_from_vassal) -> + | Result (i, result) -> Queue.add result results; Ipc.send ocs.(i) (Job (next t)); dispatch () @@ -316,15 +315,14 @@ end = struct of_queue results let vassal i ~f ~vassal_pipe_r ~lord_pipe_w = - eprintf "[debug] [vassal %d] started\n%!" i; let ic = Unix.in_channel_of_descr vassal_pipe_r in let oc = Unix.out_channel_of_descr lord_pipe_w in let rec work msg = Ipc.send oc msg; - match Ipc.recv ic with - | (Job (Some x) : 'input msg_from_lord) -> + match (Ipc.recv ic : 'input msg_from_lord) with + | Job (Some x) -> work (Result (i, (x, f x))) - | (Job None : 'input msg_from_lord) -> + | Job None -> Ipc.send oc (Exiting i) in work (Ready i);