improve benchmarks

This commit is contained in:
Simon Cruanes 2015-10-21 23:01:14 +02:00
parent 54c2e4541e
commit 2d2f92c899

View file

@ -263,36 +263,40 @@ module Tbl = struct
= fun key -> = fun key ->
let (module Key), name = arg_make key in let (module Key), name = arg_make key in
let module T = struct let module T = struct
let name = sprintf "hashtbl.make(%s)" name let name = sprintf "hashtbl(%s)" name
include Hashtbl.Make(Key) include Hashtbl.Make(Key)
end in end in
(module T) (module T)
let persistent_hashtbl_ref = let persistent_hashtbl_ref : type a. a key_type -> (module MUT with type key = a)
let module T = Ref_impl.PersistentHashtbl(CCInt) in = fun key ->
let (module Key), name = arg_make key in
let module T = Ref_impl.PersistentHashtbl(Key) in
let module U = struct let module U = struct
type key = int type key = a
type 'a t = 'a T.t ref type 'a t = 'a T.t ref
let name = "persistent_tbl_old" let name = sprintf "persistent_tbl_old(%s)" name
let create _ = ref (T.empty ()) let create _ = ref (T.empty ())
let find m k = T.find !m k let find m k = T.find !m k
let add m k v = m := T.replace !m k v let add m k v = m := T.replace !m k v
let replace = add let replace = add
end in end in
(module U : INT_MUT) (module U)
let persistent_hashtbl = let persistent_hashtbl : type a. a key_type -> (module MUT with type key = a)
let module T = CCPersistentHashtbl.Make(CCInt) in = fun key ->
let (module Key), name = arg_make key in
let module T = CCPersistentHashtbl.Make(Key) in
let module U = struct let module U = struct
type key = int type key = a
type 'a t = 'a T.t ref type 'a t = 'a T.t ref
let name = "persistent_tbl" let name = sprintf "persistent_tbl(%s)" name
let create _ = ref (T.empty ()) let create _ = ref (T.empty ())
let find m k = T.find !m k let find m k = T.find !m k
let add m k v = m := T.replace !m k v let add m k v = m := T.replace !m k v
let replace = add let replace = add
end in end in
(module U : INT_MUT) (module U)
let hashtbl = let hashtbl =
let module T = struct let module T = struct
@ -389,7 +393,7 @@ module Tbl = struct
let modules_int = let modules_int =
[ hashtbl_make Int [ hashtbl_make Int
; hashtbl ; hashtbl
; persistent_hashtbl ; persistent_hashtbl Int
(* ; poly_hashtbl *) (* ; poly_hashtbl *)
; map Int ; map Int
; wbt Int ; wbt Int
@ -404,6 +408,7 @@ module Tbl = struct
; map Str ; map Str
; wbt Str ; wbt Str
; hashtrie Str ; hashtrie Str
; persistent_hashtbl Str
; hamt Str ; hamt Str
; trie ; trie
] ]
@ -422,7 +427,7 @@ module Tbl = struct
let bench_add = bench_add_to modules_int let bench_add = bench_add_to modules_int
let bench_add_string n = let bench_add_string_to l n =
let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in
let make (module T : STRING_MUT) = let make (module T : STRING_MUT) =
let run() = let run() =
@ -433,7 +438,9 @@ module Tbl = struct
in in
T.name, run, () T.name, run, ()
in in
B.throughputN 3 ~repeat (List.map make modules_string) B.throughputN 3 ~repeat (List.map make l)
let bench_add_string = bench_add_string_to modules_string
let bench_replace n = let bench_replace n =
let make (module T : INT_MUT) = let make (module T : INT_MUT) =
@ -506,7 +513,7 @@ module Tbl = struct
let bench_find = bench_find_to modules_int_find let bench_find = bench_find_to modules_int_find
let bench_find_string n = let bench_find_string_to l n =
let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in let keys = CCList.( 1 -- n |> map (fun i->string_of_int i,i)) in
let make (module T : STRING_MUT) = let make (module T : STRING_MUT) =
let m = T.create n in let m = T.create n in
@ -518,7 +525,9 @@ module Tbl = struct
in in
T.name, run, () T.name, run, ()
in in
Benchmark.throughputN 3 ~repeat (List.map make modules_string) Benchmark.throughputN 3 ~repeat (List.map make l)
let bench_find_string = bench_find_string_to modules_string
let () = let () =
B.Tree.register ("tbl" @>>> B.Tree.register ("tbl" @>>>
@ -529,12 +538,16 @@ module Tbl = struct
; "find_string" @>> app_ints bench_find_string [10; 20; 100; 1_000; 10_000] ; "find_string" @>> app_ints bench_find_string [10; 20; 100; 1_000; 10_000]
]); ]);
B.Tree.register ("tbl_persistent" @>>> B.Tree.register ("tbl_persistent" @>>>
[ "add_int" @>> app_ints let l_int = [persistent_hashtbl Int; persistent_hashtbl_ref Int] in
(bench_add_to [persistent_hashtbl; persistent_hashtbl_ref]) [10; 100; 1_000; 10_000;] let l_str = [persistent_hashtbl Str; persistent_hashtbl_ref Str] in
[ "add_int" @>> app_ints (bench_add_to l_int) [10; 100; 1_000; 10_000;]
; "find_int" @>> app_ints ; "find_int" @>> app_ints
(bench_find_to (bench_find_to (List.map find_of_mut l_int))
(List.map find_of_mut [persistent_hashtbl; persistent_hashtbl_ref]))
[10; 20; 100; 1_000; 10_000] [10; 20; 100; 1_000; 10_000]
; "add_string" @>> app_ints
(bench_add_string_to l_str) [10; 100; 1_000; 10_000;]
; "find_string" @>> app_ints
(bench_find_string_to l_str) [10; 20; 100; 1_000; 10_000]
]); ]);
() ()
end end