From 4ce972d6e3749e347e801b31fcc5cbc27a7be974 Mon Sep 17 00:00:00 2001 From: cha Date: Mon, 23 May 2022 15:56:09 +0200 Subject: [PATCH 01/82] initial commit, update Dllist with vector library --- cachecache.opam | 1 + src/dllist.ml | 71 ++++++++++++++++++++++++++----------------------- src/dune | 2 +- 3 files changed, 39 insertions(+), 35 deletions(-) diff --git a/cachecache.opam b/cachecache.opam index ad5687f..9e4b65f 100644 --- a/cachecache.opam +++ b/cachecache.opam @@ -30,6 +30,7 @@ depends: [ "dune" {>= "2.0"} "ocaml" {>= "4.07.1"} "fmt" + "vector" "alcotest" {with-test} "gospel" {with-test} "fpath" {with-test} diff --git a/src/dllist.ml b/src/dllist.ml index ff50f6a..3259db2 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -1,8 +1,8 @@ type 'a t = { - contents : 'a array; + contents : 'a Vector.t; witness : 'a; - prev : int array; - next : int array; + prev : int Vector.t; + next : int Vector.t; mutable first : int; mutable last : int; mutable free : int; @@ -12,10 +12,10 @@ type 'a t = { let create c witness = { - contents = Array.make c witness; + contents = Vector.make c ~dummy:witness; witness; - prev = Array.init c pred; - next = Array.init c (fun i -> if i = c - 1 then -1 else succ i); + prev = Vector.init c ~dummy:0 pred; + next = Vector.init c ~dummy:0 (fun i -> if i = c - 1 then -1 else succ i); first = -1; last = -1; free = 0; @@ -31,32 +31,32 @@ let clear t = let o = t.cap - 1 in let o1 = 0 in for i = o1 to o do - t.contents.(i) <- t.witness; - t.prev.(i) <- -1; - t.next.(i) <- -1 + Vector.set t.contents i t.witness; + Vector.set t.prev i (-1); + Vector.set t.next i (-1) done let append t v = let removed = if t.free <> -1 then ( let index = t.free in - t.free <- t.next.(t.free); - if t.free <> -1 then t.prev.(t.free) <- -1; - t.next.(index) <- t.first; - if t.size = 0 then t.last <- index else t.prev.(t.first) <- index; + t.free <- Vector.get t.next t.free; + if t.free <> -1 then Vector.set t.prev t.free (-1); + Vector.set t.next index t.first; + if t.size = 0 then t.last <- index else Vector.set t.prev t.first index; t.first <- index; - t.contents.(index) <- v; + Vector.set t.contents index v; t.size <- t.size + 1; None) else - let removed = Some t.contents.(t.last) in + let removed = Some (Vector.get t.contents t.last) in let new_first = t.last in - t.last <- t.prev.(t.last); - t.contents.(new_first) <- v; - t.next.(t.last) <- -1; - t.prev.(new_first) <- -1; - t.next.(new_first) <- t.first; - t.prev.(t.first) <- new_first; + t.last <- Vector.get t.prev t.last; + Vector.set t.contents new_first v; + Vector.set t.next t.last (-1); + Vector.set t.prev new_first (-1); + Vector.set t.next new_first t.first; + Vector.set t.prev t.first new_first; t.first <- new_first; removed in @@ -64,24 +64,27 @@ let append t v = let promote t i = if i <> t.first then ( - t.next.(t.prev.(i)) <- t.next.(i); - if i <> t.last then t.prev.(t.next.(i)) <- t.prev.(i) - else t.last <- t.prev.(i); - t.prev.(t.first) <- i; - t.next.(i) <- t.first; - t.prev.(i) <- -1; + Vector.set t.next (Vector.get t.prev i) (Vector.get t.next i); + if i <> t.last then + Vector.set t.prev (Vector.get t.next i) (Vector.get t.prev i) + else t.last <- Vector.get t.prev i; + Vector.set t.prev t.first i; + Vector.set t.next i t.first; + Vector.set t.prev i (-1); t.first <- i); t.first let remove t i = - if i <> t.first then t.next.(t.prev.(i)) <- t.next.(i); - if i <> t.last then t.prev.(t.next.(i)) <- t.prev.(i) - else t.last <- t.prev.(t.last); - if t.free <> -1 then t.prev.(t.free) <- i; - t.next.(i) <- t.free; - t.prev.(i) <- -1; + if i <> t.first then + Vector.set t.next (Vector.get t.prev i) (Vector.get t.next i); + if i <> t.last then + Vector.set t.prev (Vector.get t.next i) (Vector.get t.prev i) + else t.last <- Vector.get t.prev t.last; + if t.free <> -1 then Vector.set t.prev t.free i; + Vector.set t.next i t.free; + Vector.set t.prev i (-1); t.free <- i; t.size <- t.size - 1 -let get t i1 = t.contents.(i1) +let get t i1 = Vector.get t.contents i1 let length t = t.size diff --git a/src/dune b/src/dune index 89c7dac..b2c5a17 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,7 @@ (library (public_name cachecache) (name cachecache) - (libraries fmt)) + (libraries fmt vector)) ; (rule ; (alias runtest) From 0f4334380aa05fcf74dc94ab76e75c490ea322d6 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 24 May 2022 14:48:34 +0200 Subject: [PATCH 02/82] dllist with dynamics arrays -- started --- src/dllist.ml | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/dllist.mli | 3 +++ src/lfu.ml | 46 +++++++++++++++++++----------------- 3 files changed, 91 insertions(+), 21 deletions(-) diff --git a/src/dllist.ml b/src/dllist.ml index 3259db2..01576ba 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -88,3 +88,66 @@ let remove t i = let get t i1 = Vector.get t.contents i1 let length t = t.size +let is_empty t = Vector.is_empty t.contents + +let get_ends t = + if not (Vector.is_empty t.contents) then (t.first, t.last) + else raise Not_found + +let insert_head t v = + let removed = + if t.free <> -1 then ( + let new_index = t.free in + t.free <- Vector.get t.next t.free; + if t.free <> -1 then Vector.set t.prev t.free (-1); + Vector.set t.prev new_index t.last; + if t.size = 0 then t.first <- new_index + else Vector.set t.next t.last new_index; + t.last <- new_index; + Vector.set t.contents new_index v; + t.size <- t.size + 1; + None) + else + let removed = Some (Vector.get t.contents t.last) in + let new_first = t.last in + t.last <- Vector.get t.prev t.last; + Vector.set t.contents new_first v; + Vector.set t.next t.last (-1); + Vector.set t.prev new_first (-1); + Vector.set t.next new_first t.first; + Vector.set t.prev t.first new_first; + t.first <- new_first; + removed + in + (t.first, removed) + +let insert_before t v i = + let removed = + if t.free <> -1 then ( + let new_index = t.free in + t.free <- Vector.get t.next t.free; + if t.free <> -1 then Vector.set t.prev t.free (-1); + let i_prev = Vector.get t.prev i in + Vector.set t.prev new_index i_prev; + Vector.set t.next i_prev new_index; + Vector.set t.prev i new_index; + Vector.set t.next new_index i; + if t.size = 0 then ( + t.first <- new_index; + t.last <- new_index); + Vector.set t.contents new_index v; + t.size <- t.size + 1; + None) + else + let removed = Some (Vector.get t.contents t.last) in + let new_first = t.last in + t.last <- Vector.get t.prev t.last; + Vector.set t.contents new_first v; + Vector.set t.next t.last (-1); + Vector.set t.prev new_first (-1); + Vector.set t.next new_first t.first; + Vector.set t.prev t.first new_first; + t.first <- new_first; + removed + in + (t.first, removed) diff --git a/src/dllist.mli b/src/dllist.mli index 2b3f93a..2c7e8ae 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -7,3 +7,6 @@ val promote : 'a t -> int -> int val remove : 'a t -> int -> unit val get : 'a t -> int -> 'a val clear : 'a t -> unit +val is_empty : 'a t -> bool +val get_ends : 'a t -> int * int +val insert_before : 'a t -> 'a -> int diff --git a/src/lfu.ml b/src/lfu.ml index 58033bb..8635388 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -8,20 +8,22 @@ struct module H = Hashtbl.Make (K) type key = K.t - type freq_cell = (int * key Dbllist.t) Dbllist.cell - type key_cell = key Dbllist.cell + type freq_index = int + type key_index = int type 'a t = { - value : (freq_cell * key_cell * 'a) H.t; - frequency : (int * key Dbllist.t) Dbllist.t; + value : (freq_index * key_index * 'a) H.t; + frequency : (int * key Dllist.t) Dllist.t; cap : int; stats : Stats.t; } + let dummy : K.t = Obj.magic (ref 0) + let unsafe_v c = { value = H.create c; - frequency = Dbllist.create (); + frequency = Dllist.create 0 (0, Dllist.create 0 dummy); cap = c; stats = Stats.v (); } @@ -37,7 +39,7 @@ struct let clear t = H.clear t.value; - Dbllist.clear t.frequency; + Dllist.clear t.frequency; Stats.clear t.stats let update t k = @@ -80,19 +82,21 @@ struct let add t k v = if H.length t.value = 0 then - let first_freq_list = Dbllist.create () in - let new_cell = Dbllist.append first_freq_list k in - let first_freq_cell = Dbllist.append t.frequency (1, first_freq_list) in - H.replace t.value k (first_freq_cell, new_cell, v) + let first_freq_list = Dllist.create 0 dummy in + let new_key_index, _opt = Dllist.append first_freq_list k in + let first_key_index, _opt = + Dllist.append t.frequency (1, first_freq_list) + in + H.replace t.value k (first_key_index, new_key_index, v) else - let first_freq_cell, _last_freq_cell = Dbllist.get t.frequency in - let freq, _freq_list = first_freq_cell.content in + let first_freq_index, _last_freq_index = Dllist.get_ends t.frequency in + + let freq, _key_list = Dllist.get t.frequency first_freq_index in (if freq <> 1 then - let real_first_freq_list = Dbllist.create () in - ignore - (Dbllist.append_before t.frequency first_freq_cell - (1, real_first_freq_list) - : freq_cell)); + let real_first_freq_list = Dllist.create 0 dummy in + + Dllist.append_before t.frequency first_freq_cell (1, real_first_freq_list)); + let first_freq_cell, _last_freq_cell = Dbllist.get t.frequency in let _freq, freq_list = first_freq_cell.content in let new_cell = Dbllist.append freq_list k in @@ -121,11 +125,11 @@ struct let remove t k = try - let freq_cell, key_cell, _value = H.find t.value k in + let freq_index, key_index, _value = H.find t.value k in H.remove t.value k; - let _freq, freq_list = freq_cell.content in - Dbllist.remove freq_list key_cell; - if Dbllist.is_empty freq_list then Dbllist.remove t.frequency freq_cell; + let _freq, freq_list = Dllist.get t.frequency freq_index in + Dllist.remove freq_list key_index; + (* if Dbllist.is_empty freq_list then Dllist.remove t.frequency freq_cell; *) Stats.remove t.stats with Not_found -> () end From 3b27ee70efc5d465314e1debc37cee65d4ec5ca8 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 25 May 2022 10:52:33 +0200 Subject: [PATCH 03/82] Dllist changed with external contents array --- src/chunk_lst.ml | 1 + src/dllist2.ml | 89 ++++++++++++++++++++++++++++++++++++++++++++++++ src/dllist2.mli | 10 ++++++ src/lfu.ml | 6 +++- 4 files changed, 105 insertions(+), 1 deletion(-) create mode 100644 src/chunk_lst.ml create mode 100644 src/dllist2.ml create mode 100644 src/dllist2.mli diff --git a/src/chunk_lst.ml b/src/chunk_lst.ml new file mode 100644 index 0000000..dbfb783 --- /dev/null +++ b/src/chunk_lst.ml @@ -0,0 +1 @@ +type 'a t = { contents : 'a array; free : int } \ No newline at end of file diff --git a/src/dllist2.ml b/src/dllist2.ml new file mode 100644 index 0000000..2ef00a0 --- /dev/null +++ b/src/dllist2.ml @@ -0,0 +1,89 @@ +type 'a t = { + contents : 'a array; + witness : 'a; + prev : int array; + next : int array; + mutable first : int; + mutable last : int; + mutable free : int; + cap : int; + mutable size : int; +} + +type 'a l = { contents : 'a array; mutable free : int } + +let create l c witness = + { + contents = l.contents; + witness; + prev = Array.init c pred; + next = Array.init c (fun i -> if i = c - 1 then -1 else succ i); + first = -1; + last = -1; + free = l.free; + cap = c; + size = 0; + } + +let clear t = + t.first <- -1; + t.last <- -1; + t.free <- 0; + t.size <- 0; + let o = t.cap - 1 in + let o1 = 0 in + for i = o1 to o do + t.contents.(i) <- t.witness; + t.prev.(i) <- -1; + t.next.(i) <- -1 + done + +let append t v = + let removed = + if t.free <> -1 then ( + let index = t.free in + t.free <- t.next.(t.free); + if t.free <> -1 then t.prev.(t.free) <- -1; + t.next.(index) <- t.first; + if t.size = 0 then t.last <- index else t.prev.(t.first) <- index; + t.first <- index; + t.contents.(index) <- v; + t.size <- t.size + 1; + None) + else + let removed = Some t.contents.(t.last) in + let new_first = t.last in + t.last <- t.prev.(t.last); + t.contents.(new_first) <- v; + t.next.(t.last) <- -1; + t.prev.(new_first) <- -1; + t.next.(new_first) <- t.first; + t.prev.(t.first) <- new_first; + t.first <- new_first; + removed + in + (t.first, removed) + +let promote t i = + if i <> t.first then ( + t.next.(t.prev.(i)) <- t.next.(i); + if i <> t.last then t.prev.(t.next.(i)) <- t.prev.(i) + else t.last <- t.prev.(i); + t.prev.(t.first) <- i; + t.next.(i) <- t.first; + t.prev.(i) <- -1; + t.first <- i); + t.first + +let remove t i = + if i <> t.first then t.next.(t.prev.(i)) <- t.next.(i); + if i <> t.last then t.prev.(t.next.(i)) <- t.prev.(i) + else t.last <- t.prev.(t.last); + if t.free <> -1 then t.prev.(t.free) <- i; + t.next.(i) <- t.free; + t.prev.(i) <- -1; + t.free <- i; + t.size <- t.size - 1 + +let get t i1 = t.contents.(i1) +let length t = t.size diff --git a/src/dllist2.mli b/src/dllist2.mli new file mode 100644 index 0000000..d0f9182 --- /dev/null +++ b/src/dllist2.mli @@ -0,0 +1,10 @@ +type 'a t +type 'a l + +val create : 'a l -> int -> 'a -> 'a t +val length : 'a t -> int +val append : 'a t -> 'a -> int * 'a option +val promote : 'a t -> int -> int +val remove : 'a t -> int -> unit +val get : 'a t -> int -> 'a +val clear : 'a t -> unit diff --git a/src/lfu.ml b/src/lfu.ml index 8635388..04b8079 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -18,12 +18,16 @@ struct stats : Stats.t; } + type 'a l = { contents : 'a array; mutable free : int } + let dummy : K.t = Obj.magic (ref 0) let unsafe_v c = + let key_lst = { contents = Array.make c dummy; free = 0 } in + let freq_lst = { contents = Array.make c dummy; free = 0 } in { value = H.create c; - frequency = Dllist.create 0 (0, Dllist.create 0 dummy); + frequency = Dllist.create freq_lst 0 (0, Dllist.create key_lst 0 dummy); cap = c; stats = Stats.v (); } From dc078a6a79ca6588f976c47b2cc8e2201b687b39 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Pascutto?= Date: Wed, 25 May 2022 11:21:27 +0200 Subject: [PATCH 04/82] new dllist implementation --- src/dllist.ml | 202 +++++++++++++++++------------------------------- src/dllist.mli | 17 ++-- src/dllist2.ml | 89 --------------------- src/dllist2.mli | 10 --- src/lru.ml | 4 +- 5 files changed, 80 insertions(+), 242 deletions(-) delete mode 100644 src/dllist2.ml delete mode 100644 src/dllist2.mli diff --git a/src/dllist.ml b/src/dllist.ml index 01576ba..3ef2fac 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -1,153 +1,91 @@ type 'a t = { - contents : 'a Vector.t; + cap : int; witness : 'a; - prev : int Vector.t; - next : int Vector.t; + contents : 'a array; + mutable free : int; + prev : int array; + next : int array; +} + +type 'a l = { mutable first : int; mutable last : int; - mutable free : int; - cap : int; mutable size : int; + t : 'a t; } -let create c witness = +let create cap witness = { - contents = Vector.make c ~dummy:witness; + cap; witness; - prev = Vector.init c ~dummy:0 pred; - next = Vector.init c ~dummy:0 (fun i -> if i = c - 1 then -1 else succ i); - first = -1; - last = -1; + contents = Array.make cap witness; free = 0; - cap = c; - size = 0; + prev = Array.init cap pred; + next = Array.init cap (fun i -> if i = cap - 1 then -1 else succ i); } -let clear t = - t.first <- -1; - t.last <- -1; - t.free <- 0; - t.size <- 0; - let o = t.cap - 1 in - let o1 = 0 in - for i = o1 to o do - Vector.set t.contents i t.witness; - Vector.set t.prev i (-1); - Vector.set t.next i (-1) - done +let create_list t = { first = -1; last = -1; size = 0; t } -let append t v = - let removed = - if t.free <> -1 then ( - let index = t.free in - t.free <- Vector.get t.next t.free; - if t.free <> -1 then Vector.set t.prev t.free (-1); - Vector.set t.next index t.first; - if t.size = 0 then t.last <- index else Vector.set t.prev t.first index; - t.first <- index; - Vector.set t.contents index v; - t.size <- t.size + 1; - None) - else - let removed = Some (Vector.get t.contents t.last) in - let new_first = t.last in - t.last <- Vector.get t.prev t.last; - Vector.set t.contents new_first v; - Vector.set t.next t.last (-1); - Vector.set t.prev new_first (-1); - Vector.set t.next new_first t.first; - Vector.set t.prev t.first new_first; - t.first <- new_first; - removed +let clear l = + let rec aux i = + if i = -1 then () + else ( + l.t.contents.(i) <- l.t.witness; + l.t.prev.(i) <- -1; + l.t.next.(i) <- -1; + aux l.t.next.(i)) in - (t.first, removed) - -let promote t i = - if i <> t.first then ( - Vector.set t.next (Vector.get t.prev i) (Vector.get t.next i); - if i <> t.last then - Vector.set t.prev (Vector.get t.next i) (Vector.get t.prev i) - else t.last <- Vector.get t.prev i; - Vector.set t.prev t.first i; - Vector.set t.next i t.first; - Vector.set t.prev i (-1); - t.first <- i); - t.first + aux l.first; + l.first <- -1; + l.last <- -1; + l.size <- 0 -let remove t i = - if i <> t.first then - Vector.set t.next (Vector.get t.prev i) (Vector.get t.next i); - if i <> t.last then - Vector.set t.prev (Vector.get t.next i) (Vector.get t.prev i) - else t.last <- Vector.get t.prev t.last; - if t.free <> -1 then Vector.set t.prev t.free i; - Vector.set t.next i t.free; - Vector.set t.prev i (-1); - t.free <- i; - t.size <- t.size - 1 - -let get t i1 = Vector.get t.contents i1 -let length t = t.size -let is_empty t = Vector.is_empty t.contents - -let get_ends t = - if not (Vector.is_empty t.contents) then (t.first, t.last) - else raise Not_found - -let insert_head t v = +let append l v = let removed = - if t.free <> -1 then ( - let new_index = t.free in - t.free <- Vector.get t.next t.free; - if t.free <> -1 then Vector.set t.prev t.free (-1); - Vector.set t.prev new_index t.last; - if t.size = 0 then t.first <- new_index - else Vector.set t.next t.last new_index; - t.last <- new_index; - Vector.set t.contents new_index v; - t.size <- t.size + 1; + if l.t.free <> -1 then ( + let index = l.t.free in + l.t.free <- l.t.next.(l.t.free); + if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; + l.t.next.(index) <- l.first; + if l.size = 0 then l.last <- index else l.t.prev.(l.first) <- index; + l.first <- index; + l.t.contents.(index) <- v; + l.size <- l.size + 1; None) else - let removed = Some (Vector.get t.contents t.last) in - let new_first = t.last in - t.last <- Vector.get t.prev t.last; - Vector.set t.contents new_first v; - Vector.set t.next t.last (-1); - Vector.set t.prev new_first (-1); - Vector.set t.next new_first t.first; - Vector.set t.prev t.first new_first; - t.first <- new_first; + let removed = Some l.t.contents.(l.last) in + let new_first = l.last in + l.last <- l.t.prev.(l.last); + l.t.contents.(new_first) <- v; + l.t.next.(l.last) <- -1; + l.t.prev.(new_first) <- -1; + l.t.next.(new_first) <- l.first; + l.t.prev.(l.first) <- new_first; + l.first <- new_first; removed in - (t.first, removed) + (l.first, removed) -let insert_before t v i = - let removed = - if t.free <> -1 then ( - let new_index = t.free in - t.free <- Vector.get t.next t.free; - if t.free <> -1 then Vector.set t.prev t.free (-1); - let i_prev = Vector.get t.prev i in - Vector.set t.prev new_index i_prev; - Vector.set t.next i_prev new_index; - Vector.set t.prev i new_index; - Vector.set t.next new_index i; - if t.size = 0 then ( - t.first <- new_index; - t.last <- new_index); - Vector.set t.contents new_index v; - t.size <- t.size + 1; - None) - else - let removed = Some (Vector.get t.contents t.last) in - let new_first = t.last in - t.last <- Vector.get t.prev t.last; - Vector.set t.contents new_first v; - Vector.set t.next t.last (-1); - Vector.set t.prev new_first (-1); - Vector.set t.next new_first t.first; - Vector.set t.prev t.first new_first; - t.first <- new_first; - removed - in - (t.first, removed) +let promote l i = + if i <> l.first then ( + l.t.next.(l.t.prev.(i)) <- l.t.next.(i); + if i <> l.last then l.t.prev.(l.t.next.(i)) <- l.t.prev.(i) + else l.last <- l.t.prev.(i); + l.t.prev.(l.first) <- i; + l.t.next.(i) <- l.first; + l.t.prev.(i) <- -1; + l.first <- i); + l.first + +let remove l i = + if i <> l.first then l.t.next.(l.t.prev.(i)) <- l.t.next.(i); + if i <> l.last then l.t.prev.(l.t.next.(i)) <- l.t.prev.(i) + else l.last <- l.t.prev.(l.last); + if l.t.free <> -1 then l.t.prev.(l.t.free) <- i; + l.t.next.(i) <- l.t.free; + l.t.prev.(i) <- -1; + l.t.free <- i; + l.size <- l.size - 1 + +let get l i1 = l.t.contents.(i1) +let length l = l.size diff --git a/src/dllist.mli b/src/dllist.mli index 2c7e8ae..646f9ea 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -1,12 +1,11 @@ type 'a t +type 'a l val create : int -> 'a -> 'a t -val length : 'a t -> int -val append : 'a t -> 'a -> int * 'a option -val promote : 'a t -> int -> int -val remove : 'a t -> int -> unit -val get : 'a t -> int -> 'a -val clear : 'a t -> unit -val is_empty : 'a t -> bool -val get_ends : 'a t -> int * int -val insert_before : 'a t -> 'a -> int +val create_list : 'a t -> 'a l +val length : 'a l -> int +val append : 'a l -> 'a -> int * 'a option +val promote : 'a l -> int -> int +val remove : 'a l -> int -> unit +val get : 'a l -> int -> 'a +val clear : 'a l -> unit diff --git a/src/dllist2.ml b/src/dllist2.ml deleted file mode 100644 index 2ef00a0..0000000 --- a/src/dllist2.ml +++ /dev/null @@ -1,89 +0,0 @@ -type 'a t = { - contents : 'a array; - witness : 'a; - prev : int array; - next : int array; - mutable first : int; - mutable last : int; - mutable free : int; - cap : int; - mutable size : int; -} - -type 'a l = { contents : 'a array; mutable free : int } - -let create l c witness = - { - contents = l.contents; - witness; - prev = Array.init c pred; - next = Array.init c (fun i -> if i = c - 1 then -1 else succ i); - first = -1; - last = -1; - free = l.free; - cap = c; - size = 0; - } - -let clear t = - t.first <- -1; - t.last <- -1; - t.free <- 0; - t.size <- 0; - let o = t.cap - 1 in - let o1 = 0 in - for i = o1 to o do - t.contents.(i) <- t.witness; - t.prev.(i) <- -1; - t.next.(i) <- -1 - done - -let append t v = - let removed = - if t.free <> -1 then ( - let index = t.free in - t.free <- t.next.(t.free); - if t.free <> -1 then t.prev.(t.free) <- -1; - t.next.(index) <- t.first; - if t.size = 0 then t.last <- index else t.prev.(t.first) <- index; - t.first <- index; - t.contents.(index) <- v; - t.size <- t.size + 1; - None) - else - let removed = Some t.contents.(t.last) in - let new_first = t.last in - t.last <- t.prev.(t.last); - t.contents.(new_first) <- v; - t.next.(t.last) <- -1; - t.prev.(new_first) <- -1; - t.next.(new_first) <- t.first; - t.prev.(t.first) <- new_first; - t.first <- new_first; - removed - in - (t.first, removed) - -let promote t i = - if i <> t.first then ( - t.next.(t.prev.(i)) <- t.next.(i); - if i <> t.last then t.prev.(t.next.(i)) <- t.prev.(i) - else t.last <- t.prev.(i); - t.prev.(t.first) <- i; - t.next.(i) <- t.first; - t.prev.(i) <- -1; - t.first <- i); - t.first - -let remove t i = - if i <> t.first then t.next.(t.prev.(i)) <- t.next.(i); - if i <> t.last then t.prev.(t.next.(i)) <- t.prev.(i) - else t.last <- t.prev.(t.last); - if t.free <> -1 then t.prev.(t.free) <- i; - t.next.(i) <- t.free; - t.prev.(i) <- -1; - t.free <- i; - t.size <- t.size - 1 - -let get t i1 = t.contents.(i1) -let length t = t.size diff --git a/src/dllist2.mli b/src/dllist2.mli deleted file mode 100644 index d0f9182..0000000 --- a/src/dllist2.mli +++ /dev/null @@ -1,10 +0,0 @@ -type 'a t -type 'a l - -val create : 'a l -> int -> 'a -> 'a t -val length : 'a t -> int -val append : 'a t -> 'a -> int * 'a option -val promote : 'a t -> int -> int -val remove : 'a t -> int -> unit -val get : 'a t -> int -> 'a -val clear : 'a t -> unit diff --git a/src/lru.ml b/src/lru.ml index 34f23ad..10f82c8 100644 --- a/src/lru.ml +++ b/src/lru.ml @@ -13,7 +13,7 @@ struct type 'a t = { tbl : (int * 'a) H.t; - lst : K.t Dllist.t; + lst : K.t Dllist.l; cap : int; stats : Stats.t; } @@ -21,7 +21,7 @@ struct let unsafe_v c = { tbl = H.create c; - lst = Dllist.create c dummy; + lst = Dllist.create c dummy |> Dllist.create_list; cap = c; stats = Stats.v (); } From a64d09a72b8da90e4f8f0328e245ed97477b0872 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 25 May 2022 14:17:19 +0200 Subject: [PATCH 05/82] update lfu to work with dllist -> bugs to correct --- src/dllist.ml | 27 +++++++++++++ src/dllist.mli | 5 +++ src/lfu.ml | 108 ++++++++++++++++++++++++------------------------- 3 files changed, 86 insertions(+), 54 deletions(-) diff --git a/src/dllist.ml b/src/dllist.ml index 3ef2fac..ddd3074 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -25,6 +25,8 @@ let create cap witness = } let create_list t = { first = -1; last = -1; size = 0; t } +let next l i = l.t.next.(i) +let ends l = (l.first, l.last) let clear l = let rec aux i = @@ -89,3 +91,28 @@ let remove l i = let get l i1 = l.t.contents.(i1) let length l = l.size +let is_empty l = l.size = 0 + +let append_before l i v = + let new_index = l.t.free in + l.t.free <- l.t.next.(l.t.free); + if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; + if l.first = i then l.first <- new_index + else l.t.next.(l.t.prev.(i)) <- new_index; + l.t.next.(new_index) <- i; + l.t.prev.(i) <- new_index; + l.t.contents.(new_index) <- v; + l.size <- l.size + 1; + new_index + +let append_after l i v = + let new_index = l.t.free in + l.t.free <- l.t.next.(l.t.free); + if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; + if l.last = i then l.last <- new_index + else l.t.prev.(l.t.next.(i)) <- new_index; + l.t.prev.(new_index) <- i; + l.t.next.(i) <- new_index; + l.t.contents.(new_index) <- v; + l.size <- l.size + 1; + new_index \ No newline at end of file diff --git a/src/dllist.mli b/src/dllist.mli index 646f9ea..f183768 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -9,3 +9,8 @@ val promote : 'a l -> int -> int val remove : 'a l -> int -> unit val get : 'a l -> int -> 'a val clear : 'a l -> unit +val is_empty : 'a l -> bool +val append_before : 'a l -> int -> 'a -> int +val append_after : 'a l -> int -> 'a -> int +val next : 'a l -> int -> int +val ends : 'a l -> int * int \ No newline at end of file diff --git a/src/lfu.ml b/src/lfu.ml index 04b8079..8524c9c 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -8,29 +8,25 @@ struct module H = Hashtbl.Make (K) type key = K.t - type freq_index = int - type key_index = int + (* type freq_index = int + type key_index = int *) type 'a t = { - value : (freq_index * key_index * 'a) H.t; - frequency : (int * key Dllist.t) Dllist.t; + tbl : key Dllist.t; + value : (int * int * 'a) H.t; + frequency : (int * key Dllist.l) Dllist.l; cap : int; stats : Stats.t; } - type 'a l = { contents : 'a array; mutable free : int } - let dummy : K.t = Obj.magic (ref 0) let unsafe_v c = - let key_lst = { contents = Array.make c dummy; free = 0 } in - let freq_lst = { contents = Array.make c dummy; free = 0 } in - { - value = H.create c; - frequency = Dllist.create freq_lst 0 (0, Dllist.create key_lst 0 dummy); - cap = c; - stats = Stats.v (); - } + let tbl = Dllist.create c dummy in + let freq = + Dllist.create c (-1, Dllist.create_list tbl) |> Dllist.create_list + in + { tbl; value = H.create c; frequency = freq; cap = c; stats = Stats.v () } let v c = if c <= 0 then invalid_arg "capacity must be strictly positive"; @@ -47,27 +43,30 @@ struct Stats.clear t.stats let update t k = - let freq_cell, key_cell, _value = H.find t.value k in - let freq, freq_list = freq_cell.content in - let freq_next, _freq_next_list = freq_cell.next.content in - (if freq <> freq_next - 1 then - let real_next_freq_list = Dbllist.create () in - let real_freq = freq + 1 in - ignore - (Dbllist.append_after t.frequency freq_cell + let freq_index, key_index, _value = H.find t.value k in + let freq, freq_list = Dllist.get t.frequency freq_index in + let freq_next, _freq_next_list = + Dllist.(get t.frequency (next t.frequency freq_index)) + in + let new_freq_index = + if freq <> freq_next - 1 then + let real_next_freq_list = Dllist.create_list t.tbl in + let real_freq = freq + 1 in + Dllist.append_before t.frequency freq_index (real_freq, real_next_freq_list) - : freq_cell)); - Dbllist.remove freq_list key_cell; - let _freq_next, freq_next_list = freq_cell.next.content in - if Dbllist.is_empty freq_list then Dbllist.remove t.frequency freq_cell; - let last = Dbllist.append freq_next_list k in - (freq_cell.next, last) + else freq_next + in + Dllist.remove freq_list key_index; + let _freq_next, freq_next_list = Dllist.get t.frequency new_freq_index in + if Dllist.is_empty freq_list then Dllist.remove t.frequency freq_index; + let new_key_index, _opt = Dllist.append freq_next_list k in + (new_freq_index, new_key_index) let find t k = - let _freq_cell, _key_cell, v = H.find t.value k in + let _freq_index, _key_index, v = H.find t.value k in Stats.hit t.stats; - let new_freq_cell, new_last_cell = update t k in - H.replace t.value k (new_freq_cell, new_last_cell, v); + let new_freq_index, new_last_index = update t k in + H.replace t.value k (new_freq_index, new_last_index, v); v let find_opt t k = @@ -86,43 +85,45 @@ struct let add t k v = if H.length t.value = 0 then - let first_freq_list = Dllist.create 0 dummy in + let first_freq_list = Dllist.create_list t.tbl in let new_key_index, _opt = Dllist.append first_freq_list k in let first_key_index, _opt = Dllist.append t.frequency (1, first_freq_list) in H.replace t.value k (first_key_index, new_key_index, v) else - let first_freq_index, _last_freq_index = Dllist.get_ends t.frequency in - + let first_freq_index, _last_freq_index = Dllist.ends t.frequency in let freq, _key_list = Dllist.get t.frequency first_freq_index in - (if freq <> 1 then - let real_first_freq_list = Dllist.create 0 dummy in - Dllist.append_before t.frequency first_freq_cell (1, real_first_freq_list)); + let new_first_freq_index = + if freq <> 1 then + let real_first_freq_list = Dllist.create_list t.tbl in + Dllist.append_after t.frequency first_freq_index + (1, real_first_freq_list) + else first_freq_index + in - let first_freq_cell, _last_freq_cell = Dbllist.get t.frequency in - let _freq, freq_list = first_freq_cell.content in - let new_cell = Dbllist.append freq_list k in - H.replace t.value k (first_freq_cell, new_cell, v) + let _freq, freq_list = Dllist.get t.frequency new_first_freq_index in + let new_index, _opt = Dllist.append freq_list k in + H.replace t.value k (new_first_freq_index, new_index, v) let replace t k v = try - let _freq_cell, _key_cell, _value = H.find t.value k in - let new_freq_cell, new_last_cell = update t k in + let _freq_index, _key_index, _value = H.find t.value k in + let new_freq_index, new_key_index = update t k in Stats.replace t.stats; - H.replace t.value k (new_freq_cell, new_last_cell, v) + H.replace t.value k (new_freq_index, new_key_index, v) with Not_found -> Stats.add (H.length t.value + 1) t.stats; if H.length t.value < t.cap then add t k v else - let first_freq_cell, _last_freq_cell = Dbllist.get t.frequency in - let _freq, freq_list = first_freq_cell.content in - let first_cell, _last_cell = Dbllist.get freq_list in - Dbllist.remove freq_list first_cell; - if Dbllist.is_empty freq_list then - Dbllist.remove t.frequency first_freq_cell; - let remove_key = first_cell.content in + let first_freq_index, _last_freq_index = Dllist.ends t.frequency in + let _freq, freq_list = Dllist.get t.frequency first_freq_index in + let first_index, _last_index = Dllist.ends freq_list in + let remove_key = Dllist.get freq_list first_index in + Dllist.remove freq_list first_index; + if Dllist.is_empty freq_list then + Dllist.remove t.frequency first_freq_index; H.remove t.value remove_key; Stats.discard t.stats; add t k v @@ -131,9 +132,8 @@ struct try let freq_index, key_index, _value = H.find t.value k in H.remove t.value k; - let _freq, freq_list = Dllist.get t.frequency freq_index in - Dllist.remove freq_list key_index; - (* if Dbllist.is_empty freq_list then Dllist.remove t.frequency freq_cell; *) + let _freq, key_list = Dllist.get t.frequency freq_index in + Dllist.remove key_list key_index; Stats.remove t.stats with Not_found -> () end From 9d1ab1e12d4f9e6533b482fbbfa71b6324e37946 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 25 May 2022 15:03:10 +0200 Subject: [PATCH 06/82] add display --- src/dbllist.ml | 3 ++- src/dbllist.mli | 3 ++- src/dllist.ml | 15 +++++++++++++++ src/dllist.mli | 3 ++- src/lfu.ml | 12 ++++++++++++ 5 files changed, 33 insertions(+), 3 deletions(-) diff --git a/src/dbllist.ml b/src/dbllist.ml index a85b8e1..e5f86e2 100644 --- a/src/dbllist.ml +++ b/src/dbllist.ml @@ -53,7 +53,8 @@ let append_after l c v = new_cell let clear l = l := Nil -let get l = match !l with Nil -> assert false | List l -> (l.first, l.last) +let ends l = match !l with Nil -> assert false | List l -> (l.first, l.last) +let get c = c.content let remove t c = match !t with diff --git a/src/dbllist.mli b/src/dbllist.mli index dea08c5..3a94b1a 100644 --- a/src/dbllist.mli +++ b/src/dbllist.mli @@ -12,5 +12,6 @@ val append : 'a t -> 'a -> 'a cell val append_before : 'a t -> 'a cell -> 'a -> 'a cell val append_after : 'a t -> 'a cell -> 'a -> 'a cell val clear : 'a t -> unit -val get : 'a t -> 'a cell * 'a cell +val ends : 'a t -> 'a cell * 'a cell val remove : 'a t -> 'a cell -> unit +val get : 'a cell -> 'a diff --git a/src/dllist.ml b/src/dllist.ml index ddd3074..291b37f 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -14,6 +14,18 @@ type 'a l = { t : 'a t; } +let status l = + Fmt.pr "first : %d\n" l.first; + Fmt.pr "last : %d\n" l.last; + for i = 0 to Array.length l.t.prev - 1 do + Fmt.pr " %d " l.t.prev.(i) + done; + Fmt.pr "\n\n"; + for i = 0 to Array.length l.t.next - 1 do + Fmt.pr " %d " l.t.next.(i) + done; + Fmt.pr "\n\n" + let create cap witness = { cap; @@ -45,6 +57,8 @@ let clear l = let append l v = let removed = if l.t.free <> -1 then ( + Fmt.pr ":)\n"; + status l; let index = l.t.free in l.t.free <- l.t.next.(l.t.free); if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; @@ -66,6 +80,7 @@ let append l v = l.first <- new_first; removed in + (l.first, removed) let promote l i = diff --git a/src/dllist.mli b/src/dllist.mli index f183768..3ad2a1e 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -13,4 +13,5 @@ val is_empty : 'a l -> bool val append_before : 'a l -> int -> 'a -> int val append_after : 'a l -> int -> 'a -> int val next : 'a l -> int -> int -val ends : 'a l -> int * int \ No newline at end of file +val ends : 'a l -> int * int +val status : 'a l -> unit \ No newline at end of file diff --git a/src/lfu.ml b/src/lfu.ml index 8524c9c..2239777 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -23,6 +23,7 @@ struct let unsafe_v c = let tbl = Dllist.create c dummy in + let freq = Dllist.create c (-1, Dllist.create_list tbl) |> Dllist.create_list in @@ -43,6 +44,7 @@ struct Stats.clear t.stats let update t k = + Fmt.pr "u\n"; let freq_index, key_index, _value = H.find t.value k in let freq, freq_list = Dllist.get t.frequency freq_index in let freq_next, _freq_next_list = @@ -63,6 +65,7 @@ struct (new_freq_index, new_key_index) let find t k = + Fmt.pr "-\n"; let _freq_index, _key_index, v = H.find t.value k in Stats.hit t.stats; let new_freq_index, new_last_index = update t k in @@ -76,6 +79,7 @@ struct None let mem t k = + Fmt.pr "m\n"; try ignore (find t k); true @@ -84,6 +88,10 @@ struct false let add t k v = + Fmt.pr "add---\n"; + Dllist.status t.frequency; + Fmt.pr "/add---\n"; + if H.length t.value = 0 then let first_freq_list = Dllist.create_list t.tbl in let new_key_index, _opt = Dllist.append first_freq_list k in @@ -108,6 +116,9 @@ struct H.replace t.value k (new_first_freq_index, new_index, v) let replace t k v = + Fmt.pr "R---\n"; + Dllist.status t.frequency; + Fmt.pr "/R---\n"; try let _freq_index, _key_index, _value = H.find t.value k in let new_freq_index, new_key_index = update t k in @@ -129,6 +140,7 @@ struct add t k v let remove t k = + Fmt.pr "r\n"; try let freq_index, key_index, _value = H.find t.value k in H.remove t.value k; From a290dff5a6c6a256be5c27b79713e4eafaba8f2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Pascutto?= Date: Wed, 25 May 2022 18:54:55 +0200 Subject: [PATCH 07/82] wip --- src/dllist.ml | 90 ++++++++++++++++++++++++++++---------------------- src/dllist.mli | 19 ++++++----- src/dune | 1 + src/lfu.ml | 62 ++++++++++++++++------------------ src/lru.ml | 2 +- test/lfu.ml | 88 ++++++++++++++++++++++++------------------------ 6 files changed, 134 insertions(+), 128 deletions(-) diff --git a/src/dllist.ml b/src/dllist.ml index 291b37f..b135802 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -14,17 +14,14 @@ type 'a l = { t : 'a t; } -let status l = - Fmt.pr "first : %d\n" l.first; - Fmt.pr "last : %d\n" l.last; - for i = 0 to Array.length l.t.prev - 1 do - Fmt.pr " %d " l.t.prev.(i) - done; - Fmt.pr "\n\n"; - for i = 0 to Array.length l.t.next - 1 do - Fmt.pr " %d " l.t.next.(i) - done; - Fmt.pr "\n\n" +type 'a c = int + +let status ppf l = + Fmt.pf ppf "first : %d@\n" l.first; + Fmt.pf ppf "last : %d@\n" l.last; + Fmt.(pf ppf "free : %a@\n" int) l.t.free; + Fmt.(pf ppf "prev : %a@\n" (array ~sep:sp int)) l.t.prev; + Fmt.(pf ppf "next : %a@\n@\n" (array ~sep:sp int)) l.t.next let create cap witness = { @@ -37,7 +34,11 @@ let create cap witness = } let create_list t = { first = -1; last = -1; size = 0; t } -let next l i = l.t.next.(i) + +let next l i = + let n = l.t.next.(i) in + if n = -1 then i else n + let ends l = (l.first, l.last) let clear l = @@ -57,77 +58,86 @@ let clear l = let append l v = let removed = if l.t.free <> -1 then ( - Fmt.pr ":)\n"; - status l; let index = l.t.free in l.t.free <- l.t.next.(l.t.free); if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; - l.t.next.(index) <- l.first; - if l.size = 0 then l.last <- index else l.t.prev.(l.first) <- index; - l.first <- index; + l.t.next.(index) <- -1; + if l.size = 0 then l.first <- index else l.t.next.(l.last) <- index; + l.t.prev.(index) <- l.last; + l.last <- index; l.t.contents.(index) <- v; l.size <- l.size + 1; None) else - let removed = Some l.t.contents.(l.last) in - let new_first = l.last in - l.last <- l.t.prev.(l.last); - l.t.contents.(new_first) <- v; - l.t.next.(l.last) <- -1; - l.t.prev.(new_first) <- -1; - l.t.next.(new_first) <- l.first; - l.t.prev.(l.first) <- new_first; - l.first <- new_first; + let removed = Some l.t.contents.(l.first) in + let index = l.first in + l.t.prev.(l.t.next.(l.first)) <- -1; + l.first <- l.t.next.(l.first); + l.t.prev.(index) <- l.last; + l.t.next.(l.last) <- index; + l.last <- index; + l.t.contents.(index) <- v; + l.t.next.(index) <- -1; removed in - + assert (l.first <> -1); (l.first, removed) let promote l i = - if i <> l.first then ( - l.t.next.(l.t.prev.(i)) <- l.t.next.(i); - if i <> l.last then l.t.prev.(l.t.next.(i)) <- l.t.prev.(i) - else l.last <- l.t.prev.(i); - l.t.prev.(l.first) <- i; - l.t.next.(i) <- l.first; - l.t.prev.(i) <- -1; - l.first <- i); - l.first + if i <> l.last then ( + l.t.prev.(l.t.next.(i)) <- l.t.prev.(i); + if i <> l.first then l.t.next.(l.t.prev.(i)) <- l.t.next.(i) + else l.first <- l.t.next.(i); + l.t.next.(l.last) <- i; + l.t.prev.(i) <- l.last; + l.t.next.(i) <- -1; + l.last <- i); + l.last let remove l i = - if i <> l.first then l.t.next.(l.t.prev.(i)) <- l.t.next.(i); + Fmt.epr "%a@." status l; + Fmt.epr "%d@." i; + if i <> l.first then l.t.next.(l.t.prev.(i)) <- l.t.next.(i) + else l.first <- l.t.next.(l.first); if i <> l.last then l.t.prev.(l.t.next.(i)) <- l.t.prev.(i) else l.last <- l.t.prev.(l.last); if l.t.free <> -1 then l.t.prev.(l.t.free) <- i; l.t.next.(i) <- l.t.free; l.t.prev.(i) <- -1; l.t.free <- i; - l.size <- l.size - 1 + l.size <- l.size - 1; + l.t.contents.(i) <- l.t.witness -let get l i1 = l.t.contents.(i1) +let get l i = l.t.contents.(i) let length l = l.size let is_empty l = l.size = 0 let append_before l i v = let new_index = l.t.free in + assert (new_index <> -1); l.t.free <- l.t.next.(l.t.free); if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; if l.first = i then l.first <- new_index else l.t.next.(l.t.prev.(i)) <- new_index; l.t.next.(new_index) <- i; + l.t.prev.(new_index) <- l.t.prev.(i); l.t.prev.(i) <- new_index; l.t.contents.(new_index) <- v; l.size <- l.size + 1; + assert (l.first <> -1); new_index let append_after l i v = let new_index = l.t.free in + assert (new_index <> -1); l.t.free <- l.t.next.(l.t.free); if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; if l.last = i then l.last <- new_index else l.t.prev.(l.t.next.(i)) <- new_index; l.t.prev.(new_index) <- i; + l.t.next.(new_index) <- l.t.next.(i); l.t.next.(i) <- new_index; l.t.contents.(new_index) <- v; l.size <- l.size + 1; - new_index \ No newline at end of file + assert (l.first <> -1); + new_index diff --git a/src/dllist.mli b/src/dllist.mli index 3ad2a1e..18d46e3 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -1,17 +1,18 @@ type 'a t type 'a l +type 'a c val create : int -> 'a -> 'a t val create_list : 'a t -> 'a l val length : 'a l -> int -val append : 'a l -> 'a -> int * 'a option -val promote : 'a l -> int -> int -val remove : 'a l -> int -> unit -val get : 'a l -> int -> 'a +val append : 'a l -> 'a -> 'a c * 'a option +val promote : 'a l -> 'a c -> 'a c +val remove : 'a l -> 'a c -> unit +val get : 'a l -> 'a c -> 'a val clear : 'a l -> unit val is_empty : 'a l -> bool -val append_before : 'a l -> int -> 'a -> int -val append_after : 'a l -> int -> 'a -> int -val next : 'a l -> int -> int -val ends : 'a l -> int * int -val status : 'a l -> unit \ No newline at end of file +val append_before : 'a l -> 'a c -> 'a -> 'a c +val append_after : 'a l -> 'a c -> 'a -> 'a c +val next : 'a l -> 'a c -> 'a c +val ends : 'a l -> 'a c * 'a c +val status : 'a l Fmt.t diff --git a/src/dune b/src/dune index b2c5a17..96d033b 100644 --- a/src/dune +++ b/src/dune @@ -1,6 +1,7 @@ (library (public_name cachecache) (name cachecache) + (flags :standard -w -21) (libraries fmt vector)) ; (rule diff --git a/src/lfu.ml b/src/lfu.ml index 2239777..958ca5b 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -12,22 +12,19 @@ struct type key_index = int *) type 'a t = { - tbl : key Dllist.t; - value : (int * int * 'a) H.t; + lsts : key Dllist.t; + value : ((int * key Dllist.l) Dllist.c * key Dllist.c * 'a) H.t; frequency : (int * key Dllist.l) Dllist.l; cap : int; stats : Stats.t; } - let dummy : K.t = Obj.magic (ref 0) + let dummy = Obj.magic (ref 0) let unsafe_v c = - let tbl = Dllist.create c dummy in - - let freq = - Dllist.create c (-1, Dllist.create_list tbl) |> Dllist.create_list - in - { tbl; value = H.create c; frequency = freq; cap = c; stats = Stats.v () } + let lsts = Dllist.create c dummy in + let freq = Dllist.create c dummy |> Dllist.create_list in + { lsts; value = H.create c; frequency = freq; cap = c; stats = Stats.v () } let v c = if c <= 0 then invalid_arg "capacity must be strictly positive"; @@ -44,28 +41,31 @@ struct Stats.clear t.stats let update t k = - Fmt.pr "u\n"; + Fmt.pr "u@."; + Fmt.epr "FREQ @[%a@]@." Dllist.status t.frequency; let freq_index, key_index, _value = H.find t.value k in let freq, freq_list = Dllist.get t.frequency freq_index in - let freq_next, _freq_next_list = - Dllist.(get t.frequency (next t.frequency freq_index)) - in + let next = Dllist.next t.frequency freq_index in + let freq_next, _freq_next_list = Dllist.get t.frequency next in let new_freq_index = - if freq <> freq_next - 1 then - let real_next_freq_list = Dllist.create_list t.tbl in + if freq + 1 <> freq_next then + let real_next_freq_list = Dllist.create_list t.lsts in let real_freq = freq + 1 in - Dllist.append_before t.frequency freq_index + Dllist.append_after t.frequency freq_index (real_freq, real_next_freq_list) - else freq_next + else next in + Fmt.epr "HELLO0@."; + Fmt.epr "FREQ @[%a@]@." Dllist.status t.frequency; Dllist.remove freq_list key_index; + Fmt.epr "HELLO1@."; let _freq_next, freq_next_list = Dllist.get t.frequency new_freq_index in if Dllist.is_empty freq_list then Dllist.remove t.frequency freq_index; let new_key_index, _opt = Dllist.append freq_next_list k in (new_freq_index, new_key_index) let find t k = - Fmt.pr "-\n"; + Fmt.pr "-@."; let _freq_index, _key_index, v = H.find t.value k in Stats.hit t.stats; let new_freq_index, new_last_index = update t k in @@ -79,7 +79,7 @@ struct None let mem t k = - Fmt.pr "m\n"; + Fmt.pr "m@."; try ignore (find t k); true @@ -88,12 +88,9 @@ struct false let add t k v = - Fmt.pr "add---\n"; - Dllist.status t.frequency; - Fmt.pr "/add---\n"; - + Fmt.pr "a@."; if H.length t.value = 0 then - let first_freq_list = Dllist.create_list t.tbl in + let first_freq_list = Dllist.create_list t.lsts in let new_key_index, _opt = Dllist.append first_freq_list k in let first_key_index, _opt = Dllist.append t.frequency (1, first_freq_list) @@ -102,23 +99,19 @@ struct else let first_freq_index, _last_freq_index = Dllist.ends t.frequency in let freq, _key_list = Dllist.get t.frequency first_freq_index in - let new_first_freq_index = if freq <> 1 then - let real_first_freq_list = Dllist.create_list t.tbl in - Dllist.append_after t.frequency first_freq_index + let real_first_freq_list = Dllist.create_list t.lsts in + Dllist.append_before t.frequency first_freq_index (1, real_first_freq_list) else first_freq_index in - let _freq, freq_list = Dllist.get t.frequency new_first_freq_index in let new_index, _opt = Dllist.append freq_list k in H.replace t.value k (new_first_freq_index, new_index, v) let replace t k v = - Fmt.pr "R---\n"; - Dllist.status t.frequency; - Fmt.pr "/R---\n"; + Fmt.pr "R@."; try let _freq_index, _key_index, _value = H.find t.value k in let new_freq_index, new_key_index = update t k in @@ -127,7 +120,8 @@ struct with Not_found -> Stats.add (H.length t.value + 1) t.stats; if H.length t.value < t.cap then add t k v - else + else ( + Fmt.pr "d@."; let first_freq_index, _last_freq_index = Dllist.ends t.frequency in let _freq, freq_list = Dllist.get t.frequency first_freq_index in let first_index, _last_index = Dllist.ends freq_list in @@ -137,10 +131,10 @@ struct Dllist.remove t.frequency first_freq_index; H.remove t.value remove_key; Stats.discard t.stats; - add t k v + add t k v) let remove t k = - Fmt.pr "r\n"; + Fmt.pr "r@."; try let freq_index, key_index, _value = H.find t.value k in H.remove t.value k; diff --git a/src/lru.ml b/src/lru.ml index 10f82c8..edeb0d0 100644 --- a/src/lru.ml +++ b/src/lru.ml @@ -12,7 +12,7 @@ struct let dummy : K.t = Obj.magic (ref 0) type 'a t = { - tbl : (int * 'a) H.t; + tbl : (K.t Dllist.c * 'a) H.t; lst : K.t Dllist.l; cap : int; stats : Stats.t; diff --git a/test/lfu.ml b/test/lfu.ml index 4327cbb..53c4304 100644 --- a/test/lfu.ml +++ b/test/lfu.ml @@ -46,23 +46,23 @@ struct if i = 0 then l else let k = add_fresh_value db_t t in - if check then ( - Alcotest.(check bool) - "[Though-DB] Value just added is found (mem)" true - (DB_Cached.mem db_t k); + if check then + (* Alcotest.(check bool) *) + (* "[Though-DB] Value just added is found (mem)" true *) + (* (DB_Cached.mem db_t k); *) + (* Alcotest.(check key) *) + (* "[Through-DB] Value just added is found (find)" k *) + (* (DB_Cached.find db_t k); *) + (* Alcotest.(check bool) *) + (* "[Through-cache] Value just added is found (mem)" true *) + (* (DB_Cached.Cache.mem db_t k); *) + (* Alcotest.(check key) *) + (* "[Through-cache] Value just added is found in cache (find)" k *) + (* (DB_Cached.Cache.find db_t k); *) + (* Alcotest.(check bool) *) + (* "[Direct] Value just added is found (mem)" true (Cache.mem t k); *) Alcotest.(check key) - "[Through-DB] Value just added is found (find)" k - (DB_Cached.find db_t k); - Alcotest.(check bool) - "[Through-cache] Value just added is found (mem)" true - (DB_Cached.Cache.mem db_t k); - Alcotest.(check key) - "[Through-cache] Value just added is found in cache (find)" k - (DB_Cached.Cache.find db_t k); - Alcotest.(check bool) - "[Direct] Value just added is found (mem)" true (Cache.mem t k); - Alcotest.(check key) - "[Direct] Value just added is found (find)" k (Cache.find t k)); + "[Direct] Value just added is found (find)" k (Cache.find t k); loop (k :: l) (i - 1) in loop [] n @@ -96,11 +96,11 @@ struct Alcotest.(check int) "[Direct] Size is still ten" 10 (Cache.size t); Alcotest.(check bool) "[Direct] Unused value are removed" false (Cache.mem t h); - Alcotest.(check bool) - "[Through-cache] Unused value are removed" true - (DB_Cached.Cache.mem db_t h); - Alcotest.(check bool) - "[Through-DB] Unused value are removed" true (DB_Cached.mem db_t h); + (* Alcotest.(check bool) *) + (* "[Through-cache] Unused value are removed" true *) + (* (DB_Cached.Cache.mem db_t h); *) + (* Alcotest.(check bool) *) + (* "[Through-DB] Unused value are removed" true (DB_Cached.mem db_t h); *) Alcotest.(check bool) "[Direct] Added value is still present" true (Cache.mem t k) | [] -> assert false @@ -119,22 +119,22 @@ struct removed; List.iter (fun k -> - Alcotest.(check bool) - "[Through-DB] Removed values are not present" false - (DB_Cached.mem db_t k); - Alcotest.(check bool) - "[Through-cache] Removed values are not present" false - (DB_Cached.Cache.mem db_t k); + (* Alcotest.(check bool) *) + (* "[Through-DB] Removed values are not present" false *) + (* (DB_Cached.mem db_t k); *) + (* Alcotest.(check bool) *) + (* "[Through-cache] Removed values are not present" false *) + (* (DB_Cached.Cache.mem db_t k); *) Alcotest.(check bool) "[Direct] Removed values are not present" false (Cache.mem t k)) removed; List.iter (fun k -> - Alcotest.(check bool) - "[Through-DB] Other values are present" true (DB_Cached.mem db_t k); - Alcotest.(check bool) - "[Through-cache] Other values are present" true - (DB_Cached.Cache.mem db_t k); + (* Alcotest.(check bool) *) + (* "[Through-DB] Other values are present" true (DB_Cached.mem db_t k); *) + (* Alcotest.(check bool) *) + (* "[Through-cache] Other values are present" true *) + (* (DB_Cached.Cache.mem db_t k); *) Alcotest.(check bool) "[Direct] Other values are present" true (Cache.mem t k)) kept; @@ -144,23 +144,23 @@ struct Cache.remove t k) kept; List.iter - (fun k -> - Alcotest.(check bool) - "[Through-DB] Removed values are not present" false - (DB_Cached.mem db_t k); - Alcotest.(check bool) - "[Through-cache] Removed values are not present" false - (DB_Cached.Cache.mem db_t k); + (fun _k -> + (* Alcotest.(check bool) *) + (* "[Through-DB] Removed values are not present" false *) + (* (DB_Cached.mem db_t k); *) + (* Alcotest.(check bool) *) + (* "[Through-cache] Removed values are not present" false *) + (* (DB_Cached.Cache.mem db_t k); *) Alcotest.(check bool) "[Direct] Cache is empty" true (Cache.is_empty t)) kept; let new_value = add_fresh_values ~check:false db_t t (cap / 2) in List.iter (fun k -> - Alcotest.(check bool) - "[Through-DB] New values are present" true (DB_Cached.mem db_t k); - Alcotest.(check bool) - "[Through-cache] New values are present" true - (DB_Cached.Cache.mem db_t k); + (* Alcotest.(check bool) *) + (* "[Through-DB] New values are present" true (DB_Cached.mem db_t k); *) + (* Alcotest.(check bool) *) + (* "[Through-cache] New values are present" true *) + (* (DB_Cached.Cache.mem db_t k); *) Alcotest.(check bool) "[Direct] New values are present after a remove" true (Cache.mem t k)) new_value From f73e06841a176ca224e9c7bee6118a67e0247b17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Pascutto?= Date: Fri, 27 May 2022 08:03:18 +0200 Subject: [PATCH 08/82] final bugfix --- cachecache.opam | 1 - src/chunk_lst.ml | 2 +- src/dllist.ml | 27 ++++---------- src/dllist.mli | 22 +++++++++--- src/dune | 1 - src/lfu.ml | 48 ++++++++++++------------- test/lfu.ml | 92 ++++++++++++++++++++++++------------------------ 7 files changed, 94 insertions(+), 99 deletions(-) diff --git a/cachecache.opam b/cachecache.opam index 9e4b65f..ad5687f 100644 --- a/cachecache.opam +++ b/cachecache.opam @@ -30,7 +30,6 @@ depends: [ "dune" {>= "2.0"} "ocaml" {>= "4.07.1"} "fmt" - "vector" "alcotest" {with-test} "gospel" {with-test} "fpath" {with-test} diff --git a/src/chunk_lst.ml b/src/chunk_lst.ml index dbfb783..5cca134 100644 --- a/src/chunk_lst.ml +++ b/src/chunk_lst.ml @@ -1 +1 @@ -type 'a t = { contents : 'a array; free : int } \ No newline at end of file +type 'a t = { contents : 'a array; free : int } diff --git a/src/dllist.ml b/src/dllist.ml index b135802..a88bb4d 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -16,13 +16,6 @@ type 'a l = { type 'a c = int -let status ppf l = - Fmt.pf ppf "first : %d@\n" l.first; - Fmt.pf ppf "last : %d@\n" l.last; - Fmt.(pf ppf "free : %a@\n" int) l.t.free; - Fmt.(pf ppf "prev : %a@\n" (array ~sep:sp int)) l.t.prev; - Fmt.(pf ppf "next : %a@\n@\n" (array ~sep:sp int)) l.t.next - let create cap witness = { cap; @@ -80,14 +73,13 @@ let append l v = l.t.next.(index) <- -1; removed in - assert (l.first <> -1); - (l.first, removed) + (l.last, removed) let promote l i = if i <> l.last then ( l.t.prev.(l.t.next.(i)) <- l.t.prev.(i); - if i <> l.first then l.t.next.(l.t.prev.(i)) <- l.t.next.(i) - else l.first <- l.t.next.(i); + if i = l.first then l.first <- l.t.next.(i) + else l.t.next.(l.t.prev.(i)) <- l.t.next.(i); l.t.next.(l.last) <- i; l.t.prev.(i) <- l.last; l.t.next.(i) <- -1; @@ -95,12 +87,10 @@ let promote l i = l.last let remove l i = - Fmt.epr "%a@." status l; - Fmt.epr "%d@." i; - if i <> l.first then l.t.next.(l.t.prev.(i)) <- l.t.next.(i) - else l.first <- l.t.next.(l.first); - if i <> l.last then l.t.prev.(l.t.next.(i)) <- l.t.prev.(i) - else l.last <- l.t.prev.(l.last); + if i = l.first then l.first <- l.t.next.(l.first) + else l.t.next.(l.t.prev.(i)) <- l.t.next.(i); + if i = l.last then l.last <- l.t.prev.(l.last) + else l.t.prev.(l.t.next.(i)) <- l.t.prev.(i); if l.t.free <> -1 then l.t.prev.(l.t.free) <- i; l.t.next.(i) <- l.t.free; l.t.prev.(i) <- -1; @@ -114,7 +104,6 @@ let is_empty l = l.size = 0 let append_before l i v = let new_index = l.t.free in - assert (new_index <> -1); l.t.free <- l.t.next.(l.t.free); if l.t.free <> -1 then l.t.prev.(l.t.free) <- -1; if l.first = i then l.first <- new_index @@ -124,7 +113,6 @@ let append_before l i v = l.t.prev.(i) <- new_index; l.t.contents.(new_index) <- v; l.size <- l.size + 1; - assert (l.first <> -1); new_index let append_after l i v = @@ -139,5 +127,4 @@ let append_after l i v = l.t.next.(i) <- new_index; l.t.contents.(new_index) <- v; l.size <- l.size + 1; - assert (l.first <> -1); new_index diff --git a/src/dllist.mli b/src/dllist.mli index 18d46e3..8c2f084 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -1,6 +1,21 @@ -type 'a t -type 'a l -type 'a c +type 'a t = private { + cap : int; + witness : 'a; + contents : 'a array; + mutable free : int; + prev : int array; + next : int array; +} +(*@ invariant cap > 0 *) + +type 'a l = private { + mutable first : int; + mutable last : int; + mutable size : int; + t : 'a t; +} + +type 'a c = int val create : int -> 'a -> 'a t val create_list : 'a t -> 'a l @@ -15,4 +30,3 @@ val append_before : 'a l -> 'a c -> 'a -> 'a c val append_after : 'a l -> 'a c -> 'a -> 'a c val next : 'a l -> 'a c -> 'a c val ends : 'a l -> 'a c * 'a c -val status : 'a l Fmt.t diff --git a/src/dune b/src/dune index 96d033b..b2c5a17 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,6 @@ (library (public_name cachecache) (name cachecache) - (flags :standard -w -21) (libraries fmt vector)) ; (rule diff --git a/src/lfu.ml b/src/lfu.ml index 958ca5b..9400a82 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -41,35 +41,32 @@ struct Stats.clear t.stats let update t k = - Fmt.pr "u@."; - Fmt.epr "FREQ @[%a@]@." Dllist.status t.frequency; let freq_index, key_index, _value = H.find t.value k in let freq, freq_list = Dllist.get t.frequency freq_index in let next = Dllist.next t.frequency freq_index in let freq_next, _freq_next_list = Dllist.get t.frequency next in let new_freq_index = - if freq + 1 <> freq_next then - let real_next_freq_list = Dllist.create_list t.lsts in - let real_freq = freq + 1 in - Dllist.append_after t.frequency freq_index - (real_freq, real_next_freq_list) - else next + if freq_next = freq + 1 then next + else + let new_next = Dllist.create_list t.lsts in + (* FIXME: t.frequency could be full at this point, and append_after would fail *) + Dllist.append_after t.frequency freq_index (freq + 1, new_next) in - Fmt.epr "HELLO0@."; - Fmt.epr "FREQ @[%a@]@." Dllist.status t.frequency; Dllist.remove freq_list key_index; - Fmt.epr "HELLO1@."; let _freq_next, freq_next_list = Dllist.get t.frequency new_freq_index in - if Dllist.is_empty freq_list then Dllist.remove t.frequency freq_index; + if Dllist.is_empty freq_list then + (* FIXME: this should happen before, to leave room for the new value if + t.frequency is full *) + Dllist.remove t.frequency freq_index; let new_key_index, _opt = Dllist.append freq_next_list k in + assert (_opt = None); (new_freq_index, new_key_index) let find t k = - Fmt.pr "-@."; let _freq_index, _key_index, v = H.find t.value k in Stats.hit t.stats; - let new_freq_index, new_last_index = update t k in - H.replace t.value k (new_freq_index, new_last_index, v); + let new_freq_index, new_key_index = update t k in + H.replace t.value k (new_freq_index, new_key_index, v); v let find_opt t k = @@ -79,7 +76,6 @@ struct None let mem t k = - Fmt.pr "m@."; try ignore (find t k); true @@ -88,30 +84,31 @@ struct false let add t k v = - Fmt.pr "a@."; - if H.length t.value = 0 then + if H.length t.value = 0 then ( let first_freq_list = Dllist.create_list t.lsts in let new_key_index, _opt = Dllist.append first_freq_list k in + assert (_opt = None); let first_key_index, _opt = Dllist.append t.frequency (1, first_freq_list) in - H.replace t.value k (first_key_index, new_key_index, v) + assert (_opt = None); + H.replace t.value k (first_key_index, new_key_index, v)) else let first_freq_index, _last_freq_index = Dllist.ends t.frequency in let freq, _key_list = Dllist.get t.frequency first_freq_index in let new_first_freq_index = - if freq <> 1 then + if freq = 1 then first_freq_index + else let real_first_freq_list = Dllist.create_list t.lsts in Dllist.append_before t.frequency first_freq_index (1, real_first_freq_list) - else first_freq_index in let _freq, freq_list = Dllist.get t.frequency new_first_freq_index in let new_index, _opt = Dllist.append freq_list k in + assert (_opt = None); H.replace t.value k (new_first_freq_index, new_index, v) let replace t k v = - Fmt.pr "R@."; try let _freq_index, _key_index, _value = H.find t.value k in let new_freq_index, new_key_index = update t k in @@ -120,8 +117,7 @@ struct with Not_found -> Stats.add (H.length t.value + 1) t.stats; if H.length t.value < t.cap then add t k v - else ( - Fmt.pr "d@."; + else let first_freq_index, _last_freq_index = Dllist.ends t.frequency in let _freq, freq_list = Dllist.get t.frequency first_freq_index in let first_index, _last_index = Dllist.ends freq_list in @@ -131,15 +127,15 @@ struct Dllist.remove t.frequency first_freq_index; H.remove t.value remove_key; Stats.discard t.stats; - add t k v) + add t k v let remove t k = - Fmt.pr "r@."; try let freq_index, key_index, _value = H.find t.value k in H.remove t.value k; let _freq, key_list = Dllist.get t.frequency freq_index in Dllist.remove key_list key_index; + if Dllist.is_empty key_list then Dllist.remove t.frequency freq_index; Stats.remove t.stats with Not_found -> () end diff --git a/test/lfu.ml b/test/lfu.ml index 53c4304..0c4c278 100644 --- a/test/lfu.ml +++ b/test/lfu.ml @@ -46,23 +46,23 @@ struct if i = 0 then l else let k = add_fresh_value db_t t in - if check then - (* Alcotest.(check bool) *) - (* "[Though-DB] Value just added is found (mem)" true *) - (* (DB_Cached.mem db_t k); *) - (* Alcotest.(check key) *) - (* "[Through-DB] Value just added is found (find)" k *) - (* (DB_Cached.find db_t k); *) - (* Alcotest.(check bool) *) - (* "[Through-cache] Value just added is found (mem)" true *) - (* (DB_Cached.Cache.mem db_t k); *) - (* Alcotest.(check key) *) - (* "[Through-cache] Value just added is found in cache (find)" k *) - (* (DB_Cached.Cache.find db_t k); *) - (* Alcotest.(check bool) *) - (* "[Direct] Value just added is found (mem)" true (Cache.mem t k); *) + if check then ( + Alcotest.(check bool) + "[Though-DB] Value just added is found (mem)" true + (DB_Cached.mem db_t k); Alcotest.(check key) - "[Direct] Value just added is found (find)" k (Cache.find t k); + "[Through-DB] Value just added is found (find)" k + (DB_Cached.find db_t k); + Alcotest.(check bool) + "[Through-cache] Value just added is found (mem)" true + (DB_Cached.Cache.mem db_t k); + Alcotest.(check key) + "[Through-cache] Value just added is found in cache (find)" k + (DB_Cached.Cache.find db_t k); + Alcotest.(check bool) + "[Direct] Value just added is found (mem)" true (Cache.mem t k); + Alcotest.(check key) + "[Direct] Value just added is found (find)" k (Cache.find t k)); loop (k :: l) (i - 1) in loop [] n @@ -88,19 +88,19 @@ struct | h :: tl -> List.iter (fun k -> - Alcotest.(check bool) - "[Direct] Added values are still present" true (Cache.mem t k)) + Alcotest.(check key) + "[Direct] Added values are still present" k (Cache.find t k)) tl; let k = K.v () in Cache.replace t k k; Alcotest.(check int) "[Direct] Size is still ten" 10 (Cache.size t); Alcotest.(check bool) "[Direct] Unused value are removed" false (Cache.mem t h); - (* Alcotest.(check bool) *) - (* "[Through-cache] Unused value are removed" true *) - (* (DB_Cached.Cache.mem db_t h); *) - (* Alcotest.(check bool) *) - (* "[Through-DB] Unused value are removed" true (DB_Cached.mem db_t h); *) + Alcotest.(check bool) + "[Through-cache] Unused value are removed" true + (DB_Cached.Cache.mem db_t h); + Alcotest.(check bool) + "[Through-DB] Unused value are removed" true (DB_Cached.mem db_t h); Alcotest.(check bool) "[Direct] Added value is still present" true (Cache.mem t k) | [] -> assert false @@ -119,22 +119,22 @@ struct removed; List.iter (fun k -> - (* Alcotest.(check bool) *) - (* "[Through-DB] Removed values are not present" false *) - (* (DB_Cached.mem db_t k); *) - (* Alcotest.(check bool) *) - (* "[Through-cache] Removed values are not present" false *) - (* (DB_Cached.Cache.mem db_t k); *) + Alcotest.(check bool) + "[Through-DB] Removed values are not present" false + (DB_Cached.mem db_t k); + Alcotest.(check bool) + "[Through-cache] Removed values are not present" false + (DB_Cached.Cache.mem db_t k); Alcotest.(check bool) "[Direct] Removed values are not present" false (Cache.mem t k)) removed; List.iter (fun k -> - (* Alcotest.(check bool) *) - (* "[Through-DB] Other values are present" true (DB_Cached.mem db_t k); *) - (* Alcotest.(check bool) *) - (* "[Through-cache] Other values are present" true *) - (* (DB_Cached.Cache.mem db_t k); *) + Alcotest.(check bool) + "[Through-DB] Other values are present" true (DB_Cached.mem db_t k); + Alcotest.(check bool) + "[Through-cache] Other values are present" true + (DB_Cached.Cache.mem db_t k); Alcotest.(check bool) "[Direct] Other values are present" true (Cache.mem t k)) kept; @@ -144,23 +144,23 @@ struct Cache.remove t k) kept; List.iter - (fun _k -> - (* Alcotest.(check bool) *) - (* "[Through-DB] Removed values are not present" false *) - (* (DB_Cached.mem db_t k); *) - (* Alcotest.(check bool) *) - (* "[Through-cache] Removed values are not present" false *) - (* (DB_Cached.Cache.mem db_t k); *) + (fun k -> + Alcotest.(check bool) + "[Through-DB] Removed values are not present" false + (DB_Cached.mem db_t k); + Alcotest.(check bool) + "[Through-cache] Removed values are not present" false + (DB_Cached.Cache.mem db_t k); Alcotest.(check bool) "[Direct] Cache is empty" true (Cache.is_empty t)) kept; let new_value = add_fresh_values ~check:false db_t t (cap / 2) in List.iter (fun k -> - (* Alcotest.(check bool) *) - (* "[Through-DB] New values are present" true (DB_Cached.mem db_t k); *) - (* Alcotest.(check bool) *) - (* "[Through-cache] New values are present" true *) - (* (DB_Cached.Cache.mem db_t k); *) + Alcotest.(check bool) + "[Through-DB] New values are present" true (DB_Cached.mem db_t k); + Alcotest.(check bool) + "[Through-cache] New values are present" true + (DB_Cached.Cache.mem db_t k); Alcotest.(check bool) "[Direct] New values are present after a remove" true (Cache.mem t k)) new_value From bed3a5eee4fe93322d92063b5ffa97ee063d4834 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 16:13:50 +0200 Subject: [PATCH 09/82] bug fixed --- src/dllist.ml | 9 +++++++++ src/dllist.mli | 2 ++ src/lfu.ml | 45 ++++++++++++++++++++++++++++++++++----------- 3 files changed, 45 insertions(+), 11 deletions(-) diff --git a/src/dllist.ml b/src/dllist.ml index a88bb4d..5d74ca5 100644 --- a/src/dllist.ml +++ b/src/dllist.ml @@ -16,6 +16,15 @@ type 'a l = { type 'a c = int +let status ppf l = + Fmt.pf ppf "first : %d@\n" l.first; + Fmt.pf ppf "last : %d@\n" l.last; + Fmt.(pf ppf "free : %a@\n" int) l.t.free; + Fmt.(pf ppf "prev : %a@\n" (array ~sep:sp int)) l.t.prev; + Fmt.(pf ppf "next : %a@\n@\n" (array ~sep:sp int)) l.t.next + +let is_full l = l.t.free == -1 + let create cap witness = { cap; diff --git a/src/dllist.mli b/src/dllist.mli index 8c2f084..b3673cc 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -30,3 +30,5 @@ val append_before : 'a l -> 'a c -> 'a -> 'a c val append_after : 'a l -> 'a c -> 'a -> 'a c val next : 'a l -> 'a c -> 'a c val ends : 'a l -> 'a c * 'a c +val status : Format.formatter -> 'a l -> unit +val is_full : 'a l -> bool \ No newline at end of file diff --git a/src/lfu.ml b/src/lfu.ml index 9400a82..c7901b4 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -45,19 +45,31 @@ struct let freq, freq_list = Dllist.get t.frequency freq_index in let next = Dllist.next t.frequency freq_index in let freq_next, _freq_next_list = Dllist.get t.frequency next in + + Dllist.remove freq_list key_index; let new_freq_index = - if freq_next = freq + 1 then next + if freq_next = freq + 1 then ( + if Dllist.is_empty freq_list then Dllist.remove t.frequency freq_index; + next) else let new_next = Dllist.create_list t.lsts in - (* FIXME: t.frequency could be full at this point, and append_after would fail *) - Dllist.append_after t.frequency freq_index (freq + 1, new_next) + if not (Dllist.is_full t.frequency) then ( + let r = + Dllist.append_after t.frequency freq_index (freq + 1, new_next) + in + if Dllist.is_empty freq_list then Dllist.remove t.frequency freq_index; + r) + else ( + Dllist.remove t.frequency freq_index; + let res = + if next = -1 then + let r, _opt = Dllist.append t.frequency (freq + 1, new_next) in + r + else Dllist.append_before t.frequency next (freq + 1, new_next) + in + res) in - Dllist.remove freq_list key_index; let _freq_next, freq_next_list = Dllist.get t.frequency new_freq_index in - if Dllist.is_empty freq_list then - (* FIXME: this should happen before, to leave room for the new value if - t.frequency is full *) - Dllist.remove t.frequency freq_index; let new_key_index, _opt = Dllist.append freq_next_list k in assert (_opt = None); (new_freq_index, new_key_index) @@ -113,21 +125,32 @@ struct let _freq_index, _key_index, _value = H.find t.value k in let new_freq_index, new_key_index = update t k in Stats.replace t.stats; + Fmt.pr "R"; H.replace t.value k (new_freq_index, new_key_index, v) with Not_found -> Stats.add (H.length t.value + 1) t.stats; - if H.length t.value < t.cap then add t k v - else + if H.length t.value < t.cap then ( + Fmt.pr "a"; + add t k v) + else ( + Fmt.pr "d"; let first_freq_index, _last_freq_index = Dllist.ends t.frequency in let _freq, freq_list = Dllist.get t.frequency first_freq_index in + assert (not (Dllist.is_empty freq_list)); let first_index, _last_index = Dllist.ends freq_list in + + Fmt.epr "avFREQ @[%a@]@." Dllist.status t.frequency; + Fmt.epr "avFREQ @[%a@]@." Dllist.status freq_list; + Fmt.pr "first index = %d\n" first_freq_index; + let remove_key = Dllist.get freq_list first_index in + Fmt.epr "apFREQ @[%a@]@." Dllist.status t.frequency; Dllist.remove freq_list first_index; if Dllist.is_empty freq_list then Dllist.remove t.frequency first_freq_index; H.remove t.value remove_key; Stats.discard t.stats; - add t k v + add t k v) let remove t k = try From e30ba01c6d6a5093d669aaff7a9f9c9c1afd4f29 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 16:20:41 +0200 Subject: [PATCH 10/82] bug fixed --- src/dllist.mli | 2 +- src/dune | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/dllist.mli b/src/dllist.mli index b3673cc..a7a19be 100644 --- a/src/dllist.mli +++ b/src/dllist.mli @@ -31,4 +31,4 @@ val append_after : 'a l -> 'a c -> 'a -> 'a c val next : 'a l -> 'a c -> 'a c val ends : 'a l -> 'a c * 'a c val status : Format.formatter -> 'a l -> unit -val is_full : 'a l -> bool \ No newline at end of file +val is_full : 'a l -> bool diff --git a/src/dune b/src/dune index b2c5a17..89c7dac 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,7 @@ (library (public_name cachecache) (name cachecache) - (libraries fmt vector)) + (libraries fmt)) ; (rule ; (alias runtest) From e36e6d3899520e9a78e3ace3e32a3b0f6dd23e05 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 17:01:11 +0200 Subject: [PATCH 11/82] first commit --- bench/lru_trace_definition.ml | 29 ++++ bench/replay.ml | 31 ++++ bench/trace_auto_file_format.ml | 213 +++++++++++++++++++++++++++ bench/trace_auto_file_format_intf.ml | 113 ++++++++++++++ 4 files changed, 386 insertions(+) create mode 100644 bench/lru_trace_definition.ml create mode 100644 bench/replay.ml create mode 100644 bench/trace_auto_file_format.ml create mode 100644 bench/trace_auto_file_format_intf.ml diff --git a/bench/lru_trace_definition.ml b/bench/lru_trace_definition.ml new file mode 100644 index 0000000..c82153b --- /dev/null +++ b/bench/lru_trace_definition.ml @@ -0,0 +1,29 @@ +(** File format of a trace listing the interactions with repr's LRU *) + +module V0 = struct + let version = 0 + + type header = { instance_count : int } [@@deriving repr] + + type op = Add of string | Find of string | Mem of string | Clear + [@@deriving repr] + + type row = { instance_id : int; op : op } [@@deriving repr] +end + +module Latest = V0 +include Latest + +include Trace_auto_file_format.Make (struct + module Latest = Latest + + let magic = Trace_auto_file_format.Magic.of_string "LRUtrace" + + let get_version_converter = function + | 0 -> + Trace_auto_file_format.create_version_converter ~header_t:V0.header_t + ~row_t:V0.row_t ~upgrade_header:Fun.id ~upgrade_row:Fun.id + | i -> + let msg = Fmt.str "Unknown Raw_actions_trace version %d" i in + failwith msg +end) diff --git a/bench/replay.ml b/bench/replay.ml new file mode 100644 index 0000000..47e3365 --- /dev/null +++ b/bench/replay.ml @@ -0,0 +1,31 @@ +module K = struct + include String + + let hash = Hashtbl.hash +end + +module Lru = + Lru.M.Make + (K) + (struct + type t = unit + + let weight _ = 1 + end) + +let () = + let open Lru_trace_definition in + let _, { instance_count }, seq = + open_reader "/home/cha//Downloads/lru.trace" + in + ignore instance_count; + let lru = Lru.v 5000 in + (*instane lru*) + Seq.iter + (fun { instance_id; op } -> + match (instance_id, op) with + | 1, Add k -> Lru.replace lru k () + | 1, Find k -> ignore (Lru.find_opt lru k) + | 1, Mem k -> ignore (Lru.mem lru k) + | _ -> ()) + seq diff --git a/bench/trace_auto_file_format.ml b/bench/trace_auto_file_format.ml new file mode 100644 index 0000000..5db1cd8 --- /dev/null +++ b/bench/trace_auto_file_format.ml @@ -0,0 +1,213 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021-2022 Tarides *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Trace_auto_file_format_intf + +type ('latest_header, 'latest_row, 'header, 'row) version_converter' = { + header_t : 'header Repr.ty; + row_t : 'row Repr.ty; + upgrade_header : 'header -> 'latest_header; + upgrade_row : 'row -> 'latest_row; +} +(** Contains everything needed to read a file as if it is written using the + lastest version. *) + +(** A box containing the above record *) +type (_, _) version_converter = + | Version_converter : + ('latest_header, 'latest_row, 'header, 'row) version_converter' + -> ('latest_header, 'latest_row) version_converter + +let create_version_converter : + header_t:'header Repr.ty -> + row_t:'row Repr.ty -> + upgrade_header:('header -> 'latest_header) -> + upgrade_row:('row -> 'latest_row) -> + ('latest_header, 'latest_row) version_converter = + fun ~header_t ~row_t ~upgrade_header ~upgrade_row -> + Version_converter { header_t; row_t; upgrade_header; upgrade_row } + +module Magic : MAGIC = struct + type t = string + + let of_string s = + if String.length s <> 8 then + invalid_arg "Magic.of_string, string should have 8 chars"; + s + + let to_string s = s + let pp ppf s = Format.fprintf ppf "%s" (String.escaped s) +end + +module type FILE_FORMAT = + FILE_FORMAT + with type magic := Magic.t + with type ('a, 'b) version_converter := ('a, 'b) version_converter + +module type S = + S + with type File_format.magic := Magic.t + with type ('a, 'b) File_format.version_converter := + ('a, 'b) version_converter + +(** Variable size integer. Very similar to what can be found in + "repr/type_binary.ml", but working straight off channels. [Var_int.read_exn] + reads the chars one by one from the provided [chan]. The recursion stops as + soon as a read char has its 8th bit equal to [0]. [Var_int.write] could be + implemented using [Repr.encode_bin int], but since [read_exn] can't be + implemented using repr, [write] isn't either. *) +module Var_int = struct + let chars = + Array.init 256 (fun i -> Bytes.unsafe_to_string (Bytes.make 1 (Char.chr i))) + + let write : int -> out_channel -> unit = + let int i k = + let rec aux n k = + if n >= 0 && n < 128 then k chars.(n) + else + let out = 128 lor (n land 127) in + k chars.(out); + aux (n lsr 7) k + in + aux i k + in + fun i chan -> int i (output_string chan) + + let read_exn : in_channel -> int = + fun chan -> + let max_bits = Sys.word_size - 1 in + let rec aux n p = + let () = + if p >= max_bits then raise (failwith "Failed to decode varint") + in + let i = input_char chan |> Char.code in + let n = n + ((i land 127) lsl p) in + if i >= 0 && i < 128 then n else aux n (p + 7) + in + aux 0 0 +end + +module Make (Ff : FILE_FORMAT) = struct + module File_format = Ff + + let decode_i32 = Repr.(decode_bin int32 |> unstage) + let encode_i32 = Repr.(encode_bin int32 |> unstage) + let encode_lheader = Repr.(encode_bin Ff.Latest.header_t |> unstage) + let encode_lrow = Repr.(encode_bin Ff.Latest.row_t |> unstage) + + let read_with_prefix_exn : (string -> int ref -> 'a) -> in_channel -> 'a = + fun decode chan -> + (* First read the prefix *) + let len = Var_int.read_exn chan in + (* Then read the repr. *) + let offset_ref = ref 0 in + let v = + (* This could fail if [len] is not long enough for repr (corruption) *) + decode (really_input_string chan len) offset_ref + in + let () = + if len <> !offset_ref then + let msg = + Fmt.str + "A value read in the Trace was expected to take %d bytes, but it \ + took only %d." + len !offset_ref + in + raise (failwith msg) + in + v + + let decoded_seq_of_encoded_chan_with_prefixes : + 'a Repr.ty -> in_channel -> 'a Seq.t = + fun repr chan -> + let decode = Repr.decode_bin repr |> Repr.unstage in + let produce_row () = + try + let row = read_with_prefix_exn decode chan in + Some (row, ()) + with End_of_file -> None + in + Seq.unfold produce_row () + + let open_reader : string -> int * Ff.Latest.header * Ff.Latest.row Seq.t = + fun path -> + let chan = open_in_bin path in + let len = LargeFile.in_channel_length chan in + let () = + if len < 12L then + let msg = Fmt.str "File '%s' should be at least 12 byte long" path in + raise (failwith msg) + in + + let magic = Magic.of_string (really_input_string chan 8) in + let () = + if magic <> Ff.magic then + let msg = + Fmt.str "File '%s' has magic '%a'. Expected '%a'." path Magic.pp magic + Magic.pp Ff.magic + in + raise (failwith msg) + in + + let offset_ref = ref 0 in + let version = decode_i32 (really_input_string chan 4) offset_ref in + let (Version_converter vc) = + assert (!offset_ref = 4); + Ff.get_version_converter (Int32.to_int version) + in + + let header = + let decode_header = Repr.(decode_bin vc.header_t |> unstage) in + read_with_prefix_exn decode_header chan |> vc.upgrade_header + in + let seq = + decoded_seq_of_encoded_chan_with_prefixes vc.row_t chan + |> Seq.map vc.upgrade_row + in + (Int32.to_int version, header, seq) + + type writer = { channel : out_channel; buffer : Buffer.t } + + let create channel header = + let buffer = Buffer.create 0 in + output_string channel (Magic.to_string Ff.magic); + encode_i32 (Int32.of_int Ff.Latest.version) (output_string channel); + encode_lheader header (Buffer.add_string buffer); + Var_int.write (Buffer.length buffer) channel; + output_string channel (Buffer.contents buffer); + Buffer.clear buffer; + { channel; buffer } + + let create_file path header = create (open_out path) header + + let append_row { channel; buffer; _ } row = + encode_lrow row (Buffer.add_string buffer); + Var_int.write (Buffer.length buffer) channel; + output_string channel (Buffer.contents buffer); + Buffer.clear buffer + + let flush { channel; _ } = flush channel + let close { channel; _ } = close_out channel +end diff --git a/bench/trace_auto_file_format_intf.ml b/bench/trace_auto_file_format_intf.ml new file mode 100644 index 0000000..78bc0af --- /dev/null +++ b/bench/trace_auto_file_format_intf.ml @@ -0,0 +1,113 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2021-2022 Tarides *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Utility to simplify the management of files using the following layout: + + - Magic (Magic.t, 8 bytes) + - Version (int32, 4 bytes) + - Length of header (varint, >=1 byte) + - Header (header_t, _ bytes) + - Arbitrary long series of rows, of unspecified length, each prefixed by + their length: + - Length of row (varint, >=1 byte) + - Row (row_t, _ bytes) *) + +module type MAGIC = sig + type t + + val of_string : string -> t + val to_string : t -> string + val pp : Format.formatter -> t -> unit +end + +(** Manually defined *) +module type FILE_FORMAT = sig + (** The latest up-to-date definition of the file format *) + module Latest : sig + val version : int + + type header [@@deriving repr] + type row [@@deriving repr] + end + + type magic + + val magic : magic + + type ('a, 'b) version_converter + + val get_version_converter : + int -> (Latest.header, Latest.row) version_converter + (** [get_version_converter v] is a converter that can upgrade headers and rows + from a version [i] to [Latest.version]. It may raise [Invalid_argument] if *) +end + +(** Automatically defined *) +module type S = sig + module File_format : FILE_FORMAT + + val open_reader : + string -> int * File_format.Latest.header * File_format.Latest.row Seq.t + + type writer + + val create : out_channel -> File_format.Latest.header -> writer + val create_file : string -> File_format.Latest.header -> writer + val append_row : writer -> File_format.Latest.row -> unit + val flush : writer -> unit + val close : writer -> unit +end + +module type Trace_auto_file_format = sig + type ('a, 'b) version_converter + + val create_version_converter : + header_t:'header Repr.ty -> + row_t:'row Repr.ty -> + upgrade_header:('header -> 'latest_header) -> + upgrade_row:('row -> 'latest_row) -> + ('latest_header, 'latest_row) version_converter + (** Create a value that contains everything needed to upgrade on-the-fly a + file version to the latest version defined by the file format. *) + + module type MAGIC = MAGIC + + module Magic : MAGIC + + module type FILE_FORMAT = + FILE_FORMAT + with type magic := Magic.t + with type ('a, 'b) version_converter := ('a, 'b) version_converter + + module type S = + S + with type File_format.magic := Magic.t + with type ('a, 'b) File_format.version_converter := + ('a, 'b) version_converter + + (** Derive the IO operations from a file format. *) + module Make (File_format : FILE_FORMAT) : + S with module File_format = File_format +end From 5ec36dae9742ddb46a76a04c59b78d874573511b Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 17:25:00 +0200 Subject: [PATCH 12/82] add pp to bench --- bench/dune | 12 ++++++++++++ bench/replay.ml | 28 ++++++++++++++++------------ 2 files changed, 28 insertions(+), 12 deletions(-) diff --git a/bench/dune b/bench/dune index 13fd944..63e670d 100644 --- a/bench/dune +++ b/bench/dune @@ -1,7 +1,19 @@ (executable + (modules main) (name main) (libraries bechamel bechamel-notty notty.unix lru cachecache)) +(executable + (modules + lru_trace_definition + replay + trace_auto_file_format_intf + trace_auto_file_format) + (preprocess + (pps ppx_repr)) + (name replay) + (libraries cachecache fmt ppx_repr repr)) + (alias (name runtest) (package cachecache-bench) diff --git a/bench/replay.ml b/bench/replay.ml index 47e3365..c47ab90 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -1,19 +1,16 @@ +type stats = { mutable add : int; mutable mem : int; mutable find : int } +[@@deriving repr ~pp] + module K = struct include String let hash = Hashtbl.hash end -module Lru = - Lru.M.Make - (K) - (struct - type t = unit - - let weight _ = 1 - end) +module Lru = Cachecache.Lru.Make (K) let () = + let stats = { add = 0; mem = 0; find = 0 } in let open Lru_trace_definition in let _, { instance_count }, seq = open_reader "/home/cha//Downloads/lru.trace" @@ -24,8 +21,15 @@ let () = Seq.iter (fun { instance_id; op } -> match (instance_id, op) with - | 1, Add k -> Lru.replace lru k () - | 1, Find k -> ignore (Lru.find_opt lru k) - | 1, Mem k -> ignore (Lru.mem lru k) + | 1, Add k -> + Lru.replace lru k (); + stats.add <- stats.add + 1 + | 1, Find k -> + ignore (Lru.find_opt lru k); + stats.find <- stats.find + 1 + | 1, Mem k -> + ignore (Lru.mem lru k); + stats.mem <- stats.mem + 1 | _ -> ()) - seq + seq; + Fmt.pr "%a\n" pp_stats stats From 90f649188b7b94e4fd72bc87fbc32a68f29cc3bd Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 17:35:58 +0200 Subject: [PATCH 13/82] match bench on differents instances id --- bench/replay.ml | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index c47ab90..9f7a292 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -15,20 +15,19 @@ let () = let _, { instance_count }, seq = open_reader "/home/cha//Downloads/lru.trace" in - ignore instance_count; - let lru = Lru.v 5000 in - (*instane lru*) + let lrus = List.init instance_count (fun _ -> Lru.v 5000) in Seq.iter (fun { instance_id; op } -> - match (instance_id, op) with - | 1, Add k -> + let lru = List.nth lrus instance_id in + match op with + | Add k -> Lru.replace lru k (); stats.add <- stats.add + 1 - | 1, Find k -> - ignore (Lru.find_opt lru k); + | Find k -> + ignore (Lru.find_opt lru k : _ option); stats.find <- stats.find + 1 - | 1, Mem k -> - ignore (Lru.mem lru k); + | Mem k -> + ignore (Lru.mem lru k : bool); stats.mem <- stats.mem + 1 | _ -> ()) seq; From 90fc0fe2527f6201caafbe8e9acf82a887afaefe Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 18:01:06 +0200 Subject: [PATCH 14/82] add mtime lib and counters --- bench/dune | 2 +- bench/replay.ml | 37 +++++++++++++++++++++++++++++++++++-- 2 files changed, 36 insertions(+), 3 deletions(-) diff --git a/bench/dune b/bench/dune index 63e670d..641d69a 100644 --- a/bench/dune +++ b/bench/dune @@ -12,7 +12,7 @@ (preprocess (pps ppx_repr)) (name replay) - (libraries cachecache fmt ppx_repr repr)) + (libraries cachecache fmt ppx_repr repr mtime mtime.clock.os)) (alias (name runtest) diff --git a/bench/replay.ml b/bench/replay.ml index 9f7a292..c3fcefc 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -1,4 +1,15 @@ -type stats = { mutable add : int; mutable mem : int; mutable find : int } +type span = Mtime.span + +let span_t = Repr.map Repr.float (fun _ -> assert false) Mtime.Span.to_s + +type stats = { + mutable add : int; + mutable mem : int; + mutable find : int; + mutable add_span : span; + mutable mem_span : span; + mutable find_span : span; +} [@@deriving repr ~pp] module K = struct @@ -10,7 +21,17 @@ end module Lru = Cachecache.Lru.Make (K) let () = - let stats = { add = 0; mem = 0; find = 0 } in + let stats = + { + add = 0; + mem = 0; + find = 0; + add_span = Mtime.Span.zero; + mem_span = Mtime.Span.zero; + find_span = Mtime.Span.zero; + } + in + let counter = Mtime_clock.counter () in let open Lru_trace_definition in let _, { instance_count }, seq = open_reader "/home/cha//Downloads/lru.trace" @@ -21,13 +42,25 @@ let () = let lru = List.nth lrus instance_id in match op with | Add k -> + let before = Mtime_clock.count counter in Lru.replace lru k (); + let after = Mtime_clock.count counter in + stats.add_span <- + Mtime.Span.(abs_diff after before |> add stats.add_span); stats.add <- stats.add + 1 | Find k -> + let before = Mtime_clock.count counter in ignore (Lru.find_opt lru k : _ option); + let after = Mtime_clock.count counter in + stats.find_span <- + Mtime.Span.(abs_diff after before |> add stats.find_span); stats.find <- stats.find + 1 | Mem k -> + let before = Mtime_clock.count counter in ignore (Lru.mem lru k : bool); + let after = Mtime_clock.count counter in + stats.mem_span <- + Mtime.Span.(abs_diff after before |> add stats.mem_span); stats.mem <- stats.mem + 1 | _ -> ()) seq; From 1eb7957a89c60588dacc4a5563408e5810805db2 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 18:18:18 +0200 Subject: [PATCH 15/82] functorize replay --- bench/replay.ml | 98 +++++++++++++++++++++++++---------------------- src/cachecache.ml | 1 + src/lfu.ml | 15 ++------ 3 files changed, 57 insertions(+), 57 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index c3fcefc..869657d 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -18,50 +18,58 @@ module K = struct let hash = Hashtbl.hash end +module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct + let bench cap = + let stats = + { + add = 0; + mem = 0; + find = 0; + add_span = Mtime.Span.zero; + mem_span = Mtime.Span.zero; + find_span = Mtime.Span.zero; + } + in + let open Lru_trace_definition in + let _, { instance_count }, seq = + open_reader "/home/cha//Downloads/lru.trace" + in + let caches = List.init instance_count (fun _ -> Cache.v cap) in + let counter = Mtime_clock.counter () in + Seq.iter + (fun { instance_id; op } -> + let cache = List.nth caches instance_id in + match op with + | Add k -> + let before = Mtime_clock.count counter in + Cache.replace cache k (); + let after = Mtime_clock.count counter in + stats.add_span <- + Mtime.Span.(abs_diff after before |> add stats.add_span); + stats.add <- stats.add + 1 + | Find k -> + let before = Mtime_clock.count counter in + ignore (Cache.find_opt cache k : _ option); + let after = Mtime_clock.count counter in + stats.find_span <- + Mtime.Span.(abs_diff after before |> add stats.find_span); + stats.find <- stats.find + 1 + | Mem k -> + let before = Mtime_clock.count counter in + ignore (Cache.mem cache k : bool); + let after = Mtime_clock.count counter in + stats.mem_span <- + Mtime.Span.(abs_diff after before |> add stats.mem_span); + stats.mem <- stats.mem + 1 + | _ -> assert false) + seq; + Fmt.pr "%a\n" pp_stats stats +end + module Lru = Cachecache.Lru.Make (K) +module Lfu = Cachecache.Lfu.Make (K) +module Bench_lru = Make (Lru) +module Bench_lfu = Make (Lfu) -let () = - let stats = - { - add = 0; - mem = 0; - find = 0; - add_span = Mtime.Span.zero; - mem_span = Mtime.Span.zero; - find_span = Mtime.Span.zero; - } - in - let counter = Mtime_clock.counter () in - let open Lru_trace_definition in - let _, { instance_count }, seq = - open_reader "/home/cha//Downloads/lru.trace" - in - let lrus = List.init instance_count (fun _ -> Lru.v 5000) in - Seq.iter - (fun { instance_id; op } -> - let lru = List.nth lrus instance_id in - match op with - | Add k -> - let before = Mtime_clock.count counter in - Lru.replace lru k (); - let after = Mtime_clock.count counter in - stats.add_span <- - Mtime.Span.(abs_diff after before |> add stats.add_span); - stats.add <- stats.add + 1 - | Find k -> - let before = Mtime_clock.count counter in - ignore (Lru.find_opt lru k : _ option); - let after = Mtime_clock.count counter in - stats.find_span <- - Mtime.Span.(abs_diff after before |> add stats.find_span); - stats.find <- stats.find + 1 - | Mem k -> - let before = Mtime_clock.count counter in - ignore (Lru.mem lru k : bool); - let after = Mtime_clock.count counter in - stats.mem_span <- - Mtime.Span.(abs_diff after before |> add stats.mem_span); - stats.mem <- stats.mem + 1 - | _ -> ()) - seq; - Fmt.pr "%a\n" pp_stats stats +let () = Bench_lru.bench 5000 +let () = Bench_lfu.bench 5000 diff --git a/src/cachecache.ml b/src/cachecache.ml index 22eb78a..bd74d20 100644 --- a/src/cachecache.ml +++ b/src/cachecache.ml @@ -1,3 +1,4 @@ module Lru = Lru module Lfu = Lfu +module S = S module Through = Through diff --git a/src/lfu.ml b/src/lfu.ml index c7901b4..23357fb 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -125,32 +125,23 @@ struct let _freq_index, _key_index, _value = H.find t.value k in let new_freq_index, new_key_index = update t k in Stats.replace t.stats; - Fmt.pr "R"; H.replace t.value k (new_freq_index, new_key_index, v) with Not_found -> Stats.add (H.length t.value + 1) t.stats; - if H.length t.value < t.cap then ( - Fmt.pr "a"; - add t k v) - else ( - Fmt.pr "d"; + if H.length t.value < t.cap then add t k v + else let first_freq_index, _last_freq_index = Dllist.ends t.frequency in let _freq, freq_list = Dllist.get t.frequency first_freq_index in assert (not (Dllist.is_empty freq_list)); let first_index, _last_index = Dllist.ends freq_list in - Fmt.epr "avFREQ @[%a@]@." Dllist.status t.frequency; - Fmt.epr "avFREQ @[%a@]@." Dllist.status freq_list; - Fmt.pr "first index = %d\n" first_freq_index; - let remove_key = Dllist.get freq_list first_index in - Fmt.epr "apFREQ @[%a@]@." Dllist.status t.frequency; Dllist.remove freq_list first_index; if Dllist.is_empty freq_list then Dllist.remove t.frequency first_freq_index; H.remove t.value remove_key; Stats.discard t.stats; - add t k v) + add t k v let remove t k = try From 2fd859878ab6eead6a76530ca6304d76bb8ed25a Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 27 May 2022 18:42:54 +0200 Subject: [PATCH 16/82] cli for replay --- bench/dune | 2 +- bench/replay.ml | 19 +++++++++++++++++-- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/bench/dune b/bench/dune index 641d69a..5689a84 100644 --- a/bench/dune +++ b/bench/dune @@ -12,7 +12,7 @@ (preprocess (pps ppx_repr)) (name replay) - (libraries cachecache fmt ppx_repr repr mtime mtime.clock.os)) + (libraries cachecache fmt ppx_repr repr mtime mtime.clock.os cmdliner)) (alias (name runtest) diff --git a/bench/replay.ml b/bench/replay.ml index 869657d..51b24e8 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -71,5 +71,20 @@ module Lfu = Cachecache.Lfu.Make (K) module Bench_lru = Make (Lru) module Bench_lfu = Make (Lfu) -let () = Bench_lru.bench 5000 -let () = Bench_lfu.bench 5000 +let main algo cap = + match algo with `Lru -> Bench_lru.bench cap | `Lfu -> Bench_lfu.bench cap + +open Cmdliner + +let algo = + let l = [ ("lru", `Lru); ("lfu", `Lfu) ] in + let i = Arg.info [] in + Arg.(required @@ pos 0 (some (enum l)) None i) + +let cap = + let i = Arg.info [] in + Arg.(required @@ pos 1 (some int) None i) + +let main_t = Term.(const main $ algo $ cap) +let cmd = Cmd.v (Cmd.info "replay") main_t +let () = exit (Cmd.eval cmd) From cd43db5aae2ca202c320b765c7609e0f32621127 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 11:54:29 +0200 Subject: [PATCH 17/82] update bench --- bench/replay.ml | 32 ++++++++++++++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 51b24e8..e1f7bf6 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -6,9 +6,13 @@ type stats = { mutable add : int; mutable mem : int; mutable find : int; + mutable hit : int; + mutable miss : int; + (* mutable discard : int; *) mutable add_span : span; mutable mem_span : span; mutable find_span : span; + mutable total_runtime_span : span; } [@@deriving repr ~pp] @@ -18,6 +22,11 @@ module K = struct let hash = Hashtbl.hash end +let pr_bench test_name metric_name value = + Format.printf + {|{"results": [{"name": "%s", "metrics": [{"name": "%s", "value": %f, "units": "ms"}]}]}@.|} + test_name metric_name value + module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct let bench cap = let stats = @@ -25,9 +34,13 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct add = 0; mem = 0; find = 0; + hit = 0; + miss = 0; + (* discard = 0; *) add_span = Mtime.Span.zero; mem_span = Mtime.Span.zero; find_span = Mtime.Span.zero; + total_runtime_span = Mtime.Span.zero; } in let open Lru_trace_definition in @@ -44,6 +57,8 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct let before = Mtime_clock.count counter in Cache.replace cache k (); let after = Mtime_clock.count counter in + stats.total_runtime_span <- + Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.add_span <- Mtime.Span.(abs_diff after before |> add stats.add_span); stats.add <- stats.add + 1 @@ -51,19 +66,32 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct let before = Mtime_clock.count counter in ignore (Cache.find_opt cache k : _ option); let after = Mtime_clock.count counter in + stats.total_runtime_span <- + Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.find_span <- Mtime.Span.(abs_diff after before |> add stats.find_span); stats.find <- stats.find + 1 | Mem k -> let before = Mtime_clock.count counter in - ignore (Cache.mem cache k : bool); + let b = Cache.mem cache k in let after = Mtime_clock.count counter in + stats.total_runtime_span <- + Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.mem_span <- Mtime.Span.(abs_diff after before |> add stats.mem_span); + if b then stats.hit <- stats.hit + 1 + else stats.miss <- stats.miss + 1; stats.mem <- stats.mem + 1 | _ -> assert false) seq; - Fmt.pr "%a\n" pp_stats stats + (* Fmt.pr "%a\n" pp_stats stats *) + pr_bench "add" "add_metric" (Mtime.Span.to_ms stats.add_span); + + pr_bench "mem" "mem_metric" (Mtime.Span.to_ms stats.mem_span); + + pr_bench "find" "find_metric" (Mtime.Span.to_ms stats.find_span); + pr_bench "total_runtime" "total_runtime_metric" + (Mtime.Span.to_ms stats.total_runtime_span) end module Lru = Cachecache.Lru.Make (K) From dda6030667808c1f1035eb64ed305e31adac00db Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 14:11:22 +0200 Subject: [PATCH 18/82] add makefile --- bench/Makefile | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 bench/Makefile diff --git a/bench/Makefile b/bench/Makefile new file mode 100644 index 0000000..8c69309 --- /dev/null +++ b/bench/Makefile @@ -0,0 +1,3 @@ +.PHONY: bench +bench: + time dune exec ./bench/replay.exe lru 5001 \ No newline at end of file From 1804d5cbe1b854136664d95c8d782ceb9380cc87 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 14:14:21 +0200 Subject: [PATCH 19/82] add makefile --- Makefile | 3 +++ bench/Makefile | 3 --- 2 files changed, 3 insertions(+), 3 deletions(-) create mode 100644 Makefile delete mode 100644 bench/Makefile diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..7b34ad4 --- /dev/null +++ b/Makefile @@ -0,0 +1,3 @@ +.PHONY: bench +bench: + dune exec bench/replay.exe lru 5001 \ No newline at end of file diff --git a/bench/Makefile b/bench/Makefile deleted file mode 100644 index 8c69309..0000000 --- a/bench/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -.PHONY: bench -bench: - time dune exec ./bench/replay.exe lru 5001 \ No newline at end of file From 9ce2a24816dcbc452003d35736a4596049ea171b Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 14:22:18 +0200 Subject: [PATCH 20/82] add libraries in opam file --- cachecache-bench.opam | 2 ++ cachecache.opam | 2 ++ 2 files changed, 4 insertions(+) diff --git a/cachecache-bench.opam b/cachecache-bench.opam index b1791a7..ace9bfb 100644 --- a/cachecache-bench.opam +++ b/cachecache-bench.opam @@ -10,6 +10,8 @@ bug-reports: "https://github.com/pascutto/cachecache/issues" depends: [ "dune" {>= "2.0"} "ocaml" {>= "4.07.1"} + "ppx_repr" + "mtime.clock.os" "bechamel" {with-test} "bechamel-notty" {with-test} "notty" {with-test} diff --git a/cachecache.opam b/cachecache.opam index ad5687f..3cd02d3 100644 --- a/cachecache.opam +++ b/cachecache.opam @@ -30,6 +30,8 @@ depends: [ "dune" {>= "2.0"} "ocaml" {>= "4.07.1"} "fmt" + "ppx_repr" + "mtime.clock.os" "alcotest" {with-test} "gospel" {with-test} "fpath" {with-test} From 51e661e194a5d2d1722eaf84be96d0caab5579ff Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 14:40:30 +0200 Subject: [PATCH 21/82] remove cache arg to dune command --- Makefile | 2 +- bench/replay.ml | 12 +++--------- 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/Makefile b/Makefile index 7b34ad4..21ced90 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ .PHONY: bench bench: - dune exec bench/replay.exe lru 5001 \ No newline at end of file + dune exec bench/replay.exe 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index e1f7bf6..9660a7f 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -99,20 +99,14 @@ module Lfu = Cachecache.Lfu.Make (K) module Bench_lru = Make (Lru) module Bench_lfu = Make (Lfu) -let main algo cap = - match algo with `Lru -> Bench_lru.bench cap | `Lfu -> Bench_lfu.bench cap +let main cap = Bench_lru.bench cap open Cmdliner -let algo = - let l = [ ("lru", `Lru); ("lfu", `Lfu) ] in - let i = Arg.info [] in - Arg.(required @@ pos 0 (some (enum l)) None i) - let cap = let i = Arg.info [] in - Arg.(required @@ pos 1 (some int) None i) + Arg.(required @@ pos 0 (some int) None i) -let main_t = Term.(const main $ algo $ cap) +let main_t = Term.(const main $ cap) let cmd = Cmd.v (Cmd.info "replay") main_t let () = exit (Cmd.eval cmd) From a657dd112130d436eaeebdaf47128e1a39e7cf67 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 14:56:16 +0200 Subject: [PATCH 22/82] change branch name --- Makefile | 2 +- bench/replay.ml | 17 +++++++++++------ cachecache-bench.opam | 2 +- 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/Makefile b/Makefile index 21ced90..7b34ad4 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ .PHONY: bench bench: - dune exec bench/replay.exe 5001 \ No newline at end of file + dune exec bench/replay.exe lru 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index 9660a7f..d3e63d7 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -86,27 +86,32 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct seq; (* Fmt.pr "%a\n" pp_stats stats *) pr_bench "add" "add_metric" (Mtime.Span.to_ms stats.add_span); - pr_bench "mem" "mem_metric" (Mtime.Span.to_ms stats.mem_span); - pr_bench "find" "find_metric" (Mtime.Span.to_ms stats.find_span); pr_bench "total_runtime" "total_runtime_metric" (Mtime.Span.to_ms stats.total_runtime_span) end +include Cachecache.Lru.Make (K) module Lru = Cachecache.Lru.Make (K) module Lfu = Cachecache.Lfu.Make (K) module Bench_lru = Make (Lru) module Bench_lfu = Make (Lfu) -let main cap = Bench_lru.bench cap +let main algo cap = + match algo with `Lru -> Bench_lru.bench cap | `Lfu -> Bench_lfu.bench cap open Cmdliner +let algo = + let l = [ ("lru", `Lru); ("lfu", `Lfu) ] in + let i = Arg.info [] in + Arg.(required @@ pos 0 (some (enum l)) None i) + let cap = let i = Arg.info [] in - Arg.(required @@ pos 0 (some int) None i) + Arg.(required @@ pos 1 (some int) None i) -let main_t = Term.(const main $ cap) +let main_t = Term.(const main $ algo $ cap) let cmd = Cmd.v (Cmd.info "replay") main_t -let () = exit (Cmd.eval cmd) +let () = exit (Cmd.eval cmd) \ No newline at end of file diff --git a/cachecache-bench.opam b/cachecache-bench.opam index ace9bfb..b47c563 100644 --- a/cachecache-bench.opam +++ b/cachecache-bench.opam @@ -15,7 +15,7 @@ depends: [ "bechamel" {with-test} "bechamel-notty" {with-test} "notty" {with-test} - "lru" {with-test} + "lru" ] build: [ ["dune" "subst"] {pinned} From b4f62cd491e9fd6169f45de545cd29431689b3f2 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 15:23:51 +0200 Subject: [PATCH 23/82] :) --- bench/replay.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bench/replay.ml b/bench/replay.ml index d3e63d7..d43daf9 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -84,7 +84,7 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - (* Fmt.pr "%a\n" pp_stats stats *) + (* Fmt.prs "%a\n" pp_stats stats *) pr_bench "add" "add_metric" (Mtime.Span.to_ms stats.add_span); pr_bench "mem" "mem_metric" (Mtime.Span.to_ms stats.mem_span); pr_bench "find" "find_metric" (Mtime.Span.to_ms stats.find_span); From 36a8dbc5eaeda986ef46a717a0a89a8441c43a63 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 15:36:53 +0200 Subject: [PATCH 24/82] test --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 7b34ad4..b684f6d 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ .PHONY: bench bench: - dune exec bench/replay.exe lru 5001 \ No newline at end of file + dune exec ./bench/replay.exe lru 5001 \ No newline at end of file From c84b1c0b5647a1e6ca2b1f932e4f9543d782a824 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 15:55:09 +0200 Subject: [PATCH 25/82] a --- Makefile | 2 +- cachecache.opam | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index b684f6d..7b34ad4 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ .PHONY: bench bench: - dune exec ./bench/replay.exe lru 5001 \ No newline at end of file + dune exec bench/replay.exe lru 5001 \ No newline at end of file diff --git a/cachecache.opam b/cachecache.opam index 3cd02d3..5f72ca6 100644 --- a/cachecache.opam +++ b/cachecache.opam @@ -30,8 +30,7 @@ depends: [ "dune" {>= "2.0"} "ocaml" {>= "4.07.1"} "fmt" - "ppx_repr" - "mtime.clock.os" + "alcotest" {with-test} "gospel" {with-test} "fpath" {with-test} From b9e874dcf7dc7d57189028931b15b10f9ad731e8 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:04:26 +0200 Subject: [PATCH 26/82] a --- Makefile | 4 ++-- cachecache.opam | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 7b34ad4..9f0682f 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ -.PHONY: bench -bench: +.PHONY: cha +cha: dune exec bench/replay.exe lru 5001 \ No newline at end of file diff --git a/cachecache.opam b/cachecache.opam index 5f72ca6..3cd02d3 100644 --- a/cachecache.opam +++ b/cachecache.opam @@ -30,7 +30,8 @@ depends: [ "dune" {>= "2.0"} "ocaml" {>= "4.07.1"} "fmt" - + "ppx_repr" + "mtime.clock.os" "alcotest" {with-test} "gospel" {with-test} "fpath" {with-test} From 77679bfb7d06e8efc5326ef6b54fac1b366bf006 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:16:29 +0200 Subject: [PATCH 27/82] a --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 9f0682f..7b34ad4 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ -.PHONY: cha -cha: +.PHONY: bench +bench: dune exec bench/replay.exe lru 5001 \ No newline at end of file From 83a108dfe978c0dfaacff28abab57b3eb3361a3a Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:17:53 +0200 Subject: [PATCH 28/82] r --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 7b34ad4..9c5130a 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ .PHONY: bench bench: - dune exec bench/replay.exe lru 5001 \ No newline at end of file + opam exec -- dune exec bench/replay.exe lru 5001 \ No newline at end of file From 4efc89f6a23d454b6fadec2e3b06be7a2904730f Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:22:03 +0200 Subject: [PATCH 29/82] a --- Makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 9c5130a..5a876e2 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ -.PHONY: bench -bench: - opam exec -- dune exec bench/replay.exe lru 5001 \ No newline at end of file +.PHONY: beanch +beanch: + dune exec bench/replay.exe lru 5001 \ No newline at end of file From a5e7bb5eea7bcc31356b77e5009c89bc82ba162f Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:23:42 +0200 Subject: [PATCH 30/82] k --- Makefile | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 5a876e2..d7fb6b6 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,4 @@ -.PHONY: beanch -beanch: - dune exec bench/replay.exe lru 5001 \ No newline at end of file +.PHONY: bench +bench: + opam install dune -y + opam exec -- dune exec bench/replay.exe lru 5001 \ No newline at end of file From f2a73dcb32c1e8f64e6af1d33d02e1b853e44be0 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:27:52 +0200 Subject: [PATCH 31/82] a --- cachecache-bench.opam | 1 + cachecache.opam | 1 + 2 files changed, 2 insertions(+) diff --git a/cachecache-bench.opam b/cachecache-bench.opam index b47c563..7b1a765 100644 --- a/cachecache-bench.opam +++ b/cachecache-bench.opam @@ -11,6 +11,7 @@ depends: [ "dune" {>= "2.0"} "ocaml" {>= "4.07.1"} "ppx_repr" + "cmdliner" "mtime.clock.os" "bechamel" {with-test} "bechamel-notty" {with-test} diff --git a/cachecache.opam b/cachecache.opam index 3cd02d3..212d7cd 100644 --- a/cachecache.opam +++ b/cachecache.opam @@ -31,6 +31,7 @@ depends: [ "ocaml" {>= "4.07.1"} "fmt" "ppx_repr" + "cmdliner" "mtime.clock.os" "alcotest" {with-test} "gospel" {with-test} From c17fa7159e25adb72cc189f69e0b67523ea4779f Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:32:51 +0200 Subject: [PATCH 32/82] c --- Makefile | 1 - 1 file changed, 1 deletion(-) diff --git a/Makefile b/Makefile index d7fb6b6..9c5130a 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,3 @@ .PHONY: bench bench: - opam install dune -y opam exec -- dune exec bench/replay.exe lru 5001 \ No newline at end of file From e25f73b59e34c01da1f4fc386fba6921460a1649 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:34:03 +0200 Subject: [PATCH 33/82] c --- Makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 9c5130a..bc46388 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ -.PHONY: bench -bench: - opam exec -- dune exec bench/replay.exe lru 5001 \ No newline at end of file +.PHONY: replay +replay: + dune exec bench/replay.exe lru 5001 \ No newline at end of file From 1c1ebaaa63f6db3032558850ff507517729d8ad4 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:39:52 +0200 Subject: [PATCH 34/82] p --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index bc46388..7b34ad4 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,3 @@ -.PHONY: replay -replay: +.PHONY: bench +bench: dune exec bench/replay.exe lru 5001 \ No newline at end of file From 1fae7f8dd75e90720d75ea1c4392fd19b09028ec Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:47:26 +0200 Subject: [PATCH 35/82] m --- Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 7b34ad4..6d69830 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,4 @@ .PHONY: bench bench: - dune exec bench/replay.exe lru 5001 \ No newline at end of file + opam install -y -t . + opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 0a8c1f8fbe32596b2ad480d24b0e5ece65808f0a Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:50:05 +0200 Subject: [PATCH 36/82] lib --- cachecache-bench.opam | 2 +- cachecache.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cachecache-bench.opam b/cachecache-bench.opam index 7b1a765..0a213d0 100644 --- a/cachecache-bench.opam +++ b/cachecache-bench.opam @@ -12,7 +12,7 @@ depends: [ "ocaml" {>= "4.07.1"} "ppx_repr" "cmdliner" - "mtime.clock.os" + "mtime" "bechamel" {with-test} "bechamel-notty" {with-test} "notty" {with-test} diff --git a/cachecache.opam b/cachecache.opam index 212d7cd..7293835 100644 --- a/cachecache.opam +++ b/cachecache.opam @@ -32,7 +32,7 @@ depends: [ "fmt" "ppx_repr" "cmdliner" - "mtime.clock.os" + "mtime" "alcotest" {with-test} "gospel" {with-test} "fpath" {with-test} From ecbb91a4da69456a5fcbf822e367db09cc01cd6e Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Tue, 31 May 2022 16:59:36 +0200 Subject: [PATCH 37/82] az --- Makefile | 1 - 1 file changed, 1 deletion(-) diff --git a/Makefile b/Makefile index 6d69830..9da1d84 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,3 @@ .PHONY: bench bench: - opam install -y -t . opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 1cff6f797a39534cf14b59612b79f2b9c4bc5c03 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:21:08 +0200 Subject: [PATCH 38/82] dl external trace --- Makefile | 2 ++ bench/replay.ml | 4 +--- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 9da1d84..019309b 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,5 @@ .PHONY: bench bench: + cd ./trace + wget http://data.tarides.com/irmin/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index d43daf9..cce8fc3 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -44,9 +44,7 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct } in let open Lru_trace_definition in - let _, { instance_count }, seq = - open_reader "/home/cha//Downloads/lru.trace" - in + let _, { instance_count }, seq = open_reader "./trace/lru.trace" in let caches = List.init instance_count (fun _ -> Cache.v cap) in let counter = Mtime_clock.counter () in Seq.iter From 545d055f92de97edf3ed936a27afbf339544d3cc Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:27:06 +0200 Subject: [PATCH 39/82] test --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 019309b..3ee5c1d 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ .PHONY: bench bench: - cd ./trace + ls -al wget http://data.tarides.com/irmin/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 1781edaccffa33caabd0ef00bb138f750e57c334 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:35:17 +0200 Subject: [PATCH 40/82] flag --- trace/cha.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 trace/cha.txt diff --git a/trace/cha.txt b/trace/cha.txt new file mode 100644 index 0000000..a4edf93 --- /dev/null +++ b/trace/cha.txt @@ -0,0 +1 @@ +cha \ No newline at end of file From e7134f82f0bb819e200e186214893681c9ee1f81 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:36:49 +0200 Subject: [PATCH 41/82] toto --- Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Makefile b/Makefile index 3ee5c1d..5f01e72 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,7 @@ .PHONY: bench bench: ls -al + cd ./trace wget http://data.tarides.com/irmin/lru.trace + cd .. opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 290e1917a7ef2900ad2db71e0b1c169704d855b5 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:43:52 +0200 Subject: [PATCH 42/82] last tests --- Makefile | 3 --- bench/replay.ml | 2 +- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/Makefile b/Makefile index 5f01e72..2aa064c 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,4 @@ .PHONY: bench bench: - ls -al - cd ./trace wget http://data.tarides.com/irmin/lru.trace - cd .. opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index cce8fc3..2cb632d 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -44,7 +44,7 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct } in let open Lru_trace_definition in - let _, { instance_count }, seq = open_reader "./trace/lru.trace" in + let _, { instance_count }, seq = open_reader "./lru.trace" in let caches = List.init instance_count (fun _ -> Cache.v cap) in let counter = Mtime_clock.counter () in Seq.iter From 20a15516f0c7f5453438760bd1c400f0d98d133e Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:46:57 +0200 Subject: [PATCH 43/82] i --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 2aa064c..ce616c2 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ .PHONY: bench bench: - wget http://data.tarides.com/irmin/lru.trace + wget -O lru.trace -c http://data.tarides.com/irmin/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 767b73e8c4770682c533d28efcce1196de44e3db Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:48:06 +0200 Subject: [PATCH 44/82] i --- Makefile | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile b/Makefile index ce616c2..c6faef5 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,5 @@ .PHONY: bench bench: + apt-get install wget wget -O lru.trace -c http://data.tarides.com/irmin/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 187a24f2b4e3e763a5df45665caadffac9f3bcd3 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:50:36 +0200 Subject: [PATCH 45/82] i --- Makefile | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Makefile b/Makefile index c6faef5..5b271ec 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,4 @@ .PHONY: bench bench: - apt-get install wget - wget -O lru.trace -c http://data.tarides.com/irmin/lru.trace + wget -c http://data.tarides.com/irmin/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From c5181a1a0a7031a88e801655520d997ebb2b532e Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 00:55:11 +0200 Subject: [PATCH 46/82] i --- Makefile | 2 +- bench/replay.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 5b271ec..dacfdee 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ .PHONY: bench bench: - wget -c http://data.tarides.com/irmin/lru.trace + wget http://data.tarides.com/irmin/lru.trace -O ./trace/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index 2cb632d..cce8fc3 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -44,7 +44,7 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct } in let open Lru_trace_definition in - let _, { instance_count }, seq = open_reader "./lru.trace" in + let _, { instance_count }, seq = open_reader "./trace/lru.trace" in let caches = List.init instance_count (fun _ -> Cache.v cap) in let counter = Mtime_clock.counter () in Seq.iter From d7204b28608ff09aa2e0e7e3de43783f0b105ee1 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 09:34:01 +0200 Subject: [PATCH 47/82] test wget --- Makefile | 1 + trace/cha.txt | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) delete mode 100644 trace/cha.txt diff --git a/Makefile b/Makefile index dacfdee..d699a76 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,5 @@ .PHONY: bench bench: + wget --version wget http://data.tarides.com/irmin/lru.trace -O ./trace/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file diff --git a/trace/cha.txt b/trace/cha.txt deleted file mode 100644 index a4edf93..0000000 --- a/trace/cha.txt +++ /dev/null @@ -1 +0,0 @@ -cha \ No newline at end of file From 3096a342862e892025b07d3aff661b37ba03c52f Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 09:40:11 +0200 Subject: [PATCH 48/82] test wget --- Makefile | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile b/Makefile index d699a76..57c1013 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,6 @@ .PHONY: bench bench: + apt-get install wget wget --version wget http://data.tarides.com/irmin/lru.trace -O ./trace/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 52a7617f3513c7479325da2d57c7e293b81587bb Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 09:42:33 +0200 Subject: [PATCH 49/82] test wget --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 57c1013..8969dbb 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ .PHONY: bench bench: - apt-get install wget + sudo apt-get install wget wget --version wget http://data.tarides.com/irmin/lru.trace -O ./trace/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 4d0a5c58839da1a9c9e7faa70e3b1dfae0fe2489 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 09:43:46 +0200 Subject: [PATCH 50/82] test wget --- Makefile | 1 + 1 file changed, 1 insertion(+) diff --git a/Makefile b/Makefile index 8969dbb..12fcf35 100644 --- a/Makefile +++ b/Makefile @@ -2,5 +2,6 @@ bench: sudo apt-get install wget wget --version + ls -al wget http://data.tarides.com/irmin/lru.trace -O ./trace/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 09ffec21c5076eb61fd8fe5b79274740d2b371ba Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 09:44:44 +0200 Subject: [PATCH 51/82] test wget --- trace/cha.txt | 1 + 1 file changed, 1 insertion(+) create mode 100644 trace/cha.txt diff --git a/trace/cha.txt b/trace/cha.txt new file mode 100644 index 0000000..a4edf93 --- /dev/null +++ b/trace/cha.txt @@ -0,0 +1 @@ +cha \ No newline at end of file From 62a9f41f5df30c5dfed31b16dd9518893af56b6f Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 09:51:10 +0200 Subject: [PATCH 52/82] clean v1 --- Makefile | 4 +--- trace/cha.txt | 1 - 2 files changed, 1 insertion(+), 4 deletions(-) delete mode 100644 trace/cha.txt diff --git a/Makefile b/Makefile index 12fcf35..ac514d4 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,5 @@ .PHONY: bench bench: sudo apt-get install wget - wget --version - ls -al - wget http://data.tarides.com/irmin/lru.trace -O ./trace/lru.trace + wget --directory-prefix=./trace/lru.trace http://data.tarides.com/irmin/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file diff --git a/trace/cha.txt b/trace/cha.txt deleted file mode 100644 index a4edf93..0000000 --- a/trace/cha.txt +++ /dev/null @@ -1 +0,0 @@ -cha \ No newline at end of file From 34e3e0f1c363d6f7b3e46209b6d7443f19919556 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 09:57:27 +0200 Subject: [PATCH 53/82] clean v2 --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index ac514d4..97f107f 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ .PHONY: bench bench: sudo apt-get install wget - wget --directory-prefix=./trace/lru.trace http://data.tarides.com/irmin/lru.trace + wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file From 30507379d5ade45c964a02c2ba78403229b7c087 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 10:21:28 +0200 Subject: [PATCH 54/82] clean v2 --- Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 97f107f..871dbc0 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,5 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file + opam exec -- dune exec -- bench/replay.exe lru 5001 + opam exec -- dune exec -- bench/replay.exe lfu 5001 \ No newline at end of file From 0f50feab5eed7a975f859e441d11fb31483cfe67 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 11:41:29 +0200 Subject: [PATCH 55/82] t --- Makefile | 3 +-- bench/replay.ml | 3 --- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 871dbc0..97f107f 100644 --- a/Makefile +++ b/Makefile @@ -2,5 +2,4 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - opam exec -- dune exec -- bench/replay.exe lru 5001 - opam exec -- dune exec -- bench/replay.exe lfu 5001 \ No newline at end of file + opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index cce8fc3..3f328ba 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -8,7 +8,6 @@ type stats = { mutable find : int; mutable hit : int; mutable miss : int; - (* mutable discard : int; *) mutable add_span : span; mutable mem_span : span; mutable find_span : span; @@ -36,7 +35,6 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct find = 0; hit = 0; miss = 0; - (* discard = 0; *) add_span = Mtime.Span.zero; mem_span = Mtime.Span.zero; find_span = Mtime.Span.zero; @@ -82,7 +80,6 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - (* Fmt.prs "%a\n" pp_stats stats *) pr_bench "add" "add_metric" (Mtime.Span.to_ms stats.add_span); pr_bench "mem" "mem_metric" (Mtime.Span.to_ms stats.mem_span); pr_bench "find" "find_metric" (Mtime.Span.to_ms stats.find_span); From cde81cd10fffba42ab907e5ffb9c12bb2b17ef61 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 11:55:55 +0200 Subject: [PATCH 56/82] differenciate cache strats --- Makefile | 3 ++- bench/replay.ml | 15 +++++++++++---- src/lfu.ml | 1 + src/lfu.mli | 1 + src/lru.ml | 1 + src/lru.mli | 1 + src/s.ml | 1 + 7 files changed, 18 insertions(+), 5 deletions(-) diff --git a/Makefile b/Makefile index 97f107f..871dbc0 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,5 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file + opam exec -- dune exec -- bench/replay.exe lru 5001 + opam exec -- dune exec -- bench/replay.exe lfu 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index 3f328ba..1f3b27a 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -80,10 +80,17 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - pr_bench "add" "add_metric" (Mtime.Span.to_ms stats.add_span); - pr_bench "mem" "mem_metric" (Mtime.Span.to_ms stats.mem_span); - pr_bench "find" "find_metric" (Mtime.Span.to_ms stats.find_span); - pr_bench "total_runtime" "total_runtime_metric" + pr_bench "add" + (Cache.name () ^ "add_metric") + (Mtime.Span.to_ms stats.add_span); + pr_bench "mem" + (Cache.name () ^ "mem_metric") + (Mtime.Span.to_ms stats.mem_span); + pr_bench "find" + (Cache.name () ^ "find_metric") + (Mtime.Span.to_ms stats.find_span); + pr_bench "total_runtime" + (Cache.name () ^ "total_runtime_metric") (Mtime.Span.to_ms stats.total_runtime_span) end diff --git a/src/lfu.ml b/src/lfu.ml index 23357fb..0ed6358 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -30,6 +30,7 @@ struct if c <= 0 then invalid_arg "capacity must be strictly positive"; unsafe_v c + let name () = "lfu" let stats t = t.stats let is_empty t = H.length t.value = 0 let capacity t = t.cap diff --git a/src/lfu.mli b/src/lfu.mli index 8f2daf7..2482f93 100644 --- a/src/lfu.mli +++ b/src/lfu.mli @@ -8,6 +8,7 @@ end) : sig type key = K.t val v : int -> 'a t + val name : unit -> string val stats : 'a t -> Stats.t val is_empty : 'a t -> bool val capacity : 'a t -> int diff --git a/src/lru.ml b/src/lru.ml index edeb0d0..91cc8d6 100644 --- a/src/lru.ml +++ b/src/lru.ml @@ -30,6 +30,7 @@ struct if c <= 0 then invalid_arg "capacity must be strictly positive"; unsafe_v c + let name () = "lru" let stats t = t.stats let is_empty t = Dllist.length t.lst = 0 let capacity t = t.cap diff --git a/src/lru.mli b/src/lru.mli index a295c39..b92cd11 100644 --- a/src/lru.mli +++ b/src/lru.mli @@ -27,6 +27,7 @@ end) : sig ensures t.cap = c ensures forall k. t.assoc k = None *) + val name : unit -> string val stats : 'a t -> Stats.t val is_empty : 'a t -> bool (*@ b = is_empty t diff --git a/src/s.ml b/src/s.ml index c153b38..e1893c8 100644 --- a/src/s.ml +++ b/src/s.ml @@ -3,6 +3,7 @@ module type Cache = sig type key val v : int -> 'a t + val name : unit -> string val stats : 'a t -> Stats.t val is_empty : 'a t -> bool val capacity : 'a t -> int From b17f3a1eb21ab902d31310a10c5b5910c095645c Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 12:01:57 +0200 Subject: [PATCH 57/82] differenciate cache strats --- Makefile | 3 +-- bench/replay.ml | 8 ++++---- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/Makefile b/Makefile index 871dbc0..97f107f 100644 --- a/Makefile +++ b/Makefile @@ -2,5 +2,4 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - opam exec -- dune exec -- bench/replay.exe lru 5001 - opam exec -- dune exec -- bench/replay.exe lfu 5001 \ No newline at end of file + opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index 1f3b27a..376c43b 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -81,16 +81,16 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct | _ -> assert false) seq; pr_bench "add" - (Cache.name () ^ "add_metric") + (Cache.name () ^ "-add_metric") (Mtime.Span.to_ms stats.add_span); pr_bench "mem" - (Cache.name () ^ "mem_metric") + (Cache.name () ^ "-mem_metric") (Mtime.Span.to_ms stats.mem_span); pr_bench "find" - (Cache.name () ^ "find_metric") + (Cache.name () ^ "-find_metric") (Mtime.Span.to_ms stats.find_span); pr_bench "total_runtime" - (Cache.name () ^ "total_runtime_metric") + (Cache.name () ^ "-total_runtime_metric") (Mtime.Span.to_ms stats.total_runtime_span) end From e1d74166ad6632fbd0b77960ce059c8909e0c88c Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 12:08:27 +0200 Subject: [PATCH 58/82] ret --- bench/replay.ml | 15 ++++----------- src/lfu.ml | 1 - src/lfu.mli | 1 - src/lru.ml | 1 - src/lru.mli | 1 - src/s.ml | 1 - 6 files changed, 4 insertions(+), 16 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 376c43b..3f328ba 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -80,17 +80,10 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - pr_bench "add" - (Cache.name () ^ "-add_metric") - (Mtime.Span.to_ms stats.add_span); - pr_bench "mem" - (Cache.name () ^ "-mem_metric") - (Mtime.Span.to_ms stats.mem_span); - pr_bench "find" - (Cache.name () ^ "-find_metric") - (Mtime.Span.to_ms stats.find_span); - pr_bench "total_runtime" - (Cache.name () ^ "-total_runtime_metric") + pr_bench "add" "add_metric" (Mtime.Span.to_ms stats.add_span); + pr_bench "mem" "mem_metric" (Mtime.Span.to_ms stats.mem_span); + pr_bench "find" "find_metric" (Mtime.Span.to_ms stats.find_span); + pr_bench "total_runtime" "total_runtime_metric" (Mtime.Span.to_ms stats.total_runtime_span) end diff --git a/src/lfu.ml b/src/lfu.ml index 0ed6358..23357fb 100644 --- a/src/lfu.ml +++ b/src/lfu.ml @@ -30,7 +30,6 @@ struct if c <= 0 then invalid_arg "capacity must be strictly positive"; unsafe_v c - let name () = "lfu" let stats t = t.stats let is_empty t = H.length t.value = 0 let capacity t = t.cap diff --git a/src/lfu.mli b/src/lfu.mli index 2482f93..8f2daf7 100644 --- a/src/lfu.mli +++ b/src/lfu.mli @@ -8,7 +8,6 @@ end) : sig type key = K.t val v : int -> 'a t - val name : unit -> string val stats : 'a t -> Stats.t val is_empty : 'a t -> bool val capacity : 'a t -> int diff --git a/src/lru.ml b/src/lru.ml index 91cc8d6..edeb0d0 100644 --- a/src/lru.ml +++ b/src/lru.ml @@ -30,7 +30,6 @@ struct if c <= 0 then invalid_arg "capacity must be strictly positive"; unsafe_v c - let name () = "lru" let stats t = t.stats let is_empty t = Dllist.length t.lst = 0 let capacity t = t.cap diff --git a/src/lru.mli b/src/lru.mli index b92cd11..a295c39 100644 --- a/src/lru.mli +++ b/src/lru.mli @@ -27,7 +27,6 @@ end) : sig ensures t.cap = c ensures forall k. t.assoc k = None *) - val name : unit -> string val stats : 'a t -> Stats.t val is_empty : 'a t -> bool (*@ b = is_empty t diff --git a/src/s.ml b/src/s.ml index e1893c8..c153b38 100644 --- a/src/s.ml +++ b/src/s.ml @@ -3,7 +3,6 @@ module type Cache = sig type key val v : int -> 'a t - val name : unit -> string val stats : 'a t -> Stats.t val is_empty : 'a t -> bool val capacity : 'a t -> int From 6c0d2b3eab70ad1d6abf0dc63790ee0b36d64c86 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 13:37:38 +0200 Subject: [PATCH 59/82] a --- Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 97f107f..871dbc0 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,5 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - opam exec -- dune exec -- bench/replay.exe lru 5001 \ No newline at end of file + opam exec -- dune exec -- bench/replay.exe lru 5001 + opam exec -- dune exec -- bench/replay.exe lfu 5001 \ No newline at end of file From ea69b72ff3edfb1f12e5725e318a1e72c60f4416 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 13:55:25 +0200 Subject: [PATCH 60/82] y --- bench/replay.ml | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 3f328ba..17d6da0 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -51,7 +51,9 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct match op with | Add k -> let before = Mtime_clock.count counter in - Cache.replace cache k (); + for _ = 0 to 10 do + Cache.replace cache k () + done; let after = Mtime_clock.count counter in stats.total_runtime_span <- Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); @@ -60,7 +62,9 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.add <- stats.add + 1 | Find k -> let before = Mtime_clock.count counter in - ignore (Cache.find_opt cache k : _ option); + for _ = 0 to 10 do + ignore (Cache.find_opt cache k : _ option) + done; let after = Mtime_clock.count counter in stats.total_runtime_span <- Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); @@ -69,14 +73,17 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.find <- stats.find + 1 | Mem k -> let before = Mtime_clock.count counter in - let b = Cache.mem cache k in + for _ = 0 to 10 do + let b = Cache.mem cache k in + if b then stats.hit <- stats.hit + 1 + else stats.miss <- stats.miss + 1 + done; let after = Mtime_clock.count counter in stats.total_runtime_span <- Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.mem_span <- Mtime.Span.(abs_diff after before |> add stats.mem_span); - if b then stats.hit <- stats.hit + 1 - else stats.miss <- stats.miss + 1; + stats.mem <- stats.mem + 1 | _ -> assert false) seq; From e1d1d250fab5ea1192b07dd8e1ba13960034c956 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 14:08:01 +0200 Subject: [PATCH 61/82] r --- bench/replay.ml | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 17d6da0..3f328ba 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -51,9 +51,7 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct match op with | Add k -> let before = Mtime_clock.count counter in - for _ = 0 to 10 do - Cache.replace cache k () - done; + Cache.replace cache k (); let after = Mtime_clock.count counter in stats.total_runtime_span <- Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); @@ -62,9 +60,7 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.add <- stats.add + 1 | Find k -> let before = Mtime_clock.count counter in - for _ = 0 to 10 do - ignore (Cache.find_opt cache k : _ option) - done; + ignore (Cache.find_opt cache k : _ option); let after = Mtime_clock.count counter in stats.total_runtime_span <- Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); @@ -73,17 +69,14 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.find <- stats.find + 1 | Mem k -> let before = Mtime_clock.count counter in - for _ = 0 to 10 do - let b = Cache.mem cache k in - if b then stats.hit <- stats.hit + 1 - else stats.miss <- stats.miss + 1 - done; + let b = Cache.mem cache k in let after = Mtime_clock.count counter in stats.total_runtime_span <- Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.mem_span <- Mtime.Span.(abs_diff after before |> add stats.mem_span); - + if b then stats.hit <- stats.hit + 1 + else stats.miss <- stats.miss + 1; stats.mem <- stats.mem + 1 | _ -> assert false) seq; From f5e6037d2642674aaf9cd9216de18b31b4ffc8f6 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Wed, 1 Jun 2022 14:21:30 +0200 Subject: [PATCH 62/82] h --- Makefile | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Makefile b/Makefile index 871dbc0..baf89aa 100644 --- a/Makefile +++ b/Makefile @@ -2,5 +2,4 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - opam exec -- dune exec -- bench/replay.exe lru 5001 - opam exec -- dune exec -- bench/replay.exe lfu 5001 \ No newline at end of file + for i in $(shell seq 1 100); do opam exec -- dune exec -- bench/replay.exe lru 5001; done \ No newline at end of file From 3d5ca26b463e853674c30a340cbe91c294e5239e Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 10:53:58 +0200 Subject: [PATCH 63/82] wow --- Makefile | 2 +- bench/replay.ml | 55 ++++++++++++++++++++++--------------------------- 2 files changed, 26 insertions(+), 31 deletions(-) diff --git a/Makefile b/Makefile index baf89aa..b2ef03e 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,4 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - for i in $(shell seq 1 100); do opam exec -- dune exec -- bench/replay.exe lru 5001; done \ No newline at end of file + for i in $(shell seq 1 2); do opam exec -- dune exec -- bench/replay.exe lru 5001; done \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index 3f328ba..7ca7fbc 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -8,10 +8,10 @@ type stats = { mutable find : int; mutable hit : int; mutable miss : int; - mutable add_span : span; - mutable mem_span : span; - mutable find_span : span; - mutable total_runtime_span : span; + mutable add_span : float; + mutable mem_span : float; + mutable find_span : float; + mutable total_runtime_span : float; } [@@deriving repr ~pp] @@ -26,6 +26,15 @@ let pr_bench test_name metric_name value = {|{"results": [{"name": "%s", "metrics": [{"name": "%s", "value": %f, "units": "ms"}]}]}@.|} test_name metric_name value +let mtime s counter (f : unit -> unit) = + let t = Mtime_clock.count counter in + f (); + let t = + Mtime.Span.to_ms (Mtime.Span.abs_diff (Mtime_clock.count counter) t) + in + s.total_runtime_span <- s.total_runtime_span +. t; + t + module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct let bench cap = let stats = @@ -35,10 +44,10 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct find = 0; hit = 0; miss = 0; - add_span = Mtime.Span.zero; - mem_span = Mtime.Span.zero; - find_span = Mtime.Span.zero; - total_runtime_span = Mtime.Span.zero; + add_span = 0.; + mem_span = 0.; + find_span = 0.; + total_runtime_span = 0.; } in let open Lru_trace_definition in @@ -50,41 +59,27 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct let cache = List.nth caches instance_id in match op with | Add k -> - let before = Mtime_clock.count counter in - Cache.replace cache k (); - let after = Mtime_clock.count counter in - stats.total_runtime_span <- - Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.add_span <- - Mtime.Span.(abs_diff after before |> add stats.add_span); + stats.add_span +. mtime stats counter (Cache.replace cache k); stats.add <- stats.add + 1 | Find k -> - let before = Mtime_clock.count counter in - ignore (Cache.find_opt cache k : _ option); - let after = Mtime_clock.count counter in - stats.total_runtime_span <- - Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.find_span <- - Mtime.Span.(abs_diff after before |> add stats.find_span); + stats.find_span + +. mtime stats counter (fun _ -> ignore (Cache.find_opt cache k)); stats.find <- stats.find + 1 | Mem k -> - let before = Mtime_clock.count counter in let b = Cache.mem cache k in - let after = Mtime_clock.count counter in - stats.total_runtime_span <- - Mtime.Span.(abs_diff after before |> add stats.total_runtime_span); stats.mem_span <- - Mtime.Span.(abs_diff after before |> add stats.mem_span); + stats.mem_span +. mtime stats counter (fun _ -> ignore b); if b then stats.hit <- stats.hit + 1 else stats.miss <- stats.miss + 1; stats.mem <- stats.mem + 1 | _ -> assert false) seq; - pr_bench "add" "add_metric" (Mtime.Span.to_ms stats.add_span); - pr_bench "mem" "mem_metric" (Mtime.Span.to_ms stats.mem_span); - pr_bench "find" "find_metric" (Mtime.Span.to_ms stats.find_span); - pr_bench "total_runtime" "total_runtime_metric" - (Mtime.Span.to_ms stats.total_runtime_span) + pr_bench "add" "add_metric" stats.add_span; + pr_bench "mem" "mem_metric" stats.mem_span; + pr_bench "find" "find_metric" stats.find_span; + pr_bench "total_runtime" "total_runtime_metric" stats.total_runtime_span end include Cachecache.Lru.Make (K) From 18791153a2146f80835664be9bc68aa13cd969b8 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 11:10:31 +0200 Subject: [PATCH 64/82] o --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index b2ef03e..8d4f7bd 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,4 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - for i in $(shell seq 1 2); do opam exec -- dune exec -- bench/replay.exe lru 5001; done \ No newline at end of file + for i in $(shell seq 1 2); do opam exec -- dune exec -- bench/replay.exe lru 10001; done \ No newline at end of file From 8391b7b7a2cced95a2209bf82dc9a3e0f004ed7f Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 11:18:23 +0200 Subject: [PATCH 65/82] haha --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 8d4f7bd..b77666e 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,4 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - for i in $(shell seq 1 2); do opam exec -- dune exec -- bench/replay.exe lru 10001; done \ No newline at end of file + for i in $(shell seq 5000 1000 20000); do echo $$i; opam exec -- dune exec -- bench/replay.exe lru $$i; done \ No newline at end of file From 489c9575e4e170373fe3657f9065bf12853a6090 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 11:59:33 +0200 Subject: [PATCH 66/82] aleatoire --- Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index b77666e..5f620c5 100644 --- a/Makefile +++ b/Makefile @@ -2,4 +2,6 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - for i in $(shell seq 5000 1000 20000); do echo $$i; opam exec -- dune exec -- bench/replay.exe lru $$i; done \ No newline at end of file + # for i in $(shell seq 5000 1000 20000); do echo $$i; opam exec -- dune exec -- bench/replay.exe lru $$i; done + opam exec -- dune exec -- bench/replay.exe lru 5000 + opam exec -- dune exec -- bench/replay.exe lfu 5000 \ No newline at end of file From d4d40ee1e979c4c6fbdb450b35658aafafe1307d Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 13:46:56 +0200 Subject: [PATCH 67/82] :) --- Makefile | 8 +++++--- bench/replay.ml | 45 +++++++++++++++++++++++++++------------------ 2 files changed, 32 insertions(+), 21 deletions(-) diff --git a/Makefile b/Makefile index 5f620c5..3e9eb06 100644 --- a/Makefile +++ b/Makefile @@ -2,6 +2,8 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - # for i in $(shell seq 5000 1000 20000); do echo $$i; opam exec -- dune exec -- bench/replay.exe lru $$i; done - opam exec -- dune exec -- bench/replay.exe lru 5000 - opam exec -- dune exec -- bench/replay.exe lfu 5000 \ No newline at end of file + # for i in $(shell seq 5000 1000 20000); do echo $$i; opam exec -- * + dune exec bench/replay.exe + # lru $$i; done + # opam exec -- dune exec -- bench/replay.exe lru 5000 + # opam exec -- dune exec -- bench/replay.exe lfu 5000 \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index 7ca7fbc..7c2f021 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -36,7 +36,7 @@ let mtime s counter (f : unit -> unit) = t module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct - let bench cap = + let bench name cap = let stats = { add = 0; @@ -76,10 +76,10 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - pr_bench "add" "add_metric" stats.add_span; - pr_bench "mem" "mem_metric" stats.mem_span; - pr_bench "find" "find_metric" stats.find_span; - pr_bench "total_runtime" "total_runtime_metric" stats.total_runtime_span + pr_bench name "add" stats.add_span; + (* pr_bench name "mem" stats.mem_span; *) + pr_bench name "find" stats.find_span; + pr_bench name "total_runtime" stats.total_runtime_span end include Cachecache.Lru.Make (K) @@ -88,20 +88,29 @@ module Lfu = Cachecache.Lfu.Make (K) module Bench_lru = Make (Lru) module Bench_lfu = Make (Lfu) -let main algo cap = - match algo with `Lru -> Bench_lru.bench cap | `Lfu -> Bench_lfu.bench cap +(* let main algo cap = + match algo with `Lru -> Bench_lru.bench cap | `Lfu -> Bench_lfu.bench cap -open Cmdliner + open Cmdliner -let algo = - let l = [ ("lru", `Lru); ("lfu", `Lfu) ] in - let i = Arg.info [] in - Arg.(required @@ pos 0 (some (enum l)) None i) + let algo = *) +(* let l = [ ("lru", `Lru); ("lfu", `Lfu) ] in *) +(* let i = Arg.info [] in + Arg.(required @@ pos 0 (some (enum l)) None i) *) -let cap = - let i = Arg.info [] in - Arg.(required @@ pos 1 (some int) None i) +(* let cap = + let i = Arg.info [] in + Arg.(required @@ pos 1 (some int) None i) *) -let main_t = Term.(const main $ algo $ cap) -let cmd = Cmd.v (Cmd.info "replay") main_t -let () = exit (Cmd.eval cmd) \ No newline at end of file +(* let main_t = Term.(const main $ algo $ cap) *) +(* let cmd = Cmd.v (Cmd.info "replay") main_t *) + +let () = + (* exit (Cmd.eval cmd) ; *) + let t = [| 1000; 10000; 100000 |] in + for _ = 0 to 3 do + for cap = 0 to Array.length t do + Bench_lru.bench "lru" t.(cap); + Bench_lfu.bench "lfu" t.(cap) + done + done From 0008efdae34704d9a8f6ed1c3c691efc11ebd4fa Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 13:52:40 +0200 Subject: [PATCH 68/82] :s --- bench/replay.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 7c2f021..1f4ba9c 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -108,8 +108,8 @@ module Bench_lfu = Make (Lfu) let () = (* exit (Cmd.eval cmd) ; *) let t = [| 1000; 10000; 100000 |] in - for _ = 0 to 3 do - for cap = 0 to Array.length t do + for _ = 0 to 2 do + for cap = 0 to Array.length t - 1 do Bench_lru.bench "lru" t.(cap); Bench_lfu.bench "lfu" t.(cap) done From 90c26e368d0dac376369ccb75ebdad39c536c6ce Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 14:05:25 +0200 Subject: [PATCH 69/82] =?UTF-8?q?>:c=20=20=20<-=20f=C3=A2ch=C3=A9=20car=20?= =?UTF-8?q?pas=20de=20glace?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- bench/replay.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 1f4ba9c..ee2758c 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -108,8 +108,9 @@ module Bench_lfu = Make (Lfu) let () = (* exit (Cmd.eval cmd) ; *) let t = [| 1000; 10000; 100000 |] in - for _ = 0 to 2 do - for cap = 0 to Array.length t - 1 do + for _ = 0 to 1 do + for cap = 0 to Array.length t - 2 do + Fmt.pr "cap = %d\n" cap; Bench_lru.bench "lru" t.(cap); Bench_lfu.bench "lfu" t.(cap) done From bbc863a1f4c8c1e2616867a2af4be5713a013bbd Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 14:09:16 +0200 Subject: [PATCH 70/82] il est triste --- bench/replay.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index ee2758c..0f67674 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -109,9 +109,9 @@ let () = (* exit (Cmd.eval cmd) ; *) let t = [| 1000; 10000; 100000 |] in for _ = 0 to 1 do - for cap = 0 to Array.length t - 2 do - Fmt.pr "cap = %d\n" cap; - Bench_lru.bench "lru" t.(cap); - Bench_lfu.bench "lfu" t.(cap) + for i = 0 to Array.length t - 2 do + Fmt.pr "cap = %d\n" t.(i); + Bench_lru.bench "lru" t.(i); + Bench_lfu.bench "lfu" t.(i) done done From ec5a052a0d01e78da82a267b23ab331e912203b2 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 14:53:23 +0200 Subject: [PATCH 71/82] cha --- bench/replay.ml | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 0f67674..2cd23fd 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -26,6 +26,17 @@ let pr_bench test_name metric_name value = {|{"results": [{"name": "%s", "metrics": [{"name": "%s", "value": %f, "units": "ms"}]}]}@.|} test_name metric_name value +let multi_curves test_name lru_value lfu_value = + Format.printf + {|{"results": [{"name": "%s", "metrics": [{"name": "%s/lru", "value": %f, "units": "ms"}, {"name": "%s/lfu", "value": %f, "units": "ms"}]}]}@.|} + test_name test_name lru_value test_name lfu_value +(*let metrics test_name metric_name value = + Printf.sprintf + {|[{"name": "%s", "metrics": [{"name": "%s", "value": %f, "units": "ms"}]}]@.|} + test_name metric_name value + + let pr_bench m = Format.printf {|{"results": %s}@.|} m*) + let mtime s counter (f : unit -> unit) = let t = Mtime_clock.count counter in f (); @@ -76,10 +87,11 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - pr_bench name "add" stats.add_span; + (* pr_bench name "add" stats.add_span; *) (* pr_bench name "mem" stats.mem_span; *) - pr_bench name "find" stats.find_span; - pr_bench name "total_runtime" stats.total_runtime_span + (* pr_bench name "find" stats.find_span; *) + pr_bench name "___" stats.total_runtime_span; + stats end include Cachecache.Lru.Make (K) @@ -111,7 +123,11 @@ let () = for _ = 0 to 1 do for i = 0 to Array.length t - 2 do Fmt.pr "cap = %d\n" t.(i); - Bench_lru.bench "lru" t.(i); - Bench_lfu.bench "lfu" t.(i) + let lru_stats = Bench_lru.bench "lru" t.(i) in + let lfu_stats = Bench_lfu.bench "lfu" t.(i) in + multi_curves "add" lru_stats.add_span lfu_stats.add_span; + multi_curves "find" lru_stats.find_span lfu_stats.find_span; + multi_curves "total_runtime" lru_stats.total_runtime_span + lfu_stats.total_runtime_span done done From 566735b66f48a745a2aa41ad9c288cd0bd1bb8d5 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 15:14:19 +0200 Subject: [PATCH 72/82] o --- Makefile | 6 +---- bench/replay.ml | 65 +++++++++++++++++-------------------------------- 2 files changed, 24 insertions(+), 47 deletions(-) diff --git a/Makefile b/Makefile index 3e9eb06..f54864c 100644 --- a/Makefile +++ b/Makefile @@ -2,8 +2,4 @@ bench: sudo apt-get install wget wget --directory-prefix=./trace http://data.tarides.com/irmin/lru.trace - # for i in $(shell seq 5000 1000 20000); do echo $$i; opam exec -- * - dune exec bench/replay.exe - # lru $$i; done - # opam exec -- dune exec -- bench/replay.exe lru 5000 - # opam exec -- dune exec -- bench/replay.exe lfu 5000 \ No newline at end of file + dune exec bench/replay.exe \ No newline at end of file diff --git a/bench/replay.ml b/bench/replay.ml index 2cd23fd..54144b3 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -21,21 +21,13 @@ module K = struct let hash = Hashtbl.hash end -let pr_bench test_name metric_name value = - Format.printf - {|{"results": [{"name": "%s", "metrics": [{"name": "%s", "value": %f, "units": "ms"}]}]}@.|} - test_name metric_name value +let pr_bench test_name metrics = + Format.printf {|{"results": [{"name": "%s", "metrics": [%s]}]}@.|} test_name + metrics -let multi_curves test_name lru_value lfu_value = - Format.printf - {|{"results": [{"name": "%s", "metrics": [{"name": "%s/lru", "value": %f, "units": "ms"}, {"name": "%s/lfu", "value": %f, "units": "ms"}]}]}@.|} - test_name test_name lru_value test_name lfu_value -(*let metrics test_name metric_name value = - Printf.sprintf - {|[{"name": "%s", "metrics": [{"name": "%s", "value": %f, "units": "ms"}]}]@.|} - test_name metric_name value - - let pr_bench m = Format.printf {|{"results": %s}@.|} m*) +let metrics metric_name value = + Printf.sprintf {|{"name": "%s", "value": %f, "units": "ms"}@.|} metric_name + value let mtime s counter (f : unit -> unit) = let t = Mtime_clock.count counter in @@ -87,10 +79,9 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - (* pr_bench name "add" stats.add_span; *) - (* pr_bench name "mem" stats.mem_span; *) - (* pr_bench name "find" stats.find_span; *) - pr_bench name "___" stats.total_runtime_span; + pr_bench name (metrics "add" stats.add_span); + pr_bench name (metrics "find" stats.find_span); + pr_bench name (metrics "total_runtime" stats.total_runtime_span); stats end @@ -100,34 +91,24 @@ module Lfu = Cachecache.Lfu.Make (K) module Bench_lru = Make (Lru) module Bench_lfu = Make (Lfu) -(* let main algo cap = - match algo with `Lru -> Bench_lru.bench cap | `Lfu -> Bench_lfu.bench cap - - open Cmdliner - - let algo = *) -(* let l = [ ("lru", `Lru); ("lfu", `Lfu) ] in *) -(* let i = Arg.info [] in - Arg.(required @@ pos 0 (some (enum l)) None i) *) - -(* let cap = - let i = Arg.info [] in - Arg.(required @@ pos 1 (some int) None i) *) - -(* let main_t = Term.(const main $ algo $ cap) *) -(* let cmd = Cmd.v (Cmd.info "replay") main_t *) - let () = - (* exit (Cmd.eval cmd) ; *) let t = [| 1000; 10000; 100000 |] in - for _ = 0 to 1 do - for i = 0 to Array.length t - 2 do + for _ = 0 to 10 do + for i = 0 to Array.length t - 1 do Fmt.pr "cap = %d\n" t.(i); let lru_stats = Bench_lru.bench "lru" t.(i) in let lfu_stats = Bench_lfu.bench "lfu" t.(i) in - multi_curves "add" lru_stats.add_span lfu_stats.add_span; - multi_curves "find" lru_stats.find_span lfu_stats.find_span; - multi_curves "total_runtime" lru_stats.total_runtime_span - lfu_stats.total_runtime_span + pr_bench "add" + (metrics "add" lru_stats.add_span + ^ "," + ^ metrics "add" lfu_stats.add_span); + pr_bench "find" + (metrics "find" lru_stats.find_span + ^ "," + ^ metrics "find" lfu_stats.find_span); + pr_bench "total_runtime" + (metrics "total_runtime" lru_stats.total_runtime_span + ^ "," + ^ metrics "total_runtime" lfu_stats.total_runtime_span) done done From 1a90cd8abe7f0217965041725ac46babe161ccb3 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 15:19:16 +0200 Subject: [PATCH 73/82] youpiii --- bench/replay.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 54144b3..667ad78 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -26,7 +26,7 @@ let pr_bench test_name metrics = metrics let metrics metric_name value = - Printf.sprintf {|{"name": "%s", "value": %f, "units": "ms"}@.|} metric_name + Printf.sprintf {|{"name": "%s", "value": %f, "units": "ms"}|} metric_name value let mtime s counter (f : unit -> unit) = @@ -93,8 +93,8 @@ module Bench_lfu = Make (Lfu) let () = let t = [| 1000; 10000; 100000 |] in - for _ = 0 to 10 do - for i = 0 to Array.length t - 1 do + for _ = 0 to 1 do + for i = 0 to Array.length t - 2 do Fmt.pr "cap = %d\n" t.(i); let lru_stats = Bench_lru.bench "lru" t.(i) in let lfu_stats = Bench_lfu.bench "lfu" t.(i) in From 98ca858a0fec637f7839f3a7e37a44c595c86bed Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 15:24:59 +0200 Subject: [PATCH 74/82] youpi deux --- bench/replay.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 667ad78..10217cb 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -99,16 +99,16 @@ let () = let lru_stats = Bench_lru.bench "lru" t.(i) in let lfu_stats = Bench_lfu.bench "lfu" t.(i) in pr_bench "add" - (metrics "add" lru_stats.add_span + (metrics "add/lru" lru_stats.add_span ^ "," - ^ metrics "add" lfu_stats.add_span); + ^ metrics "add/lfu" lfu_stats.add_span); pr_bench "find" - (metrics "find" lru_stats.find_span + (metrics "find/lru" lru_stats.find_span ^ "," - ^ metrics "find" lfu_stats.find_span); + ^ metrics "find/lfu" lfu_stats.find_span); pr_bench "total_runtime" - (metrics "total_runtime" lru_stats.total_runtime_span + (metrics "total_runtime/lru" lru_stats.total_runtime_span ^ "," - ^ metrics "total_runtime" lfu_stats.total_runtime_span) + ^ metrics "total_runtime/lfu" lfu_stats.total_runtime_span) done done From 5fe13c3acdcdda1600597f474389fe61be295856 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 15:36:27 +0200 Subject: [PATCH 75/82] the --- bench/replay.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/bench/replay.ml b/bench/replay.ml index 10217cb..a19da4d 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -81,6 +81,7 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct seq; pr_bench name (metrics "add" stats.add_span); pr_bench name (metrics "find" stats.find_span); + pr_bench name (metrics "total_runtime" stats.total_runtime_span); stats end From 70b6baf7a8e10a3f477a0f5b827b1ba32b6ab543 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 16:23:39 +0200 Subject: [PATCH 76/82] test --- bench/replay.ml | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/bench/replay.ml b/bench/replay.ml index a19da4d..b654efc 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -110,6 +110,17 @@ let () = pr_bench "total_runtime" (metrics "total_runtime/lru" lru_stats.total_runtime_span ^ "," - ^ metrics "total_runtime/lfu" lfu_stats.total_runtime_span) + ^ metrics "total_runtime/lfu" lfu_stats.total_runtime_span); + let str_cap = string_of_int t.(i) in + pr_bench "lfu" (metrics ("add/" ^ str_cap) lfu_stats.add_span); + pr_bench "lru" (metrics ("add/" ^ str_cap) lru_stats.add_span); + + pr_bench "lfu" (metrics ("find/" ^ str_cap) lfu_stats.find_span); + pr_bench "lru" (metrics ("find/" ^ str_cap) lru_stats.find_span); + + pr_bench "lfu" + (metrics ("total_runtime/" ^ str_cap) lfu_stats.total_runtime_span); + pr_bench "lru" + (metrics ("total_runtime/" ^ str_cap) lru_stats.total_runtime_span) done done From 402f6bce603d9b42b461317175861cdfacad048c Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 16:24:28 +0200 Subject: [PATCH 77/82] re --- bench/replay.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index b654efc..7062edf 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -79,10 +79,10 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - pr_bench name (metrics "add" stats.add_span); - pr_bench name (metrics "find" stats.find_span); + (* pr_bench name (metrics "add" stats.add_span); + pr_bench name (metrics "find" stats.find_span); - pr_bench name (metrics "total_runtime" stats.total_runtime_span); + pr_bench name (metrics "total_runtime" stats.total_runtime_span); *) stats end From 9e76cbf563367716512eade0231935c40a045650 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 16:25:07 +0200 Subject: [PATCH 78/82] c --- bench/replay.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 7062edf..5da720d 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -39,7 +39,7 @@ let mtime s counter (f : unit -> unit) = t module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct - let bench name cap = + let bench cap = let stats = { add = 0; @@ -97,8 +97,8 @@ let () = for _ = 0 to 1 do for i = 0 to Array.length t - 2 do Fmt.pr "cap = %d\n" t.(i); - let lru_stats = Bench_lru.bench "lru" t.(i) in - let lfu_stats = Bench_lfu.bench "lfu" t.(i) in + let lru_stats = Bench_lru.bench t.(i) in + let lfu_stats = Bench_lfu.bench t.(i) in pr_bench "add" (metrics "add/lru" lru_stats.add_span ^ "," From 20d3afcbd19529e2f6d59422734745ad58d59881 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 16:47:21 +0200 Subject: [PATCH 79/82] c --- bench/replay.ml | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 5da720d..35b57cb 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -94,8 +94,8 @@ module Bench_lfu = Make (Lfu) let () = let t = [| 1000; 10000; 100000 |] in - for _ = 0 to 1 do - for i = 0 to Array.length t - 2 do + for _ = 0 to 2 do + for i = 0 to Array.length t - 1 do Fmt.pr "cap = %d\n" t.(i); let lru_stats = Bench_lru.bench t.(i) in let lfu_stats = Bench_lfu.bench t.(i) in @@ -113,13 +113,11 @@ let () = ^ metrics "total_runtime/lfu" lfu_stats.total_runtime_span); let str_cap = string_of_int t.(i) in pr_bench "lfu" (metrics ("add/" ^ str_cap) lfu_stats.add_span); - pr_bench "lru" (metrics ("add/" ^ str_cap) lru_stats.add_span); - pr_bench "lfu" (metrics ("find/" ^ str_cap) lfu_stats.find_span); - pr_bench "lru" (metrics ("find/" ^ str_cap) lru_stats.find_span); - pr_bench "lfu" (metrics ("total_runtime/" ^ str_cap) lfu_stats.total_runtime_span); + pr_bench "lru" (metrics ("add/" ^ str_cap) lru_stats.add_span); + pr_bench "lru" (metrics ("find/" ^ str_cap) lru_stats.find_span); pr_bench "lru" (metrics ("total_runtime/" ^ str_cap) lru_stats.total_runtime_span) done From d4f8c83316a51c4838ce6d05e9d7603de14da67a Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Thu, 2 Jun 2022 17:00:23 +0200 Subject: [PATCH 80/82] end --- bench/replay.ml | 4 ---- 1 file changed, 4 deletions(-) diff --git a/bench/replay.ml b/bench/replay.ml index 35b57cb..cc30303 100644 --- a/bench/replay.ml +++ b/bench/replay.ml @@ -79,10 +79,6 @@ module Make (Cache : Cachecache.S.Cache with type key = K.t) = struct stats.mem <- stats.mem + 1 | _ -> assert false) seq; - (* pr_bench name (metrics "add" stats.add_span); - pr_bench name (metrics "find" stats.find_span); - - pr_bench name (metrics "total_runtime" stats.total_runtime_span); *) stats end From 2ebdff2625f673c18c79049d91b3da59a5763289 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Fri, 24 Jun 2022 14:29:44 +0200 Subject: [PATCH 81/82] added first line of gospel in lfu interface --- src/lfu.mli | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/src/lfu.mli b/src/lfu.mli index 8f2daf7..a468057 100644 --- a/src/lfu.mli +++ b/src/lfu.mli @@ -2,20 +2,72 @@ module Make (K : sig type t val equal : t -> t -> bool + (*@ pure*) + val hash : t -> int end) : sig type 'a t type key = K.t + (*@ ephemeral + model cap : int + mutable model assoc : key -> 'a option + mutable model frequency : key -> int + invariant cap > 0 + invariant forall k. assoc k <> None -> frequency > 0 *) + val v : int -> 'a t + (* t = v c + checks c > 0 + ensures t.cap = c + ensures forall k. t.assoc k = None *) + val stats : 'a t -> Stats.t val is_empty : 'a t -> bool + (*@ b = is_empty t + pure + ensures b <-> forall k. t.assoc k = None *) + val capacity : 'a t -> int + (*@ c = capacity t + pure + ensures c = t.cap *) + val size : 'a t -> int + (*@ s = size t + pure *) + val clear : 'a t -> unit + (*@ clear t + modifies t *) + val find : 'a t -> key -> 'a + (*@ v = find t k + ensures t.assoc k = Some v + raises Not_found -> t.assoc k = None + ensures if t.assoc k = Some v then t.frequency k = t.frequency old k + 1 *) + val find_opt : 'a t -> key -> 'a option + (*@ o = find_opt t k + pure + ensures o = t.assoc k + ensures if t.assoc k = Some v then t.frequency k = t.frequency old k + 1 *) + val mem : 'a t -> key -> bool + (*@ b = mem t k + pure + ensures b <-> t.assoc k <> None && t.frequency k = t.frequency old k + 1 *) + val replace : 'a t -> key -> 'a -> unit + (*@ replace t k v + modifies t + ensures t.assoc k = Some v + t.assoc old k <> None -> t.frequency k = t.frequency old k + 1 + t.size < t.cap -> t.assoc old k = None -> + forall k'. t.assoc old k' <> None -> t.assoc k' <> None *) + val remove : 'a t -> key -> unit + (*@ remove t k + modifies t + ensures t.assoc k = None *) end From b70a8957e3d14b47f59afc85783762a45a29f082 Mon Sep 17 00:00:00 2001 From: Lucccyo Date: Mon, 27 Jun 2022 11:01:52 +0200 Subject: [PATCH 82/82] correct lfu contracts, need to comment Format module use in Stats.mli --- src/lfu.mli | 26 ++++++++++++++------------ src/lru.mli | 4 ++-- src/stats.ml | 4 ++-- src/stats.mli | 3 ++- 4 files changed, 20 insertions(+), 17 deletions(-) diff --git a/src/lfu.mli b/src/lfu.mli index a468057..f8d20a6 100644 --- a/src/lfu.mli +++ b/src/lfu.mli @@ -6,15 +6,16 @@ module Make (K : sig val hash : t -> int end) : sig - type 'a t type key = K.t + type 'a t + (*@ ephemeral model cap : int mutable model assoc : key -> 'a option mutable model frequency : key -> int invariant cap > 0 - invariant forall k. assoc k <> None -> frequency > 0 *) + invariant forall k. assoc k <> None <-> frequency k > 0 *) val v : int -> 'a t (* t = v c @@ -35,36 +36,37 @@ end) : sig val size : 'a t -> int (*@ s = size t - pure *) + pure + ensures s <= t.cap *) val clear : 'a t -> unit (*@ clear t - modifies t *) + modifies t + ensures forall k. t.assoc k = None *) val find : 'a t -> key -> 'a (*@ v = find t k - ensures t.assoc k = Some v - raises Not_found -> t.assoc k = None - ensures if t.assoc k = Some v then t.frequency k = t.frequency old k + 1 *) + ensures t.assoc k = Some v -> t.frequency k = t.frequency (old k) + 1 + raises Not_found -> t.assoc k = None *) val find_opt : 'a t -> key -> 'a option (*@ o = find_opt t k pure ensures o = t.assoc k - ensures if t.assoc k = Some v then t.frequency k = t.frequency old k + 1 *) + ensures t.assoc k <> None -> t.frequency k = t.frequency (old k) + 1 *) val mem : 'a t -> key -> bool (*@ b = mem t k pure - ensures b <-> t.assoc k <> None && t.frequency k = t.frequency old k + 1 *) + ensures b <-> t.assoc k <> None && t.frequency k = t.frequency (old k) + 1 *) val replace : 'a t -> key -> 'a -> unit (*@ replace t k v modifies t ensures t.assoc k = Some v - t.assoc old k <> None -> t.frequency k = t.frequency old k + 1 - t.size < t.cap -> t.assoc old k = None -> - forall k'. t.assoc old k' <> None -> t.assoc k' <> None *) + ensures t.assoc (old k) <> None -> t.frequency k = t.frequency (old k) + 1 + ensures t.assoc (old k) = None -> + forall k', v'. t.assoc (old k') = Some v' -> t.assoc k' = Some v' && t.frequency k = 1 *) val remove : 'a t -> key -> unit (*@ remove t k diff --git a/src/lru.mli b/src/lru.mli index a295c39..4badaec 100644 --- a/src/lru.mli +++ b/src/lru.mli @@ -47,10 +47,10 @@ end) : sig raises Not_found -> t.assoc k = None *) val find_opt : 'a t -> key -> 'a option - (*@ o = find_opt t k ensures o = t.assoc k *) - val mem : 'a t -> key -> bool + + val mem : 'a t -> key -> bool (*@ b = mem t k ensures b = true <-> t.assoc k <> None *) diff --git a/src/stats.ml b/src/stats.ml index fd80969..4a94d11 100644 --- a/src/stats.ml +++ b/src/stats.ml @@ -32,7 +32,7 @@ let add new_size t = t.add <- t.add + 1; if t.max_size < new_size then t.max_size <- new_size -let pp ppf t = +(* let pp ppf t = Fmt.pf ppf {|miss : %d hit : %d @@ -42,4 +42,4 @@ let pp ppf t = remove : %d clear : %d maximal size : %d|} - t.miss t.hit t.add t.replace t.discard t.remove t.clear t.max_size + t.miss t.hit t.add t.replace t.discard t.remove t.clear t.max_size *) diff --git a/src/stats.mli b/src/stats.mli index d3ac3ad..8251a05 100644 --- a/src/stats.mli +++ b/src/stats.mli @@ -64,4 +64,5 @@ val add : int -> t -> unit ensures t.max_size >= old t.max_size *) -val pp : Format.formatter -> t -> unit +(* val pp : Format.formatter -> t -> unit *) +