dune

(executable
 (name main)
 (modules main)
 (libraries bechamel bechamel-js))

(rule
 (targets eq.json)
 (action
  (with-stdout-to
   %{targets}
   (run ./main.exe))))

(rule
 (targets eq.html)
 (mode promote)
 (action
  (system "%{bin:bechamel-html} < %{dep:eq.json} > %{targets}")))

main.ml

module Oracle = struct
  let sub_equal ?(off= 0) ?len a b =
    let len = match len with
      | Some len -> len
      | None -> String.length a - off in
    try String.sub a off len = String.sub b off len
    with _ -> false
end

module T1 = struct
  let sub_equal ?(off= 0) ?len a b =
    let len = match len with
      | Some len -> len
      | None -> String.length a - off in
    if len < 0 && off < 0 || off > String.length a - len
    || off > String.length b - len
    then false else begin
      let idx = ref off in
      while !idx - off < len && (String.unsafe_get a !idx) == (String.unsafe_get b !idx) do incr idx done;
      !idx == len
    end
end

module T2 = struct
  external unsafe_get_uint32 : string -> int -> int32 = "%caml_string_get32u"

  let sub_equal off len a b =
    let len0 = len land 3 in
    let len1 = len lsr 2 in
    for i = 0 to len1 - 1 do 
      let i = off + i * 4 in
      if unsafe_get_uint32 a i <> unsafe_get_uint32 b i
      then raise_notrace Not_found;
    done;
    for i = 0 to len0 - 1 do
      let i = off + len1 * 4 + i in
      if String.unsafe_get a i != String.unsafe_get b i then raise_notrace Not_found;
    done
  ;;

  let sub_equal ?(off= 0) ?len a b =
    let len = match len with
      | Some len -> len
      | None -> String.length a - off in
    if len < 0 && off < 0 || off > String.length a - len
    || off > String.length b - len
    then false else try sub_equal off len a b; true with Not_found -> false
end

let random_max = 32767.
let ( <.> ) f g = fun x -> f (g x)

let random_normal n =
  let m = n + (n mod 2) in
  let values = Array.create_float n in
  for i = 0 to (m / 2) - 1 do
    let x = ref 0. and y = ref 0. and rsq = ref 0. in
    while
      x := (Random.float random_max /. random_max *. 2.0) -. 1. ;
      y := (Random.float random_max /. random_max *. 2.0) -. 1. ;
      rsq := (!x *. !x) +. (!y *. !y) ;
      !rsq >= 1. || !rsq = 0.
    do () done ;
    let f = sqrt (-2.0 *. log !rsq /. !rsq) in
    values.(i * 2) <- !x *. f ;
    values.((i * 2) + 1) <- !y *. f
  done ;
  Array.map (abs <.> Float.to_int <.> ( *. ) random_max) values

let random_string ln =
  let rs = Bytes.create ln in
  let ic = open_in "/dev/urandom" in
  really_input ic rs 0 ln ;
  close_in ic ;
  for i = 0 to ln - 1 do if Bytes.get rs i = '\000' then Bytes.set rs i '\001' done ;
  Bytes.unsafe_to_string rs

let db = Array.map random_string (random_normal 1000)

open Bechamel
open Toolkit

let test00 =
  Test.make ~name:"oracle" @@ Staged.stage @@ fun () ->
  Array.iter @@ fun str ->
  let off = 0 and len = String.length str in
  ignore (Oracle.sub_equal ~off ~len str str)

let test01 =
  Test.make ~name:"t1" @@ Staged.stage @@ fun () ->
  Array.iter @@ fun str ->
  let off = 0 and len = String.length str in
  ignore (T1.sub_equal ~off ~len str str)

let test02 =
  Test.make ~name:"t2" @@ Staged.stage @@ fun () ->
  Array.iter @@ fun str ->
  let off = 0 and len = String.length str in
  ignore (T2.sub_equal ~off ~len str str)

let test = Test.make_grouped ~name:"insert" [ test00; test01; test02 ]

let benchmark () =
  let ols =
    Analyze.ols ~bootstrap:0 ~r_square:true ~predictors:Measure.[| run |] in
  let instances =
    Instance.[ minor_allocated; major_allocated; monotonic_clock ] in
  let cfg =
    Benchmark.cfg ~limit:3000 ~quota:(Time.second 2.0) ~kde:(Some 1000) () in
  let raw_results = Benchmark.all cfg instances test in
  let results =
    List.map (fun instance -> Analyze.all ols instance raw_results) instances
  in
  let results = Analyze.merge ols instances results in
  (results, raw_results)

let nothing _ = Ok ()

let () =
  let results = benchmark () in
  let results =
    let open Bechamel_js in
    emit ~dst:(Channel stdout) nothing ~compare:String.compare ~x_label:Measure.run
      ~y_label:(Measure.label Instance.monotonic_clock)
      results in
  Rresult.R.failwith_error_msg results