From a3ff8ee8541224f3c0a30b8fbcc7bc3aeeca9540 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Thu, 27 Feb 2014 11:06:07 +0100 Subject: [PATCH] added a benchmark for persistent; moved all benchs to bench/ --- Makefile | 5 +- bench/bench_persistent.ml | 128 +++++++++++++++++++++++++++++++ {tests => bench}/benchs.ml | 0 {tests => bench}/simple_bench.ml | 0 sequence.ml | 8 +- 5 files changed, 135 insertions(+), 6 deletions(-) create mode 100644 bench/bench_persistent.ml rename {tests => bench}/benchs.ml (100%) rename {tests => bench}/simple_bench.ml (100%) diff --git a/Makefile b/Makefile index 3129040..b34c2c7 100644 --- a/Makefile +++ b/Makefile @@ -28,8 +28,9 @@ install_file: all: bin doc install_file benchs: all - ocamlbuild -use-ocamlfind -pkg bench -pkg unix tests/benchs.native \ - tests/simple_bench.native + ocamlbuild -use-ocamlfind -pkg bench -pkg benchmark -pkg unix \ + bench/benchs.native bench/simple_bench.native \ + bench/bench_persistent.native tests: ocamlbuild -use-ocamlfind -pkg oUnit tests/run_tests.native diff --git a/bench/bench_persistent.ml b/bench/bench_persistent.ml new file mode 100644 index 0000000..022b6b3 --- /dev/null +++ b/bench/bench_persistent.ml @@ -0,0 +1,128 @@ +module MList = struct + type 'a t = { + content : 'a array; (* elements of the node *) + mutable len : int; (* number of elements in content *) + mutable tl : 'a t; (* tail *) + } (** A list that contains some elements, and may point to another list *) + + let _empty () : 'a t = Obj.magic 0 + (** Empty list, for the tl field *) + + let make n = + assert (n > 0); + { content = Array.make n (Obj.magic 0); + len = 0; + tl = _empty (); + } + + let rec is_empty l = + l.len = 0 && (l.tl == _empty () || is_empty l.tl) + + let rec iter f l = + for i = 0 to l.len - 1 do f l.content.(i); done; + if l.tl != _empty () then iter f l.tl + + let iteri f l = + let rec iteri i f l = + for j = 0 to l.len - 1 do f (i+j) l.content.(j); done; + if l.tl != _empty () then iteri (i+l.len) f l.tl + in iteri 0 f l + + let rec iter_rev f l = + (if l.tl != _empty () then iter_rev f l.tl); + for i = l.len - 1 downto 0 do f l.content.(i); done + + let length l = + let rec len acc l = + if l.tl == _empty () then acc+l.len else len (acc+l.len) l.tl + in len 0 l + + (** Get element by index *) + let rec get l i = + if i < l.len then l.content.(i) + else if i >= l.len && l.tl == _empty () then raise (Invalid_argument "MList.get") + else get l.tl (i - l.len) + + (** Push [x] at the end of the list. It returns the block in which the + element is inserted. *) + let rec push x l = + if l.len = Array.length l.content + then begin (* insert in the next block *) + (if l.tl == _empty () then + let n = Array.length l.content in + l.tl <- make (n + n lsr 1)); + push x l.tl + end else begin (* insert in l *) + l.content.(l.len) <- x; + l.len <- l.len + 1; + l + end + + (** Reverse list (in place), and returns the new head *) + let rev l = + let rec rev prev l = + (* reverse array *) + for i = 0 to (l.len-1) / 2 do + let x = l.content.(i) in + l.content.(i) <- l.content.(l.len - i - 1); + l.content.(l.len - i - 1) <- x; + done; + (* reverse next block *) + let l' = l.tl in + l.tl <- prev; + if l' == _empty () then l else rev l l' + in + rev (_empty ()) l + + (** Build a MList of elements of the Seq. The optional argument indicates + the size of the blocks *) + let of_seq ?(size=8) seq = + (* read sequence into a MList.t *) + let start = make size in + let l = ref start in + seq (fun x -> l := push x !l); + start + + let to_seq l = + fun k -> iter k l +end + +(** Store content of the seqerator in an enum *) +let persistent_mlist seq = + let l = MList.of_seq seq in + MList.to_seq l + +let bench_mlist n = + for i = 0 to 100 do + let _ = persistent_mlist Sequence.(1 -- n) in + () + done + +let bench_naive n = + for i = 0 to 100 do + let l = Sequence.to_rev_list Sequence.(1 -- n) in + let _ = Sequence.of_list (List.rev l) in + () + done + +let bench_current n = + for i = 0 to 100 do + let _ = Sequence.persistent Sequence.(1 -- n) in + () + done + +let () = + let bench_n n = + Printf.printf "BENCH for %d\n" n; + let res = Benchmark.throughputN 5 + [ "mlist", bench_mlist, n + ; "naive", bench_naive, n + ; "current", bench_current, n + ] + in Benchmark.tabulate res + in + bench_n 100; + bench_n 100_000; + () + +(* vim:Use benchmark: *) diff --git a/tests/benchs.ml b/bench/benchs.ml similarity index 100% rename from tests/benchs.ml rename to bench/benchs.ml diff --git a/tests/simple_bench.ml b/bench/simple_bench.ml similarity index 100% rename from tests/simple_bench.ml rename to bench/simple_bench.ml diff --git a/sequence.ml b/sequence.ml index 18b94e9..e21a99a 100644 --- a/sequence.ml +++ b/sequence.ml @@ -91,7 +91,7 @@ let foldi f init seq = r := f !r !i elt; incr i); !r - + (** Map objects of the sequence into other elements, lazily *) let map f seq = let seq_fun' k = seq (fun x -> k (f x)) in @@ -257,7 +257,7 @@ let group ?(eq=fun x y -> x = y) seq = cur := [x]); (* last list *) if !cur <> [] then k !cur - + (** Remove consecutive duplicate elements. Basically this is like [fun seq -> map List.hd (group seq)]. *) let uniq ?(eq=fun x y -> x = y) seq = @@ -520,7 +520,7 @@ let hashtbl_values h = from_iter (fun k -> Hashtbl.iter (fun a b -> k b) h) let of_str s = from_iter (fun k -> String.iter k s) - + let to_str seq = let b = Buffer.create 64 in iter (fun c -> Buffer.add_char b c) seq; @@ -575,7 +575,7 @@ module Set = struct include X end - + (** Functor to build an extended Set module from an ordered type *) module Make(X : Set.OrderedType) = struct module MySet = Set.Make(X)