diff --git a/bench/README.md b/bench/README.md index 2613a31..1cd2e8f 100644 --- a/bench/README.md +++ b/bench/README.md @@ -3,8 +3,11 @@ ```sh $ ./bench.exe - name, major-allocated, minor-allocated, monotonic-clock - count 1000, 3432852.000000, 67367128.000000, 2338362566.000000 - count 2500, 8525326.000000, 168547399.000000, 5889125042.000000 - count 5000, 17046435.000000, 336965433.000000, 12299865266.000000 + name, major-allocated, minor-allocated, monotonic-clock + bench/count 10, 33288.928571, 276123.921429, 17938694.735714 + bench/count 50, 154161.900000, 1236363.100000, 82434000.866667 + bench/count 100, 304196.200000, 2489845.200000, 161951876.400000 + bench/noop 10, 4.755783, 9356.412265, 22565.037398 + bench/noop 50, 74.613901, 54175.014009, 123743.201599 + bench/noop 100, 214.415321, 110480.221914, 276927.142825 ``` diff --git a/bench/bench.ml b/bench/bench.ml index 64b03a7..f511ded 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -37,9 +37,23 @@ let count env iterations = let ctx = setup_shell ~sw env in Staged.stage (fun () -> run_shell ctx ast) +let noop env iterations = + let script = List.init iterations (fun _ -> ":") |> String.concat "\n" in + let ast = Merry.Ast.of_string script in + Eio.Switch.run @@ fun sw -> + let ctx = setup_shell ~sw env in + Staged.stage (fun () -> run_shell ctx ast) + let suite env = - Test.make_indexed ~name:"count" ~fmt:"%s %7d" ~args:[ 1000; 2500; 5000 ] - (count env) + let count = + Test.make_indexed ~name:"count" ~fmt:"%s %7d" ~args:[ 10; 50; 100 ] + (count env) + in + let noop = + Test.make_indexed ~name:"noop" ~fmt:"%s %7d" ~args:[ 10; 50; 100 ] + (noop env) + in + Test.make_grouped ~name:"bench" [ count; noop ] let metrics = Toolkit.Instance.[ minor_allocated; major_allocated; monotonic_clock ] diff --git a/src/bin/dune b/src/bin/dune index a12ad9b..d5d2d27 100644 --- a/src/bin/dune +++ b/src/bin/dune @@ -5,6 +5,7 @@ (libraries merry merry.posix + memtrace eio_posix cmdliner fmt.tty diff --git a/src/bin/main.ml b/src/bin/main.ml index b5e00dc..55bbaef 100644 --- a/src/bin/main.ml +++ b/src/bin/main.ml @@ -137,5 +137,6 @@ let main () = sh ~name shell_options env let () = + Memtrace.trace_if_requested ~context:"msh.0.0.1" (); Fmt_tty.setup_std_outputs (); if !Sys.interactive then () else main () diff --git a/src/lib/ast.ml b/src/lib/ast.ml index d661ac6..7157f25 100644 --- a/src/lib/ast.ml +++ b/src/lib/ast.ml @@ -48,7 +48,7 @@ and complete_commands : CST.complete_commands -> complete_commands = | CompleteCommands_CompleteCommands_NewlineList_CompleteCommand (a, _, c) -> let a = complete_commands a.value in let c = complete_command c.value in - a @ [ c ] + List.rev (c :: List.rev a) | CompleteCommands_CompleteCommand a -> let a = complete_command a.value in [ a ] diff --git a/src/lib/eunix.ml b/src/lib/eunix.ml index 50b17c9..cfdf466 100644 --- a/src/lib/eunix.ml +++ b/src/lib/eunix.ml @@ -8,7 +8,7 @@ let env () = |> Array.map (Astring.String.cut ~sep:"=") |> Array.to_list |> List.filter_map Fun.id -let find_env k = env () |> List.assoc_opt k +let find_env k = env () |> List.assoc_opt ~compare:String.compare k let put_env ~key ~value = Eio_unix.run_in_systhread ~label:"put_env" @@ fun () -> Unix.putenv key value diff --git a/src/lib/eval.ml b/src/lib/eval.ml index 501c577..9ad1f71 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -155,7 +155,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct (* J.get_reaper j |> fst |> Eio.Promise.await *) let lookup ~param ctx = - match List.assoc_opt param (local_state_as_env ctx) with + match + List.assoc_opt ~compare:String.compare param (local_state_as_env ctx) + with | Some _ as v -> v | None -> S.lookup ctx.state ~param @@ -338,16 +340,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct let get_env ?(extra = Stack.empty) ctx = let extra = Stack.to_list extra |> List.concat in - let extra = - extra @ List.map (fun (k, v) -> (k, v)) @@ S.exports ctx.state - in - let env = - Eunix.env () |> List.map (fun (k, v) -> (k, Ast.Fragment.[ make v ])) - in - let env = - List.fold_left (fun acc (k, _) -> List.remove_assoc k acc) env extra - |> List.append extra - in + let env = extra @ S.exports ctx.state in List.map (fun (k, v) -> (k, Ast.Fragment.join_list ~sep:"" v)) env let update ?export ?readonly ?local ctx ~param v = @@ -392,7 +385,6 @@ module Make (S : Types.State) (E : Types.Exec) = struct let initial_ctx = { initial_ctx with local_state = Stack.push [] initial_ctx.local_state } in - with_pipeline_scope initial_ctx @@ fun initial_ctx -> let set_last_background ~async process ctx = if async then begin { ctx with last_background_process = string_of_int (E.pid process) } @@ -475,6 +467,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct (ctx, job) in let job_pgid (t : _ J.t) = J.get_id t in + with_pipeline_scope initial_ctx @@ fun initial_ctx -> let rec loop pipeline_switch (pctx : pipeline_ctx) (job : _ J.t) : Ast.command list -> _ J.t = fun c -> @@ -505,7 +498,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Exit.Zero ctx -> ( let executable, extra_args = (* This is a side-effect of the alias command with something like - alias ls="ls -la" *) + alias ls="ls -la" *) match Ast.Fragment.join_list ~sep:"" (List.concat executable) |> String.split_on_char ' ' |> List.map Ast.Fragment.make @@ -1589,7 +1582,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct match ctx with Exit.Zero ctx -> read_arg ctx w | _ -> ctx) (Exit.zero ctx) assignments | fs, _assignments -> - if List.mem "p" fs then begin + if List.mem ~compare:String.compare "p" fs then begin match kind with | `Readonly -> S.pp_readonly Fmt.stdout ctx.state | `Export -> S.pp_export Fmt.stdout ctx.state @@ -1838,7 +1831,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct and handle_function_application (ctx : ctx) ~name argv : (unit -> ctx Exit.t) option = - match List.assoc_opt name ctx.functions with + match List.assoc_opt ~compare:String.compare name ctx.functions with | None -> None | Some commands -> Debug.Log.debug (fun f -> @@ -2038,7 +2031,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct | `Functions names -> let functions = List.fold_left - (fun t param -> List.remove_assoc param t) + (fun t param -> + List.remove_assoc ~compare:String.compare param t) ctx.functions names in Exit.zero { ctx with functions }) diff --git a/src/lib/import.ml b/src/lib/import.ml index 091fcf1..682b53d 100644 --- a/src/lib/import.ml +++ b/src/lib/import.ml @@ -27,6 +27,19 @@ end module List = struct include List + let rec assoc_opt ~compare x = function + | [] -> None + | (a, b) :: l -> if compare a x = 0 then Some b else assoc_opt ~compare x l + + let rec remove_assoc ~compare x = function + | [] -> [] + | ((a, _) as pair) :: l -> + if compare a x = 0 then l else pair :: remove_assoc ~compare x l + + let rec mem ~compare x = function + | [] -> false + | a :: l -> compare a x = 0 || mem ~compare x l + let assoc_replace_or_add (k, v) lst = let rec replace (added, lst) = function | [] -> (added, List.rev lst) diff --git a/src/lib/posix/state.ml b/src/lib/posix/state.ml index 1bcc774..97fe4d9 100644 --- a/src/lib/posix/state.ml +++ b/src/lib/posix/state.ml @@ -113,14 +113,14 @@ let remove ~param t = let remove_group ~id t = let variables = Variables.fold - (fun param (({ id = id'; _ }, _) as v) vs -> + (fun param ({ id = id'; _ }, _) vs -> if String.equal id id' then begin - vs + Variables.remove param vs end else begin - Variables.add param v vs + vs end) - t.variables Variables.empty + t.variables t.variables in { t with variables }