patrick.sirref.org
Shells in OCaml
1module Make (E : Types.Exec) = struct
2 type process = E.process
3
4 type t = {
5 reap : unit Eio.Promise.t * unit Eio.Promise.u;
6 id : int;
7 (* Process list is in reverse order *)
8 processes :
9 [ `Process of process
10 | `Built_in of unit Exit.t
11 | `Exit of unit Exit.t
12 | `Rdr of unit Exit.t
13 | `Error of int ]
14 list;
15 }
16
17 let get_id t = t.id
18 let set_id new_id t = { t with id = new_id }
19 let get_reaper t = t.reap
20
21 let make id processes =
22 let reap = Eio.Promise.create () in
23 { id; processes; reap }
24
25 let add_process proc t =
26 { t with processes = List.cons (`Process proc) t.processes }
27
28 let add_built_in b t =
29 { t with processes = List.cons (`Built_in b) t.processes }
30
31 let add_error b t = { t with processes = List.cons (`Error b) t.processes }
32 let add_rdr b t = { t with processes = List.cons (`Rdr b) t.processes }
33 let add_exit b t = { t with processes = List.cons (`Exit b) t.processes }
34 let size t = List.length t.processes
35
36 (* Section 2.9.2 https://pubs.opengroup.org/onlinepubs/9799919799/ *)
37 let await_exit ~pipefail ~interactive t =
38 Eio.Promise.resolve (snd t.reap) ();
39 Eio.Fiber.yield ();
40 let await = function
41 | `Process p ->
42 if interactive then
43 Eunix.delegate_control ~pgid:t.id @@ fun () -> E.await p
44 else E.await p
45 | `Built_in b | `Exit b | `Rdr b -> b
46 | `Error n -> Exit.nonzero () n
47 in
48 match (pipefail, t.processes) with
49 | false, x :: _ -> await x
50 | _ -> Fmt.failwith "TODO: pipefail or no processes"
51end