diff --git a/src/lib/eval.ml b/src/lib/eval.ml index a44afbe..9621cf2 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -113,6 +113,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let sigint_set ctx = ctx.signal_handler.sigint_set let fs ctx = ctx.fs let clear_local_state ctx = { ctx with local_state = [] } + let map_ignore ~sw v = Promise.map ~sw Exit.ignore v let with_pipeline_scope ?(force = false) ?(remove_vars = true) ctx fn = let saved_pipeline = ctx.current_pipeline in @@ -158,6 +159,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let file_creation_mode ctx = 0o666 - ctx.umask let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs + let immediate_built_in v = `Built_in (Promise.create_resolved @@ Ok v) let get_env ?(extra = []) ctx = let extra = @@ -200,6 +202,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct | `Process p -> J.add_process p j | `Rdr p -> J.add_rdr p j | `Built_in p -> J.add_built_in p j + | `Noop b -> J.add_noop b j | `Error p -> J.add_error p j | `Exit p -> J.add_exit p j in @@ -262,19 +265,19 @@ module Make (S : Types.State) (E : Types.Exec) = struct f "assignment-only: %a" yojson_pp (Ast.cmd_prefix_to_yojson prefix)); let ctx = collect_assignments ctx prefix in - let job = handle_job job (`Built_in (Exit.ignore ctx)) in + let job = handle_job job (`Noop (Exit.ignore ctx)) in loop (Exit.value ctx) job rest | Ast.SimpleCommand (Prefixed (prefix, Some executable, suffix)) :: rest -> let ctx = collect_assignments ~update:false ctx prefix in - let job = handle_job job (`Built_in (Exit.ignore ctx)) in + let job = handle_job job (`Noop (Exit.ignore ctx)) in loop (Exit.value ctx) job (Ast.SimpleCommand (Named (executable, suffix)) :: rest) | Ast.SimpleCommand (Named (executable, suffix)) :: rest -> ( let ctx, executable = word_expansion ctx executable in match ctx with | Exit.Nonzero _ as ctx -> - let job = handle_job job (`Built_in (Exit.ignore ctx)) in + let job = handle_job job (`Noop (Exit.ignore ctx)) in loop (Exit.value ctx) job rest | Exit.Zero ctx -> ( let executable, extra_args = @@ -301,7 +304,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let ctx, args = args ctx (extra_args @ suffix) in match ctx with | Exit.Nonzero _ as ctx -> - let job = handle_job job (`Built_in (Exit.ignore ctx)) in + let job = handle_job job (`Noop (Exit.ignore ctx)) in loop (Exit.value ctx) job rest | Exit.Zero ctx -> ( let some_read, some_write = @@ -331,7 +334,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Ok rdrs -> ( match Built_ins.of_args (executable :: args) with | Some (Error _) -> - (ctx, handle_job job (`Built_in (Exit.nonzero () 1))) + ( ctx, + handle_job job + (immediate_built_in (Exit.nonzero () 1)) ) | (None | Some (Ok (Command _))) as v -> ( let is_command, command_args, print_command = match v with @@ -348,7 +353,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct in let job = handle_job job - (`Built_in (updated >|= fun _ -> ())) + (immediate_built_in (Exit.ignore updated)) in Debug.Log.debug (fun f -> f "export %a" pp_args args); @@ -359,7 +364,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct in let job = handle_job job - (`Built_in (updated >|= fun _ -> ())) + (immediate_built_in (Exit.ignore updated)) in Debug.Log.debug (fun f -> f "readonly %a" pp_args args); @@ -370,7 +375,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct in let job = handle_job job - (`Built_in (updated >|= fun _ -> ())) + (immediate_built_in (Exit.ignore updated)) in loop (Exit.value updated) job rest | "exec" -> @@ -414,7 +419,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct close_stdout ~is_global some_write; (* TODO: Proper job stuff and redirects etc. *) let job = - handle_job job (`Built_in (Exit.ignore ctx)) + handle_job job + (immediate_built_in @@ Exit.ignore ctx) in loop { @@ -430,22 +436,28 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Some (Error _) -> ( ctx, handle_job job - (`Built_in (Exit.nonzero () 1)) ) + (immediate_built_in + (Exit.nonzero () 1)) ) | Some (Ok bi) -> let rdrs = make_child_rdrs_for_parent rdrs in let ctx = + Fiber.fork_promise ~sw:pipeline_switch + @@ fun () -> handle_built_in ~rdrs ~stdout:some_write ctx bi in let ctx = - ctx >|= fun ctx -> clear_local_state ctx + Promise.map ~sw:pipeline_switch + (Exit.map ~f:clear_local_state) + ctx in close_stdout ~is_global some_write; let job = match bi with | Built_ins.Exit _ -> + let ctx = Promise.await_exn ctx in let v_ctx = Exit.value ctx in if not v_ctx.subshell then exit v_ctx (Exit.code ctx) @@ -454,14 +466,19 @@ module Make (S : Types.State) (E : Types.Exec) = struct (`Exit (Exit.ignore ctx)) | _ -> handle_job job - (`Built_in (Exit.ignore ctx)) + (`Built_in + (map_ignore ~sw:pipeline_switch + ctx)) in let ctx = - Exit.map - ~f:(update_stdin ~stdin:some_read) + Promise.map ~sw:pipeline_switch + (Exit.map + ~f:(update_stdin ~stdin:some_read)) ctx in - loop (Exit.value ctx) job rest + loop + (Exit.value (Promise.await_exn ctx)) + job rest | _ -> ( let ctx, exec_and_args = if is_command then begin @@ -493,7 +510,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Exit.Nonzero _ as v -> let job = handle_job job - (`Built_in (Exit.ignore v)) + (`Noop (Exit.ignore v)) in let ctx = update_stdin ~stdin:some_read ctx @@ -515,13 +532,19 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Some (Ok bi) -> let rdrs = make_child_rdrs_for_parent rdrs in let ctx = + Fiber.fork_promise ~sw:pipeline_switch @@ fun () -> handle_built_in ~rdrs ~stdout:some_write ctx bi in - let ctx = ctx >|= fun ctx -> clear_local_state ctx in + let ctx = + Promise.map ~sw:pipeline_switch + (Exit.map ~f:clear_local_state) + ctx + in close_stdout ~is_global some_write; let job = match bi with | Built_ins.Exit _ -> + let ctx = Promise.await_exn ctx in let v_ctx = Exit.value ctx in if not v_ctx.subshell then begin if (Exit.value ctx).interactive then @@ -529,12 +552,18 @@ module Make (S : Types.State) (E : Types.Exec) = struct exit v_ctx (Exit.code ctx) end else handle_job job (`Exit (Exit.ignore ctx)) - | _ -> handle_job job (`Built_in (Exit.ignore ctx)) + | _ -> + handle_job job + (`Built_in + (map_ignore ~sw:pipeline_switch ctx)) in let ctx = - Exit.map ~f:(update_stdin ~stdin:some_read) ctx + Promise.map ~sw:pipeline_switch + (Exit.map ~f:(update_stdin ~stdin:some_read)) + ctx in - loop (Exit.value ctx) job rest)))) + loop (Exit.value @@ Promise.await_exn ctx) job rest))) + ) | CompoundCommand (c, rdrs) :: rest -> ( let some_read, some_write = stdout_for_pipeline ~sw:pipeline_switch ctx rest @@ -559,7 +588,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct handle_compound_command ctx c in close_stdout ~is_global some_write; - let job = handle_job job (`Built_in (ctx >|= fun _ -> ())) in + let job = handle_job job (`Noop (Exit.ignore ctx)) in let actual_ctx = Exit.value ctx in loop { diff --git a/src/lib/import.ml b/src/lib/import.ml index 57b27bf..4648027 100644 --- a/src/lib/import.ml +++ b/src/lib/import.ml @@ -1,5 +1,12 @@ let ( / ) = Eio.Path.( / ) +module Promise = struct + include Eio.Promise + + let map ~sw f v = + Eio.Fiber.fork_promise ~sw (fun () -> Eio.Promise.await_exn v |> f) +end + module Nlist = struct type 'a t = Singleton of 'a | Cons of 'a * 'a t diff --git a/src/lib/job.ml b/src/lib/job.ml index 8c1120e..6e7ee33 100644 --- a/src/lib/job.ml +++ b/src/lib/job.ml @@ -7,7 +7,8 @@ module Make (E : Types.Exec) = struct (* Process list is in reverse order *) processes : [ `Process of process - | `Built_in of unit Exit.t + | `Built_in of unit Exit.t Eio.Promise.or_exn + | `Noop of unit Exit.t | `Exit of unit Exit.t | `Rdr of unit Exit.t | `Error of int ] @@ -31,6 +32,7 @@ module Make (E : Types.Exec) = struct let add_error b t = { t with processes = List.cons (`Error b) t.processes } let add_rdr b t = { t with processes = List.cons (`Rdr b) t.processes } let add_exit b t = { t with processes = List.cons (`Exit b) t.processes } + let add_noop b t = { t with processes = List.cons (`Noop b) t.processes } let size t = List.length t.processes (* Section 2.9.2 https://pubs.opengroup.org/onlinepubs/9799919799/ *) @@ -42,7 +44,8 @@ module Make (E : Types.Exec) = struct if interactive then Eunix.delegate_control ~pgid:t.id @@ fun () -> E.await p else E.await p - | `Built_in b | `Exit b | `Rdr b -> b + | `Built_in b -> Eio.Promise.await_exn b + | `Exit b | `Noop b | `Rdr b -> b | `Error n -> Exit.nonzero () n in match (pipefail, t.processes) with diff --git a/src/lib/types.ml b/src/lib/types.ml index 9b83759..969fc41 100644 --- a/src/lib/types.ml +++ b/src/lib/types.ml @@ -120,7 +120,8 @@ module type Job = sig val make : int -> - [ `Built_in of unit Exit.t + [ `Built_in of unit Exit.t Eio.Promise.or_exn + | `Noop of unit Exit.t | `Error of int | `Exit of unit Exit.t | `Process of process @@ -135,10 +136,11 @@ module type Job = sig (** Set the ID of the job. *) val add_process : process -> t -> t - val add_built_in : unit Exit.t -> t -> t + val add_built_in : unit Exit.t Eio.Promise.or_exn -> t -> t val add_error : int -> t -> t val add_rdr : unit Exit.t -> t -> t val add_exit : unit Exit.t -> t -> t + val add_noop : unit Exit.t -> t -> t val size : t -> int (** Number of processes in this job *)