bench: add memory benchmarks

Signed-off-by: Rudi Grinberg <[email protected]>

<!-- ps-id: 4c9c0b62-d252-48a0-85e2-8962244825a6 -->

benchmarks/benchmark.ml

@@ -1,5 +1,6 @@
-open Core
 open Core_bench
+module List = ListLabels
+module String = StringLabels
 
 module Http = struct
   open Re
@@ -47,26 +48,25 @@ module Http = struct
   end
 end
 
-let http_requests = In_channel.read_all "benchmarks/http-requests.txt"
+let http_requests = Stdio.In_channel.read_all "benchmarks/http-requests.txt"
 
 let str_20_zeroes = String.make 20 '0'
 let re_20_zeroes = Re.(str str_20_zeroes)
 
 let tex_ignore_re =
-  "benchmarks/tex.gitignore"
-  |> In_channel.read_lines
+  Stdio.In_channel.read_lines "benchmarks/tex.gitignore"
   |> List.map ~f:(fun s ->
-      match String.lsplit2 s ~on:'#' with
+      match Base.String.lsplit2 s ~on:'#' with
       | Some (pattern, _comment) -> pattern
       | None -> s)
   |> List.filter_map ~f:(fun s ->
-      match String.strip s with
+      match Base.String.strip s with
       | "" -> None
       | s -> Some s)
   |> List.map ~f:Re.Glob.glob
   |> Re.alt
 
-let tex_ignore_filesnames = In_channel.read_lines "benchmarks/files"
+let tex_ignore_filesnames = Stdio.In_channel.read_lines "benchmarks/files"
 
 let lots_of_a's =
   String.init 101 ~f:(function
@@ -99,16 +99,15 @@ let exec_bench exec name (re : Re.t) cases =
   let re = Re.compile re in
   Bench.Test.create_group ~name (
     List.mapi cases ~f:(fun i case ->
-        let name = sprintf "case %i" i in
+        let name = Printf.sprintf "case %i" i in
         Bench.Test.create ~name (fun () -> ignore (exec re case))
       )
   )
 
 let exec_bench_many exec name re cases =
   let re = Re.compile re in
   Bench.Test.create ~name (fun () ->
-      cases |> List.iter ~f:(fun x -> ignore (exec re x))
-    )
+    List.iter cases ~f:(fun x -> ignore (exec re x)))
 
 let rec read_all_http pos re reqs =
   if pos >= String.length reqs
@@ -154,12 +153,12 @@ let benchmarks =
             |> drain_gen
           )
       ] |> Test.create_group ~name:"auto" in
-    Test.create_group ~name:"http" [manual ; many] in
+    Test.create_group ~name:"http" [manual ; many]
+  in
   benches @ [
     [ exec_bench_many Re.execp "execp"
     ; exec_bench_many Re.exec_opt "exec_opt" ]
-    |> List.map ~f:(fun f ->
-        f tex_ignore_re tex_ignore_filesnames)
+    |> List.map ~f:(fun f -> f tex_ignore_re tex_ignore_filesnames)
     |> Bench.Test.create_group ~name:"tex gitignore"
   ] @ [http_benches]
 

benchmarks/dune

@@ -1,3 +1,3 @@
-(executable
- (libraries re threads core_bench core_unix.command_unix)
- (name benchmark))
+(executables
+ (libraries re core base stdio threads core_bench core_unix.command_unix)
+ (names benchmark memory))

benchmarks/memory.ml

@@ -0,0 +1,28 @@
+(* This set of benchmarks is designed for testing re's memory usage rather than
+   speed. *)
+
+module Bench = Core_bench.Bench
+
+let size = 1_000
+
+(* a pathological re that will consume a bunch of memory *)
+let re =
+  let open Re in
+  compile @@
+  seq
+    [ rep (set "01")
+    ; char '1'
+    ; repn (set "01") size (Some size)
+    ]
+
+let str = "01" ^ String.make size '1'
+
+let benchmarks =
+  Bench.Test.create_indexed ~name:"pathological re" ~args:[10; 20; 40; 80; 100; size] (fun len ->
+    Base.Staged.stage (fun () ->
+      let len = Int.min (String.length str) len in
+      ignore (Re.execp ~pos:0 ~len re str)
+    )
+  )
+
+let () = Command_unix.run (Bench.make_command [ benchmarks ])