diff --git a/benchs/run_benchs.ml b/benchs/run_benchs.ml index fde404a7..ce7d3d58 100644 --- a/benchs/run_benchs.ml +++ b/benchs/run_benchs.ml @@ -579,5 +579,182 @@ module Batch = struct ]) end +module Deque = struct + module Base = struct + type 'a elt = { + content : 'a; + mutable prev : 'a elt; + mutable next : 'a elt; + } (** A cell holding a single element *) + + and 'a t = 'a elt option ref + (** The deque, a double linked list of cells *) + + exception Empty + + let create () = ref None + + let is_empty d = + match !d with + | None -> true + | Some _ -> false + + let push_front d x = + match !d with + | None -> + let rec elt = { + content = x; prev = elt; next = elt; + } in + d := Some elt + | Some first -> + let elt = { content = x; prev = first.prev; next=first; } in + first.prev.next <- elt; + first.prev <- elt; + d := Some elt + + let push_back d x = + match !d with + | None -> + let rec elt = { + content = x; prev = elt; next = elt; } in + d := Some elt + | Some first -> + let elt = { content = x; next=first; prev=first.prev; } in + first.prev.next <- elt; + first.prev <- elt + + let take_back d = + match !d with + | None -> raise Empty + | Some first when first == first.prev -> + (* only one element *) + d := None; + first.content + | Some first -> + let elt = first.prev in + elt.prev.next <- first; + first.prev <- elt.prev; (* remove [first.prev] from list *) + elt.content + + let take_front d = + match !d with + | None -> raise Empty + | Some first when first == first.prev -> + (* only one element *) + d := None; + first.content + | Some first -> + first.prev.next <- first.next; (* remove [first] from list *) + first.next.prev <- first.prev; + d := Some first.next; + first.content + + let iter f d = + match !d with + | None -> () + | Some first -> + let rec iter elt = + f elt.content; + if elt.next != first then iter elt.next + in + iter first + + let of_seq seq = + let q =create () in seq (push_back q); q + + let append_back ~into q = iter (push_back into) q + + let length q = + let n = ref 0 in + iter (fun _ -> incr n) q; + !n + end + + module type DEQUE = sig + type 'a t + val create : unit -> 'a t + val of_seq : 'a Sequence.t -> 'a t + val iter : ('a -> unit) -> 'a t -> unit + val push_front : 'a t -> 'a -> unit + val push_back : 'a t -> 'a -> unit + val is_empty : 'a t -> bool + val take_front : 'a t -> 'a + val take_back : 'a t -> 'a + val append_back : into:'a t -> 'a t -> unit + val length : _ t -> int + end + + let base = (module Base : DEQUE) + let cur = (module CCDeque : DEQUE) + + let bench_iter n = + let seq = Sequence.(1 -- n) in + let make (module D : DEQUE) = + let q = D.of_seq seq in + fun () -> + let n = ref 0 in + D.iter (fun _ -> incr n) q; + () + in + B.throughputN 3 + [ "base", make base, () + ; "cur", make cur, () + ] + + let bench_push_front n = + let make (module D : DEQUE) () = + let q = D.create() in + for i=0 to n do D.push_front q i done + in + B.throughputN 3 + [ "base", make base, () + ; "cur", make cur, () + ] + + let bench_push_back n = + let make (module D : DEQUE) = + let q = D.create() in + fun () -> + for i=0 to n do D.push_back q i done + in + B.throughputN 3 + [ "base", make base, () + ; "cur", make cur, () + ] + + let bench_append n = + let seq = Sequence.(1 -- n) in + let make (module D :DEQUE) = + let q1 = D.of_seq seq in + let q2 = D.of_seq seq in + fun () -> D.append_back ~into:q1 q2 + in + B.throughputN 3 + [ "base", make base, () + ; "cur", make cur, () + ] + + let bench_length n = + let seq = Sequence.(1--n) in + let make (module D:DEQUE) = + let q = D.of_seq seq in + fun () -> ignore (D.length q) + in + B.throughputN 3 + [ "base", make base, () + ; "cur", make cur, () + ] + + let () = B.Tree.register ( + "deque" @>>> + [ "iter" @>> app_ints bench_iter [100; 1_000; 100_000] + ; "push_front" @>> app_ints bench_push_front [100; 1_000; 100_000] + ; "push_back" @>> app_ints bench_push_back [100; 1_000; 100_000] + ; "append_back" @>> app_ints bench_append [100; 1_000; 100_000] + ; "length" @>> app_ints bench_length [100; 1_000] + ] + ) +end + let () = B.Tree.run_global ()