From 47df2a577316a32e03536fad5cda6365d2fb010e Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Tue, 23 Jun 2026 17:53:06 +0100 Subject: [PATCH] Benchmarks Some simple benchmarks and pre-parse arith expressions. --- bench/README.md | 10 +++++++ bench/bechamel_csv.ml | 44 ++++++++++++++++++++++++++++ bench/bench.ml | 58 ++++++++++++++++++++++++++++++++++++ bench/dune | 7 +++++ dune-project | 2 ++ merry.opam | 1 + src/lib/arith.ml | 19 ++---------- src/lib/arith_parser.mly | 4 +-- src/lib/ast.ml | 63 +++++++++++++++++++++------------------- src/lib/ast_pp.ml | 2 +- src/lib/eval.ml | 10 ++----- src/lib/sast.ml | 16 +++++++++- 12 files changed, 178 insertions(+), 58 deletions(-) create mode 100644 bench/README.md create mode 100644 bench/bechamel_csv.ml create mode 100644 bench/bench.ml create mode 100644 bench/dune diff --git a/bench/README.md b/bench/README.md new file mode 100644 index 0000000..2613a31 --- /dev/null +++ b/bench/README.md @@ -0,0 +1,10 @@ +# Benchmarks + + +```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 +``` diff --git a/bench/bechamel_csv.ml b/bench/bechamel_csv.ml new file mode 100644 index 0000000..9112b30 --- /dev/null +++ b/bench/bechamel_csv.ml @@ -0,0 +1,44 @@ +open Bechamel + +let pad width v = + let padding = String.make (width - String.length v) ' ' in + padding ^ v + +let pp_row ~width f data = + data |> List.iteri (fun i v -> + if i > 0 then Fmt.comma f (); + Fmt.pf f "%s" (pad width.(i) v) + ) + +let pp f results = + let results = Hashtbl.to_seq results |> Array.of_seq in + Array.sort (fun (n1, _) (n2, _) -> String.compare n1 n2) results; (* Sort columns *) + let rows = snd results.(0) |> Hashtbl.to_seq |> Seq.map fst |> Array.of_seq in + let width = Array.make (Array.length results + 1) 0 in + width.(0) <- String.length "name, "; + results |> Array.iteri (fun i (name, _) -> width.(i + 1) <- String.length name + 2); + Array.sort String.compare rows; + let rows = + rows |> Array.map (fun name -> + width.(0) <- max width.(0) (String.length name + 2); + let values = + results |> Array.mapi (fun i (_, col) -> + let v = + match Hashtbl.find col name |> Analyze.OLS.estimates with + | Some [v] -> Printf.sprintf "%f" v + | _ -> assert false + in + width.(i + 1) <- max width.(i + 1) (String.length v + 2); + v + ) + in + name, values + ) + in + let metrics = Array.to_list results |> List.map fst in + let headings = List.mapi (fun i v -> pad width.(i) v) ("name" :: metrics) in + Fmt.pf f "@[@[%a@]" Fmt.(list ~sep:comma string) headings; + rows |> Array.iter (fun (name, data) -> + Fmt.pf f "@,@[%a@]" (pp_row ~width) (name :: Array.to_list data); + ); + Fmt.pf f "@]" diff --git a/bench/bench.ml b/bench/bench.ml new file mode 100644 index 0000000..baefa1d --- /dev/null +++ b/bench/bench.ml @@ -0,0 +1,58 @@ +open Bechamel + +module C = Merry.Eval.Make (Merry_posix.State) (Merry_posix.Exec) + +module I = + Merry.Interactive.Make (Merry_posix.State) (Merry_posix.Exec) + (Merry.History.Prefix_search) + +let setup_shell ~sw env = + let executor = Merry_posix.Exec.{ mgr = env#process_mgr } in + let ctx = + C.make_ctx ~interactive:false + (Merry_posix.State.make + ~home:(Sys.getenv "HOME" ^ "/") + (Fpath.v (Merry.Eunix.cwd ()))) + executor ~fs:env#fs ~stdin:env#stdin ~stdout:env#stdout ~async_switch:sw + ~argv:[||] ~program:"bench" + in + Merry.Exit.zero ctx + +let run_shell ctx program = + let _, _ = C.run ctx program in + () + +let count env iterations = + let script = Fmt.str {| + count=0 + while [ "$count" -le %i ]; do + count=$((count + 1)) + done + |} iterations 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 metrics = + Toolkit.Instance.[ minor_allocated; major_allocated; monotonic_clock ] + +let benchmark env = + let ols = + Analyze.ols ~bootstrap:0 ~r_square:true ~predictors:Measure.[| run |] + in + let quota = Time.second 0.5 in + let cfg = Benchmark.cfg ~limit:2000 ~quota ~kde:(Some 1000) () in + let raw_results = Benchmark.all cfg metrics (suite env) in + List.map (fun i -> Analyze.all ols i raw_results) metrics + |> Analyze.merge ols metrics + +let () = + Eio_posix.run @@ fun env -> + let results = benchmark env in + Fmt.pr "@[%a@]@." Bechamel_csv.pp results diff --git a/bench/dune b/bench/dune new file mode 100644 index 0000000..ccbf22d --- /dev/null +++ b/bench/dune @@ -0,0 +1,7 @@ +(mdx + (files README.md) + (deps ./bench.exe)) + +(executable + (name bench) + (libraries merry merry.posix bechamel)) diff --git a/dune-project b/dune-project index c271a9d..2a03236 100644 --- a/dune-project +++ b/dune-project @@ -1,5 +1,6 @@ (lang dune 3.20) (using menhir 3.0) +(using mdx 0.4) (name merry) @@ -29,6 +30,7 @@ xdge globlon logs + (mdx :with-test) (menhir (= 20250912)) (yojson diff --git a/merry.opam b/merry.opam index 73644ae..d8937a9 100644 --- a/merry.opam +++ b/merry.opam @@ -17,6 +17,7 @@ depends: [ "xdge" "globlon" "logs" + "mdx" {with-test} "menhir" {= "20250912"} "yojson" {= "2.2.2"} "ppxlib" {>= "0.37.0"} diff --git a/src/lib/arith.ml b/src/lib/arith.ml index 106c65d..916bfab 100644 --- a/src/lib/arith.ml +++ b/src/lib/arith.ml @@ -1,13 +1,9 @@ open Import -(* We handle _very_ simple arithmetic expressions. - Really nothing crazy yet, hopefully enough to handle - most [while x < 10 do x = x + 1 done] loops! *) -type operator = Add | Sub | Mul | Div | Mod | Lt | Gt | Eq -[@@deriving to_yojson] +let pp ppf (_ : Sast.arith_expr) = Fmt.pf ppf "TODO" let exec_op = function - | Add -> Int.add + | Sast.Add -> Int.add | Sub -> Int.sub | Mul -> Int.mul | Div -> Int.div @@ -16,15 +12,6 @@ let exec_op = function | Gt -> fun a b -> if a > b then 1 else 0 | Eq -> fun a b -> if Int.equal a b then 1 else 0 -type expr = - | Int of int - | Var of string - | Binop of operator * expr * expr - | Neg of expr - | Assign of operator * string * expr - | Ternary of (expr * expr * expr) -[@@deriving to_yojson] - (* Faster way: extract the logic from morbig directly for parsing variables. *) let collect_variables v = let o = @@ -76,7 +63,7 @@ module Make (S : Types.State) = struct | Error m -> failwith m in let rec calc state = function - | Int i -> (state, i) + | Sast.Int i -> (state, i) | Var v -> Debug.Log.info (fun f -> f "V is %s" v); (state, lookup state v) diff --git a/src/lib/arith_parser.mly b/src/lib/arith_parser.mly index dfa8f18..2c36d01 100644 --- a/src/lib/arith_parser.mly +++ b/src/lib/arith_parser.mly @@ -1,5 +1,5 @@ %{ - open Arith + open Sast %} %token INT @@ -18,7 +18,7 @@ %left GT LT %right UMINUS UPLUS -%start main +%start main %% diff --git a/src/lib/ast.ml b/src/lib/ast.ml index d20546a..864c3d2 100644 --- a/src/lib/ast.ml +++ b/src/lib/ast.ml @@ -6,6 +6,35 @@ include Sast type t = complete_commands +let rec word_component_to_string : + ?field_splitting:bool -> word_component -> string list = + fun ?(field_splitting = true) -> function + | WordName s -> [ s ] + | WordLiteral s -> [ s ] + | WordDoubleQuoted s -> word_components_to_strings ~field_splitting:false s + | WordSingleQuoted s -> word_components_to_strings ~field_splitting:false s + | WordGlobAll -> [ "*" ] + | WordGlobAny -> [ "?" ] + | WordEmpty -> [ "" ] + | WordAssignmentWord (Name p, v) -> + p :: "=" :: word_components_to_strings ~field_splitting v + | WordSubshell _ -> + Fmt.failwith + "This is an error in Merry, subshells should already have been \ + expanded by now!" + | v -> + Fmt.failwith "conversion of %a" Yojson.Safe.pp + (word_component_to_yojson v) + +and word_components_to_strings ?(field_splitting = true) ws = + if field_splitting then + List.concat_map (word_component_to_string ~field_splitting) ws + else + [ + String.concat "" + (List.concat_map (word_component_to_string ~field_splitting) ws); + ] + let rec program : CST.program -> complete_commands = fun x -> match x with @@ -563,7 +592,10 @@ and word_component : CST.word_component -> word_component = WordVariable a | WordGlobAll -> WordGlobAll | WordGlobAny -> WordGlobAny - | WordArithmeticExpression s -> WordArithmeticExpression (word s) + | WordArithmeticExpression s -> + let expr = word_components_to_strings (word s) |> String.concat "" in + let aexpr = Arith_parser.main Arith_lexer.read (Lexing.from_string expr) in + WordArithmeticExpression aexpr | WordReBracketExpression a -> let a = bracket_expression a in WordReBracketExpression a @@ -771,35 +803,6 @@ let of_file path = let fname = Eio.Path.native_exn path in Eio.Path.load path |> of_string ~filename:fname -let rec word_component_to_string : - ?field_splitting:bool -> word_component -> string list = - fun ?(field_splitting = true) -> function - | WordName s -> [ s ] - | WordLiteral s -> [ s ] - | WordDoubleQuoted s -> word_components_to_strings ~field_splitting:false s - | WordSingleQuoted s -> word_components_to_strings ~field_splitting:false s - | WordGlobAll -> [ "*" ] - | WordGlobAny -> [ "?" ] - | WordEmpty -> [ "" ] - | WordAssignmentWord (Name p, v) -> - p :: "=" :: word_components_to_strings ~field_splitting v - | WordSubshell _ -> - Fmt.failwith - "This is an error in Merry, subshells should already have been \ - expanded by now!" - | v -> - Fmt.failwith "conversion of %a" Yojson.Safe.pp - (word_component_to_yojson v) - -and word_components_to_strings ?(field_splitting = true) ws = - if field_splitting then - List.concat_map (word_component_to_string ~field_splitting) ws - else - [ - String.concat "" - (List.concat_map (word_component_to_string ~field_splitting) ws); - ] - class check_ast = object (_) inherit [bool] Sast.fold diff --git a/src/lib/ast_pp.ml b/src/lib/ast_pp.ml index 4d3fe3b..d161c46 100644 --- a/src/lib/ast_pp.ml +++ b/src/lib/ast_pp.ml @@ -98,7 +98,7 @@ and word_component : word_component Fmt.t = | WordGlobAny -> Fmt.string ppf "?" | WordSubshell s -> Fmt.pf ppf "$(%a)" complete_commands s | WordTildePrefix _ -> Fmt.pf ppf "~" - | WordArithmeticExpression s -> Fmt.pf ppf "((%a))" word_cst s + | WordArithmeticExpression s -> Fmt.pf ppf "((%a))" Arith.pp s | WordReBracketExpression _ -> () and variable : variable Fmt.t = diff --git a/src/lib/eval.ml b/src/lib/eval.ml index 4f50db9..501c577 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -259,14 +259,8 @@ module Make (S : Types.State) (E : Types.Exec) = struct | Ast.WordTildePrefix _ -> Ast.WordTildePrefix (S.expand ctx.state `Tilde) | v -> v - let word_cst_to_string ?field_splitting v = - Ast.word_components_to_strings ?field_splitting v |> String.concat "" - - let arithmetic_expansion ~expand ctx word = - let expr = word_cst_to_string word in - let aexpr = Arith_parser.main Arith_lexer.read (Lexing.from_string expr) in - Debug.Log.debug (fun f -> f "Arith: %s" expr); - let state, i = A.eval ~expand ctx.state aexpr in + let arithmetic_expansion ~expand ctx expr = + let state, i = A.eval ~expand ctx.state expr in ({ ctx with state }, i) (* The minimal amount of context needed between pipeline stages. *) diff --git a/src/lib/sast.ml b/src/lib/sast.ml index dd9e6e8..c3d4686 100644 --- a/src/lib/sast.ml +++ b/src/lib/sast.ml @@ -117,11 +117,25 @@ and word_component = | WordVariable of variable | WordGlobAll (* asterisk *) | WordGlobAny (* question mark *) - | WordArithmeticExpression of word + | WordArithmeticExpression of arith_expr | WordReBracketExpression of bracket_expression (* Empty CST. Useful to represent the absence of relevant CSTs. *) | WordEmpty + +(* We handle _very_ simple arithmetic expressions. + Really nothing crazy yet, hopefully enough to handle + most [while x < 10 do x = x + 1 done] loops! *) + and arith_operator = Add | Sub | Mul | Div | Mod | Lt | Gt | Eq + + and arith_expr = + | Int of int + | Var of string + | Binop of arith_operator * arith_expr * arith_expr + | Neg of arith_expr + | Assign of arith_operator * string * arith_expr + | Ternary of (arith_expr * arith_expr * arith_expr) + and fragment = { txt : string; escaping : bool; -- 2.51.2