├── .gitignore ├── .ocamlinit ├── CHANGES.md ├── LICENSE.md ├── README.md ├── dune-project ├── lru.opam ├── src ├── dune ├── lru.ml └── lru.mli └── test ├── adapt.ml ├── bench.ml ├── dune └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | 3 | tmp 4 | *~ 5 | \.\#* 6 | \#*# 7 | 8 | gmon.out 9 | rondom 10 | -------------------------------------------------------------------------------- /.ocamlinit: -------------------------------------------------------------------------------- 1 | #require "psq" 2 | #directory "_build/src" 3 | #load "lru.cma" 4 | #require "fmt" 5 | 6 | module I = struct 7 | type t = int 8 | let compare (a: int) b = compare a b 9 | let hash = Hashtbl.hash 10 | let equal = (=) 11 | let weight a = a 12 | end 13 | 14 | module F = Lru.F.Make (I) (I) 15 | module M = Lru.M.Make (I) (I) 16 | 17 | let r _ = Random.int 100 18 | 19 | let init f n = 20 | let rec go i = 21 | if i = n then [] else let x = f i in x :: go (i + 1) in 22 | go 0 23 | 24 | let ppf = F.pp_dump Fmt.int Fmt.int 25 | let ppm = M.pp_dump Fmt.int Fmt.int 26 | 27 | ;; 28 | 29 | #install_printer ppf;; 30 | #install_printer ppm;; 31 | 32 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v0.3.1 2022-10-25 2 | 3 | - Ocaml 5.0 compatible. Thanks to @samoht for the report. 4 | - tweak ordering implementation in `F.of_list` 5 | 6 | ## v0.3.0 2019-04-09 7 | 8 | Semantics cleanup. 9 | 10 | Breaking: 11 | 12 | - `find` drops `?promote` and never changes the ordering. 13 | - `add` drops `?trim` and never drops bindings. 14 | - `size` -> `weight` 15 | - `items` -> `size` 16 | - `unadd` -> `pop` 17 | - `F.S.fold` and `F.S.iter` iterate in LRU order. 18 | - `F.M.fold` and `F.M.iter` drop `?dir` and always iterate in LRU order. 19 | 20 | Other: 21 | 22 | - add `F.S.fold_k` and `F.S.iter_k` 23 | 24 | To fix client code: 25 | 26 | - replace `find ~promote:false` with `find`; 27 | - replace `find` and `find ~promote:true` with `find` and `promote`; 28 | - replace `add ~trim:false` with `add`; 29 | - replace `add` and `add ~trim:true` with `add` and `trim`; 30 | - `s/size/weight/g`, `s/items/size/g`, `s/unadd/pop/g`; 31 | - audit uses of `fold` and `iter` for order-sensitivity. 32 | 33 | ## v0.2.0 2017-03-31 34 | 35 | Breaking changes: 36 | 37 | - `resize` no longer drops bindings if the new size pushes the queue over capacity. 38 | - `of_list` has simpler semantics; dropped the `cap` parameter. 39 | 40 | Other changes: 41 | 42 | - Replace `Lru.M.cache` with more general `Lru.memo`. 43 | - Queues with 0 initial capacity are legal. 44 | - Add `trim` to shrink a queue to its capacity, as queues are no longer guaranteed to 45 | have size smaller than capacity. 46 | - `find` gets the `promote` parameter, allowing queries that do not change the order. 47 | - `add` gets the `trim` parameter, allowing insertions that do not drop old entries. 48 | 49 | ## v0.1.1 2016-11-28 50 | 51 | * Fix missing dep on `psq` in META. 52 | 53 | ## v0.1.0 2016-11-22 54 | 55 | First release. 56 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 David Kaloper Meršinjak 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # lru — Scalable LRU caches 2 | 3 | %%VERSION%% 4 | 5 | Lru provides weight-bounded finite maps that can remove the least-recently-used 6 | (LRU) bindings in order to maintain a weight constraint. 7 | 8 | Two implementations are provided: one is functional, the other imperative. 9 | 10 | lru is distributed under the ISC license. 11 | 12 | Homepage: https://github.com/pqwy/lru 13 | 14 | ## Documentation 15 | 16 | Interface, [online][doc]. 17 | 18 | [doc]: https://pqwy.github.io/lru/doc/lru/ 19 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.7) 2 | (name lru) 3 | (version %%VERSION_NUM%%) 4 | -------------------------------------------------------------------------------- /lru.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "David Kaloper Meršinjak " 3 | authors: ["David Kaloper Meršinjak "] 4 | homepage: "https://github.com/pqwy/lru" 5 | doc: "https://pqwy.github.io/lru/doc" 6 | license: "ISC" 7 | dev-repo: "git+https://github.com/pqwy/lru.git" 8 | bug-reports: "https://github.com/pqwy/lru/issues" 9 | synopsis: "Scalable LRU caches" 10 | build: [ [ "dune" "subst" ] {pinned} 11 | [ "dune" "build" "-p" name "-j" jobs ] 12 | [ "dune" "runtest" "-p" name ] {with-test & ocaml:version >= "4.07.0"} ] 13 | depends: [ 14 | "ocaml" {>="4.03.0"} 15 | "dune" {build & >= "1.7"} 16 | "psq" {>="0.2.0"} 17 | "qcheck-core" {with-test} 18 | "qcheck-alcotest" {with-test} 19 | "alcotest" {with-test} 20 | ] 21 | description: """ 22 | Lru provides weight-bounded finite maps that can remove the least-recently-used 23 | (LRU) bindings in order to maintain a weight constraint. 24 | """ 25 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name lru) 3 | (synopsis "Scalable LRU caches") 4 | (libraries psq) 5 | (wrapped false)) 6 | 7 | -------------------------------------------------------------------------------- /src/lru.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2015-2016 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | module type Weighted = sig type t val weight : t -> int end 5 | 6 | let invalid_arg fmt = Format.ksprintf invalid_arg fmt 7 | 8 | type 'a fmt = Format.formatter -> 'a -> unit 9 | 10 | let pf = Format.fprintf 11 | 12 | let pp_iter ?(sep = Format.pp_print_space) pp ppf i = 13 | let first = ref true in 14 | i @@ fun x -> 15 | (match !first with true -> first := false | _ -> sep ppf ()); 16 | pp ppf x 17 | 18 | let cap_makes_sense ~m ~f cap = 19 | if cap < 0 then invalid_arg "Lru.%s.%s: ~cap:%d" m f cap 20 | 21 | module F = struct 22 | 23 | module type S = sig 24 | type t 25 | type k 26 | type v 27 | val empty : int -> t 28 | val is_empty : t -> bool 29 | val size : t -> int 30 | val weight : t -> int 31 | val capacity : t -> int 32 | val resize : int -> t -> t 33 | val trim : t -> t 34 | val mem : k -> t -> bool 35 | val find : k -> t -> v option 36 | val promote : k -> t -> t 37 | val add : k -> v -> t -> t 38 | val remove : k -> t -> t 39 | val pop : k -> t -> (v * t) option 40 | val lru : t -> (k * v) option 41 | val drop_lru : t -> t 42 | val pop_lru : t -> ((k * v) * t) option 43 | val fold : (k -> v -> 'a -> 'a) -> 'a -> t -> 'a 44 | val fold_k : (k -> v -> 'a -> 'a) -> 'a -> t -> 'a 45 | val iter : (k -> v -> unit) -> t -> unit 46 | val iter_k : (k -> v -> unit) -> t -> unit 47 | val of_list : (k * v) list -> t 48 | val to_list : t -> (k * v) list 49 | val pp : ?pp_size:(int * int) fmt -> ?sep:unit fmt -> (k * v) fmt -> t fmt 50 | val pp_dump : k fmt -> v fmt -> t fmt 51 | end 52 | 53 | module Make (K: Map.OrderedType) (V: Weighted) = struct 54 | 55 | module Q = Psq.Make (K) (struct 56 | type t = int * V.t 57 | let compare (g1, _) (g2, _) = compare (g1: int) g2 58 | end) 59 | 60 | type k = K.t 61 | type v = V.t 62 | 63 | type t = { cap: int; w: int; gen: int; q: Q.t } 64 | 65 | let g0 = min_int 66 | 67 | let is_empty t = Q.is_empty t.q 68 | let size t = Q.size t.q 69 | let weight t = t.w 70 | let capacity t = t.cap 71 | 72 | let cap_makes_sense = cap_makes_sense ~m:"F" 73 | 74 | let empty cap = 75 | cap_makes_sense ~f:"empty" cap; { cap; w = 0; gen = g0; q = Q.empty } 76 | 77 | let resize cap t = cap_makes_sense ~f:"resize" cap; { t with cap } 78 | 79 | let mem k t = Q.mem k t.q 80 | 81 | let find k t = match Q.find k t.q with Some (_, v) -> Some v | _ -> None 82 | 83 | let trim t = 84 | let rec go t w q = 85 | if w > t.cap then match Q.pop q with 86 | Some ((_, (_, v)), q) -> go t (w - V.weight v) q 87 | | None -> assert false 88 | else { t with w; q } in 89 | if t.w > t.cap then go t t.w t.q else t 90 | 91 | let promote k ({ gen; _ } as t) = 92 | if gen = max_int then empty t.cap else 93 | { t with gen = gen + 1; q = Q.adjust k (fun (_, v) -> gen, v) t.q } 94 | 95 | let rec add k v ({ gen; _ } as t) = 96 | if gen = max_int then add k v (empty t.cap) else 97 | let p = Some (gen, v) and p0 = ref None in 98 | let q = Q.update k (fun x -> p0 := x; p) t.q in 99 | let w = t.w + V.weight v - 100 | (match !p0 with Some (_, v0) -> V.weight v0 | _ -> 0) in 101 | { t with gen = gen + 1; w; q } 102 | 103 | let remove k t = match Q.find k t.q with 104 | None -> t 105 | | Some (_, v) -> { t with w = t.w - V.weight v; q = Q.remove k t.q } 106 | 107 | let pop k t = match Q.find k t.q with 108 | None -> None 109 | | Some (_, v) -> 110 | Some (v, { t with w = t.w - V.weight v; q = Q.remove k t.q }) 111 | 112 | let lru t = match Q.min t.q with Some (k, (_, v)) -> Some (k, v) | _ -> None 113 | 114 | let pop_lru t = match Q.pop t.q with 115 | None -> None 116 | | Some ((k, (_, v)), q) -> 117 | Some ((k, v), { t with w = t.w - V.weight v; q }) 118 | 119 | let drop_lru t = match Q.pop t.q with 120 | None -> t 121 | | Some ((_, (_, v)), q) -> { t with w = t.w - V.weight v; q } 122 | 123 | let sort_uniq_r xs = 124 | let rec sieve k0 kv0 = function 125 | | [] -> [kv0] 126 | | (k, _ as kv)::kvs when K.compare k0 k = 0 -> sieve k kv kvs 127 | | (k, _ as kv)::kvs -> kv0 :: sieve k kv kvs in 128 | let cmp (k1, (g1, _)) (k2, (g2, _)) = 129 | match K.compare k1 k2 with 0 -> compare (g1: int) g2 | r -> r 130 | in 131 | match List.sort cmp xs with [] -> [] | (k, _ as kv)::kvs -> sieve k kv kvs 132 | 133 | let of_list xs = 134 | let rec annotate g acc = function 135 | | (k, v)::kvs -> annotate (succ g) ((k, (g, v))::acc) kvs 136 | | [] -> g, sort_uniq_r acc in 137 | let gen, kgvs = annotate g0 [] xs in 138 | let q = Q.of_sorted_list kgvs in 139 | let w = Q.fold (fun _ (_, v) w -> w + V.weight v) 0 q in 140 | { cap = w; w; gen; q } 141 | 142 | let fold f z t = 143 | List.fold_right (fun (k, (_, v)) acc -> f k v acc) 144 | (Q.to_priority_list t.q) z 145 | let iter f t = 146 | Q.to_priority_list t.q |> List.iter (fun (k, (_, v)) -> f k v) 147 | let to_list t = fold (fun k v kvs -> (k, v) :: kvs) [] t 148 | 149 | let fold_k f z t = Q.fold (fun k (_, v) -> f k v) z t.q 150 | let iter_k f t = Q.iter (fun k (_, v) -> f k v) t.q 151 | 152 | let pp ?(pp_size = fun _ -> ignore) ?sep pp ppf t = 153 | let ppx ppf (k, (_, v)) = pp ppf (k, v) in 154 | pf ppf "@[%a@[%a@]@]" pp_size (t.w, t.cap) 155 | (pp_iter ?sep ppx) (fun f -> List.iter f (Q.to_priority_list t.q)) 156 | 157 | let pp_dump ppk ppv ppf = 158 | let sep ppf () = pf ppf ";@ " 159 | and ppkv ppf (k, v) = pf ppf "(@[%a,@ %a@])" ppk k ppv v in 160 | pf ppf "of_list [%a]" (pp ~sep ppkv) 161 | end 162 | 163 | end 164 | 165 | module M = struct 166 | 167 | module Q = struct 168 | 169 | type 'a node = { 170 | value : 'a; 171 | mutable next : 'a node option; 172 | mutable prev : 'a node option 173 | } 174 | 175 | type 'a t = { 176 | mutable first : 'a node option; 177 | mutable last : 'a node option 178 | } 179 | 180 | let detach t n = 181 | let np = n.prev and nn = n.next in 182 | ( match np with 183 | | None -> t.first <- nn 184 | | Some x -> x.next <- nn; n.prev <- None ); 185 | ( match nn with 186 | | None -> t.last <- np 187 | | Some x -> x.prev <- np; n.next <- None ) 188 | 189 | let append t n = 190 | let on = Some n in 191 | match t.last with 192 | | Some x as l -> x.next <- on; t.last <- on; n.prev <- l 193 | | None -> t.first <- on; t.last <- on 194 | 195 | let node x = { value = x; prev = None; next = None } 196 | 197 | let create () = { first = None; last = None } 198 | 199 | let iter f t = 200 | let rec go f = function Some n -> f n.value; go f n.next | _ -> () in 201 | go f t.first 202 | 203 | let fold f t z = 204 | let rec go f z = function Some n -> go f (f n.value z) n.prev | _ -> z in 205 | go f z t.last 206 | end 207 | 208 | module type S = sig 209 | type t 210 | type k 211 | type v 212 | val create : ?random:bool -> int -> t 213 | val is_empty : t -> bool 214 | val size : t -> int 215 | val weight : t -> int 216 | val capacity : t -> int 217 | val resize : int -> t -> unit 218 | val trim : t -> unit 219 | val mem : k -> t -> bool 220 | val find : k -> t -> v option 221 | val promote : k -> t -> unit 222 | val add : k -> v -> t -> unit 223 | val remove : k -> t -> unit 224 | val lru : t -> (k * v) option 225 | val drop_lru : t -> unit 226 | val fold : (k -> v -> 'a -> 'a) -> 'a -> t -> 'a 227 | val iter : (k -> v -> unit) -> t -> unit 228 | val of_list : (k * v) list -> t 229 | val to_list : t -> (k * v) list 230 | val pp : ?pp_size:(int * int) fmt -> ?sep:unit fmt -> (k * v) fmt -> t fmt 231 | val pp_dump : k fmt -> v fmt -> t fmt 232 | end 233 | 234 | module Bake (HT: Hashtbl.SeededS) (V: Weighted) = struct 235 | 236 | type k = HT.key 237 | type v = V.t 238 | 239 | type t = { 240 | ht : (k * v) Q.node HT.t; 241 | q : (k * v) Q.t; 242 | mutable cap : int; 243 | mutable w : int; 244 | } 245 | 246 | let size t = HT.length t.ht 247 | let weight t = t.w 248 | let capacity t = t.cap 249 | let is_empty t = HT.length t.ht = 0 250 | 251 | let cap_makes_sense = cap_makes_sense ~m:"M" 252 | 253 | let create ?random cap = 254 | cap_makes_sense ~f:"create" cap; 255 | { cap; w = 0; ht = HT.create ?random cap; q = Q.create () } 256 | 257 | let lru t = match t.q.Q.first with Some n -> Some n.Q.value | _ -> None 258 | 259 | let drop_lru t = match t.q.Q.first with 260 | None -> () 261 | | Some ({ Q.value = (k, v); _ } as n) -> 262 | t.w <- t.w - V.weight v; 263 | HT.remove t.ht k; 264 | Q.detach t.q n 265 | 266 | let rec trim t = if weight t > t.cap then (drop_lru t; trim t) 267 | 268 | let resize cap t = cap_makes_sense ~f:"resize" cap; t.cap <- cap 269 | 270 | let remove k t = 271 | try 272 | let n = HT.find t.ht k in 273 | t.w <- t.w - (snd n.Q.value |> V.weight); 274 | HT.remove t.ht k; Q.detach t.q n 275 | with Not_found -> () 276 | 277 | let add k v t = 278 | remove k t; 279 | let n = Q.node (k, v) in 280 | t.w <- t.w + V.weight v; 281 | HT.add t.ht k n; Q.append t.q n 282 | 283 | let promote k t = 284 | try 285 | let n = HT.find t.ht k in Q.( detach t.q n; append t.q n ) 286 | with Not_found -> () 287 | 288 | let find k t = 289 | try Some (snd (HT.find t.ht k).Q.value) with Not_found -> None 290 | 291 | let mem k t = HT.mem t.ht k 292 | 293 | let iter f t = Q.iter (fun (k, v) -> f k v) t.q 294 | let fold f z t = Q.fold (fun (k, v) a -> f k v a) t.q z 295 | let to_list t = Q.fold (fun x xs -> x::xs) t.q [] 296 | 297 | let of_list xs = 298 | let t = create 0 in 299 | List.iter (fun (k, v) -> add k v t) xs; 300 | resize (Q.fold (fun (_, v) w -> w + V.weight v) t.q 0) t; 301 | t 302 | 303 | let pp ?(pp_size = fun _ -> ignore) ?sep pp ppf t = 304 | pf ppf "@[%a@[%a@]@]" pp_size (t.w, t.cap) 305 | (pp_iter ?sep pp) (fun f -> Q.iter f t.q) 306 | 307 | let pp_dump ppk ppv ppf = 308 | let sep ppf () = pf ppf ";@ " 309 | and ppkv ppf (k, v) = pf ppf "(@[%a,@ %a@])" ppk k ppv v in 310 | pf ppf "of_list [%a]" (pp ~sep ppkv) 311 | end 312 | 313 | module Make (K: Hashtbl.HashedType) (V: Weighted) = 314 | Bake (Hashtbl.MakeSeeded (struct 315 | include K 316 | let hash _ = hash 317 | let seeded_hash = hash [@@ocaml.warning "-32"] 318 | end)) (V) 319 | 320 | module MakeSeeded (K : Hashtbl.SeededHashedType) (V: Weighted) = 321 | Bake (Hashtbl.MakeSeeded (K)) (V) 322 | 323 | end 324 | 325 | let memo (type k) (type v) 326 | ?(hashed=(Hashtbl.hash, (=))) ?(weight = fun _ -> 1) ~cap f = 327 | let module C = 328 | M.Make (struct type t = k let hash = fst hashed let equal = snd hashed end) 329 | (struct type t = v let weight = weight end) in 330 | let c = C.create cap in 331 | let rec g k = match C.find k c with 332 | None -> let v = f g k in C.add k v c; v 333 | | Some v -> C.promote k c; v in 334 | g 335 | -------------------------------------------------------------------------------- /src/lru.mli: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | (** Scalable LRU caches 5 | 6 | [Lru] provides weight-bounded finite maps that can remove the 7 | least-recently-used (LRU) bindings in order to maintain a weight constraint. 8 | Two implementations are provided: one is {{!F}functional}, the other 9 | {{!M}imperative}. 10 | 11 | The {{!F}functional} map is backed by a 12 | {{:https://github.com/pqwy/psq}priority search queue}. Operations on 13 | individual elements are [O(log n)]. 14 | 15 | The {{!M}mutable} map is backed by the standard {!Hashtbl} paired with a 16 | doubly-linked list. Operations on individual elements incur an [O(1)] 17 | overhead on top of hash table access. 18 | 19 | Both versions support {{!Weighted}differentially weighted} bindings, and 20 | have a capacity parameter that limits the combined weight of the bindings. 21 | To limit the maps by the number of bindings, use [let weight _ = 1]. 22 | 23 | {e %%VERSION%% — {{:%%PKG_HOMEPAGE%% }homepage}} *) 24 | 25 | (** {1:sem Semantics} 26 | 27 | A pretty accurate model of a {{!F.S}functional} [k -> v] map is an 28 | association list ([(k * v) list]) with unique keys. 29 | 30 | {{!F.S.add}Adding} a bindings [k -> v] to [kvs] means 31 | [List.remove_assoc k kvs @ [(k, v)]], {{!F.S.find}finding} a [k] means 32 | [List.assoc_opt k kvs], and removing it means [List.remove_assoc k kvs]. 33 | 34 | The {{!F.S.lru}LRU binding} is then the first element of the list. 35 | 36 | {{!F.S.promote}Promoting} a binding [k -> v] means removing, and then 37 | re-adding it. 38 | 39 | {{!F.S.trim}Trimming} [kvs] means retaining the longest suffix with the sum 40 | of [weight v] not larger than {{!F.S.capacity}capacity}. 41 | 42 | The {{!M.S}imperative} LRU map is like the above, but kept in a reference 43 | cell. *) 44 | 45 | (** {1 Lru} *) 46 | 47 | (** Signature of types with measurable weight. *) 48 | module type Weighted = sig 49 | type t 50 | val weight : t -> int 51 | (** [weight t] is a measure of [t]s contribution towards the total map 52 | capacity. Weight must be strictly positive. *) 53 | end 54 | 55 | (** Functional LRU map. *) 56 | module F : sig 57 | 58 | (** Signature of functional LRU maps. *) 59 | module type S = sig 60 | 61 | (** {1 Functional LRU map} *) 62 | 63 | type t 64 | (** A map. *) 65 | 66 | type k 67 | (** Keys in {{!t}[t]}. *) 68 | 69 | type v 70 | (** Values in {{!t}[t]}. *) 71 | 72 | val empty : int -> t 73 | (** [empty cap] is an empty map with capacity [cap]. 74 | 75 | @raise Invalid_argument when [cap < 0]. *) 76 | 77 | val is_empty : t -> bool 78 | (** [is_empty t] is [true] iff there are no bindings in [t]. *) 79 | 80 | val size : t -> int 81 | (** [size t] is the number of bindings in [t]. *) 82 | 83 | (** {1 Limiting the weight of bindings} *) 84 | 85 | val weight : t -> int 86 | (** [weight t] is the combined weight of bindings in [t]. *) 87 | 88 | val capacity : t -> int 89 | (** [capacity t] is the maximum combined weight of bindings that {!trim} 90 | will retain. *) 91 | 92 | val resize : int -> t -> t 93 | (** [resize cap t] sets [t]'s capacity to [cap], while leaving the bindings 94 | unchanged. 95 | 96 | @raise Invalid_argument when [cap < 0]. *) 97 | 98 | val trim : t -> t 99 | (** [trim t] is [t'], where [weight t' <= capacity t']. 100 | 101 | This is achieved by discarding bindings in LRU-to-MRU order. *) 102 | 103 | (** {1 Access by [k]} *) 104 | 105 | val mem : k -> t -> bool 106 | (** [mem k t] is [true] iff [k] is bound in [t]. *) 107 | 108 | val find : k -> t -> v option 109 | (** [find k t] is [Some v] when [k -> v] is bound in [t], or [None] 110 | otherwise. *) 111 | 112 | val promote : k -> t -> t 113 | (** [promote k t] is [t] with the binding for [k] promoted to 114 | most-recently-used, or [t] if [k] is not bound in [t]. *) 115 | 116 | val add : k -> v -> t -> t 117 | (** [add k v t] adds the binding [k -> v] to [t] as the most-recently-used 118 | binding. 119 | 120 | {b Note} [add] does not remove bindings. To ensure that the resulting 121 | map is not over capacity, compose with {{!trim}[trim]}. *) 122 | 123 | val remove : k -> t -> t 124 | (** [remove k t] is [t] without a binding for [k]. *) 125 | 126 | val pop : k -> t -> (v * t) option 127 | (** [pop k t] is [(v, t')], where [v] is the value bound to [k], and [t'] 128 | is [t] without the binding [k -> t], or [None] if [k] is not bound in 129 | [t]. *) 130 | 131 | (** {1 Access to least-recently-used bindings} *) 132 | 133 | val lru : t -> (k * v) option 134 | (** [lru t] is the least-recently-used binding in [t], or [None], when [t] 135 | is empty. *) 136 | 137 | val drop_lru : t -> t 138 | (** [drop_lru t] is [t] without the binding [lru t], or [t], when [t] is 139 | empty. *) 140 | 141 | val pop_lru : t -> ((k * v) * t) option 142 | (** [pop_lru t] is [((k, v), t'], where [(k, v)] is [lru t], and [t'] is [t] 143 | without that binding. *) 144 | 145 | (** {1 Aggregate access} *) 146 | 147 | val fold : (k -> v -> 'a -> 'a) -> 'a -> t -> 'a 148 | (** [fold f z t] is [f k0 v0 (... (f kn vn z))], where [k0 -> v0] is LRU and 149 | [kn -> vn] is MRU. *) 150 | 151 | val fold_k : (k -> v -> 'a -> 'a) -> 'a -> t -> 'a 152 | (** [fold_k f z t] folds in key-increasing order, ignoring the recently-used 153 | ordering. 154 | 155 | {b Note} [fold_k] is faster than [fold]. *) 156 | 157 | val iter : (k -> v -> unit) -> t -> unit 158 | (** [iter f t] applies [f] to all the bindings in [t] in in LRU-to-MRU 159 | order. *) 160 | 161 | val iter_k : (k -> v -> unit) -> t -> unit 162 | (** [iter_k f t] applies f in key-increasing order, ignoring the 163 | recently-used ordering. 164 | 165 | {b Note} [iter_k] is faster than [iter]. *) 166 | 167 | (** {1 Conversions} *) 168 | 169 | val of_list : (k * v) list -> t 170 | (** [of_list kvs] is a map with bindings [kvs], where the order of the list 171 | becomes LRU-to-MRU ordering, and its {{!capacity}[capacity]} is set to 172 | its {{!weight}[weight]}. 173 | 174 | The resulting [t] has the same shape as if the bindings were 175 | sequentially {{!add}added} in list order, except for capacity. *) 176 | 177 | val to_list : t -> (k * v) list 178 | (** [to_list t] are the bindings in [t] in LRU-to-MRU order. *) 179 | 180 | open Format 181 | 182 | (** {1 Pretty-printing} *) 183 | 184 | val pp : ?pp_size:(formatter -> (int * int) -> unit) -> 185 | ?sep:(formatter -> unit -> unit) -> 186 | (formatter -> k * v -> unit) -> formatter -> t -> unit 187 | (** [pp ~pp_size ~sep pp_kv ppf t] pretty-prints [t] to [ppf], using [pp_kv] 188 | to print the bindings, [~sep] to separate them, and [~pp_size] to print 189 | the {{!weight}[weight]} and {{!capacity}[capacity]}. [~sep] and 190 | [~pp_size] default to unspecified printers. *) 191 | 192 | (**/**) 193 | val pp_dump : (formatter -> k -> unit) -> (formatter -> v -> unit) 194 | -> formatter -> t -> unit 195 | (**/**) 196 | end 197 | 198 | (** [Make(K)(V)] is the {{!S}LRU map} with bindings [K.t -> V.t]. The weight 199 | of an individual binding is the {!Weighted.weight} of [V.t]. *) 200 | module Make (K: Map.OrderedType) (V: Weighted): 201 | S with type k = K.t and type v = V.t 202 | end 203 | 204 | 205 | (** Mutable LRU map. *) 206 | module M : sig 207 | 208 | (** Signature of mutable LRU maps. *) 209 | module type S = sig 210 | 211 | (** {1 Mutable LRU map} *) 212 | 213 | type t 214 | (** A map. *) 215 | 216 | type k 217 | (** Keys in {{!t}[t]}. *) 218 | 219 | type v 220 | (** Values in {{!t}[t]}. *) 221 | 222 | val create : ?random:bool -> int -> t 223 | (** [create ?random cap] is a new map with capacity [cap]. 224 | 225 | [~random] randomizes the underlying hash table. It defaults to [false]. 226 | See {!Hashtbl.create}. 227 | 228 | {b Note.} The internal hash table is created with size [cap]. 229 | 230 | @raise Invalid_argument when [cap < 0]. *) 231 | 232 | val is_empty : t -> bool 233 | (** [is_empty t] is [true] iff there are no bindings in [t]. *) 234 | 235 | val size : t -> int 236 | (** [size t] is the number of bindings in [t]. *) 237 | 238 | (** {1 Limiting the weight of bindings} *) 239 | 240 | val weight : t -> int 241 | (** [weight t] is the combined weight of bindings in [t]. *) 242 | 243 | val capacity : t -> int 244 | (** [capacity t] is the maximum combined weight of bindings that {!trim} 245 | will retain. *) 246 | 247 | val resize : int -> t -> unit 248 | (** [resize cap t] sets [t]'s capacity to [cap], while leaving the bindings 249 | unchanged. 250 | 251 | @raise Invalid_argument when [cap < 0]. *) 252 | 253 | val trim : t -> unit 254 | (** [trim t] ensures that [weight t <= capacity t] by dropping bindings in 255 | LRU-to-MRU order. *) 256 | 257 | (** {1 Access by [k]} *) 258 | 259 | val mem : k -> t -> bool 260 | (** [mem k t] is [true] iff [k] is bound in [t]. *) 261 | 262 | val find : k -> t -> v option 263 | (** [find k t] is [Some v] when [k -> v] is bound in [t], or [None] 264 | otherwise. 265 | 266 | {b Note} This operation does not change the recently-used order. *) 267 | 268 | val promote : k -> t -> unit 269 | (** [promote k t] promotes the binding for [k], if it exists, to 270 | most-recently-used. *) 271 | 272 | val add : k -> v -> t -> unit 273 | (** [add k v t] adds the binding [k -> v] to [t] as the most-recently-used 274 | binding. 275 | 276 | {b Note} [add] does not remove bindings. To ensure that the resulting 277 | map is not over capacity, combine with {{!trim}[trim]}. *) 278 | 279 | val remove : k -> t -> unit 280 | (** [remove k t] is [t] without a binding for [k]. *) 281 | 282 | (** {1 Access to least-recently-used bindings} *) 283 | 284 | val lru : t -> (k * v) option 285 | (** [lru t] is the least-recently-used binding in [t], or [None], when [t] 286 | is empty. *) 287 | 288 | val drop_lru : t -> unit 289 | (** [drop_lru t] removes the binding [lru t]. *) 290 | 291 | (** {1 Aggregate access} *) 292 | 293 | val fold : (k -> v -> 'a -> 'a) -> 'a -> t -> 'a 294 | (** [fold f z t] is [f k0 v0 (... (f kn vn z))], where [k0 -> v0] is LRU and 295 | [kn -> vn] is MRU. *) 296 | 297 | val iter : (k -> v -> unit) -> t -> unit 298 | (** [iter f t] applies [f] to all the bindings in [t] in in LRU-to-MRU 299 | order. *) 300 | 301 | (** {1 Conversions} *) 302 | 303 | val of_list : (k * v) list -> t 304 | (** [of_list kvs] is a map with bindings [kvs], where the order of the list 305 | becomes LRU-to-MRU ordering, and its {{!capacity}[capacity]} is set to 306 | its {{!weight}[weight]}. 307 | 308 | The resulting [t] has the same shape as if the bindings were 309 | sequentially {{!add}added} in list order, except for capacity. *) 310 | 311 | val to_list : t -> (k * v) list 312 | (** [to_list t] are the bindings in [t] in LRU-to-MRU order. *) 313 | 314 | open Format 315 | 316 | (** {1 Pretty-printing} *) 317 | 318 | val pp : ?pp_size:(formatter -> int * int -> unit) -> 319 | ?sep:(formatter -> unit -> unit) -> 320 | (formatter -> k * v -> unit) -> formatter -> t -> unit 321 | (** [pp ~pp_size ~sep pp_kv ppf t] pretty-prints [t] to [ppf], using [pp_kv] 322 | to print the bindings, [~sep] to separate them, and [~pp_size] to print 323 | the {{!weight}[weight]} and {{!capacity}[capacity]}. [~sep] and 324 | [~pp_size] default to unspecified printers. *) 325 | 326 | (**/**) 327 | val pp_dump : (formatter -> k -> unit) -> (formatter -> v -> unit) 328 | -> formatter -> t -> unit 329 | (**/**) 330 | end 331 | 332 | (** [Make(K)(V)] is the {{!S}LRU map} with bindings [K.t -> V.t]. The weight 333 | of an individual binding is the {!Weighted.weight} of [V.t]. *) 334 | module Make (K: Hashtbl.HashedType) (V: Weighted): 335 | S with type k = K.t and type v = V.t 336 | 337 | (** [MakeSeeded(K)(V)] is a variant backed by {!Hashtbl.SeededS}. *) 338 | module MakeSeeded (K: Hashtbl.SeededHashedType) (V: Weighted): 339 | S with type k = K.t and type v = V.t 340 | 341 | end 342 | 343 | (** {1 One-off memoization} *) 344 | 345 | val memo : ?hashed:(('a -> int) * ('a -> 'a -> bool)) -> ?weight:('b -> int) -> 346 | cap:int -> (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b 347 | (** [memo ?hashed ?weight ~cap f] is a new memoized instance of [f], using LRU 348 | caching. [f] is an open recursive function of one parameter. 349 | 350 | [~hashed] are hashing and equality over the arguments ['a]. It defaults to 351 | [(Hashtbl.hash, Pervasives.(=))]. 352 | 353 | [~weight] is the weighting function over the results ['b]. It defaults to 354 | [fun _ -> 1]. 355 | 356 | [~cap] is the total cache capacity. 357 | 358 | @raise Invalid_argument when [cap < 0]. *) 359 | -------------------------------------------------------------------------------- /test/adapt.ml: -------------------------------------------------------------------------------- 1 | module M_as_F (K: Hashtbl.HashedType) (V: Lru.Weighted): 2 | Lru.F.S with type k = K.t and type v = V.t = 3 | struct 4 | 5 | let nope name _ = 6 | invalid_arg @@ Format.sprintf "M_as_F.%s: not implemented" name 7 | 8 | include Lru.M.Make (K) (V) 9 | 10 | let unadd = nope "unadd" 11 | let pop_lru = nope "pop_lru" 12 | 13 | let empty n = create n 14 | 15 | let find ?promote k t = 16 | match find ?promote k t with Some v -> Some (v, t) | _ -> None 17 | 18 | let retaining f t = f t; t 19 | 20 | let trim = retaining trim 21 | let resize cap = retaining @@ resize cap 22 | let add ?trim k v = retaining @@ add ?trim k v 23 | let remove k = retaining @@ remove k 24 | let drop_lru = retaining drop_lru 25 | 26 | let fold f s t = fold f s t 27 | let iter f t = iter f t 28 | let to_list t = to_list t 29 | end 30 | -------------------------------------------------------------------------------- /test/bench.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | module I = struct 5 | type t = int 6 | let compare (a: int) b = compare a b 7 | let equal (a: int) b = a = b 8 | let hash (i: int) = Hashtbl.hash i 9 | let weight _ = 1 10 | end 11 | module F = Lru.F.Make (I) (I) 12 | module M = Lru.M.Make (I) (I) 13 | 14 | module type S = sig 15 | type t 16 | val mk : int list -> t 17 | val q : int -> t -> int option 18 | val a : int -> int -> t -> unit 19 | val r : int -> t -> unit 20 | end 21 | 22 | let r_int () = Random.int 2_000_000 23 | let double xs = List.map (fun x -> (x, x)) xs 24 | let randoms n = List.init n (fun _ -> r_int ()) 25 | 26 | open Unmark 27 | 28 | let suite ms n = 29 | let rs = randoms n in 30 | (* let rs1 = randoms n in *) 31 | group (string_of_int n) [ 32 | (* group "mk" (ms |> List.map @@ fun (name, (module M: S)) -> *) 33 | (* bench name (fun () -> M.mk rs)); *) 34 | group "find" (ms |> List.map @@ fun (name, (module M: S)) -> 35 | let t = M.mk rs in 36 | let x = r_int () in 37 | bench name (fun () -> M.q x t)) 38 | (* bench name (fun () -> rs |> List.iter (fun x -> M.q x t |> ignore))) *) 39 | ; group "add" (ms |> List.map @@ fun (name, (module M: S)) -> 40 | let t = M.mk rs in 41 | let x = r_int () in 42 | bench name (fun () -> M.a x x t)) 43 | (* bench name (fun () -> *) 44 | (* let t = M.mk rs in rs1 |> List.iter (fun x -> M.a x x t))) *) 45 | ; group "remove" (ms |> List.map @@ fun (name, (module M: S)) -> 46 | let t = M.mk rs in 47 | let x = r_int () in 48 | bench name (fun () -> M.r x t)); 49 | (* bench name (fun () -> *) 50 | (* let t = M.mk rs in rs1 |> List.iter (fun x -> M.r x t))); *) 51 | ] 52 | 53 | let impls = [ 54 | "fun", (module struct 55 | type t = F.t ref 56 | let mk xs = ref (F.of_list (double xs)) 57 | let q k q = F.find k !q 58 | let a k v q = q := F.add k v !q 59 | let r k q = q := F.remove k !q 60 | end: S) 61 | ; "imp", 62 | (module struct 63 | type t = M.t 64 | let mk xs = M.of_list (double xs) 65 | let q k q = M.find k q 66 | let a = M.add 67 | let r = M.remove 68 | end: S) 69 | ; "ht", 70 | (module struct 71 | type t = (int, int) Hashtbl.t 72 | let mk xs = 73 | let h = Hashtbl.create 20 in 74 | xs |> List.iter (fun x -> Hashtbl.replace h x x); 75 | h 76 | let q k m = Hashtbl.find_opt m k 77 | let a k v m = Hashtbl.replace m k v 78 | let r k m = Hashtbl.remove m k 79 | end: S) 80 | ] 81 | 82 | let arg = Cmdliner.Arg.( 83 | value @@ opt (list int) [10; 100; 1000] @@ info ["sizes"]) 84 | let _ = Unmark_cli.main_ext "lru" ~arg @@ List.map (suite impls) 85 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (test 2 | (name test) 3 | (modules test adapt) 4 | (libraries lru alcotest qcheck-core qcheck-alcotest)) 5 | 6 | (executable 7 | (name bench) 8 | (modules bench) 9 | (libraries lru unmark unmark.cli cmdliner)) 10 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (* Copyright (c) 2016 David Kaloper Meršinjak. All rights reserved. 2 | See LICENSE.md *) 3 | 4 | let id x = x 5 | let (%) f g x = f (g x) 6 | 7 | module I = struct 8 | type t = int 9 | let compare (a: int) b = compare a b 10 | let equal (a: int) b = a = b 11 | let hash (i: int) = Hashtbl.hash i 12 | let weight _ = 1 13 | end 14 | 15 | let sort_uniq_r (type a) cmp xs = 16 | let module S = Set.Make (struct type t = a let compare = cmp end) in 17 | List.fold_right S.add xs S.empty |> S.elements 18 | let uniq_r (type a) cmp xs = 19 | let module S = Set.Make (struct type t = a let compare = cmp end) in 20 | let rec go s acc = function 21 | [] -> acc 22 | | x::xs -> if S.mem x s then go s acc xs else go (S.add x s) (x :: acc) xs in 23 | go S.empty [] (List.rev xs) 24 | let list_of_iter_2 i = 25 | let xs = ref [] in i (fun a b -> xs := (a, b) :: !xs); List.rev !xs 26 | 27 | let list_trim w xs = 28 | let rec go wacc acc = function 29 | [] -> acc 30 | | kv::xs -> let w' = I.weight (snd kv) + wacc in 31 | if w' <= w then go w' (kv::acc) xs else acc in 32 | go 0 [] (List.rev xs) 33 | let list_weight = List.fold_left (fun a (_, v) -> a + I.weight v) 0 34 | 35 | let cmpi (a: int) b = compare a b 36 | let cmp_k (k1, _) (k2, _) = cmpi k1 k2 37 | let sorted_by_k xs = List.sort cmp_k xs 38 | 39 | let size = QCheck.Gen.(small_nat >|= fun x -> x mod 1_000) 40 | let bindings = QCheck.( 41 | make Gen.(list_size size (pair small_nat small_nat)) 42 | ~print:Fmt.(to_to_string Fmt.(Dump.(list (pair int int)))) 43 | ~shrink:Shrink.list) 44 | 45 | let test name gen p = 46 | QCheck.Test.make ~name gen p |> QCheck_alcotest.to_alcotest 47 | 48 | 49 | module F = Lru.F.Make (I) (I) 50 | let pp_f = Fmt.(F.pp_dump int int) 51 | let (!) f = `Sem F.(to_list f, size f, weight f) 52 | let sem xs = `Sem List.(xs, length xs, list_weight xs) 53 | let lru = QCheck.( 54 | map F.of_list bindings ~rev:F.to_list |> 55 | set_print Fmt.(to_to_string pp_f)) 56 | let lru_w_nat = QCheck.(pair lru small_nat) 57 | 58 | let () = Alcotest.run ~and_exit:false "Lru.F" [ 59 | 60 | "of_list", [ 61 | test "sem" bindings 62 | (fun xs -> !F.(of_list xs) = sem (uniq_r cmp_k xs)); 63 | test "cap" bindings 64 | (fun xs -> F.(capacity (of_list xs)) = list_weight (uniq_r cmp_k xs)); 65 | ]; 66 | 67 | "membership", [ 68 | test "find sem" lru_w_nat 69 | (fun (m, x) -> F.find x m = List.assoc_opt x (F.to_list m)); 70 | test "mem ==> find" lru_w_nat 71 | (fun (m, e) -> QCheck.assume (F.mem e m); F.find e m <> None); 72 | test "find ==> mem" lru_w_nat 73 | (fun (m, e) -> QCheck.assume (F.find e m <> None); F.mem e m); 74 | ]; 75 | 76 | "add", [ 77 | test "sem" lru_w_nat 78 | (fun (m, k) -> 79 | !(F.add k k m) = sem (List.remove_assoc k (F.to_list m) @ [k, k])); 80 | ]; 81 | 82 | "remove", [ 83 | test "sem" lru_w_nat 84 | (fun (m, k) -> !(F.remove k m) = sem (List.remove_assoc k (F.to_list m))); 85 | ]; 86 | 87 | "trim", [ 88 | test "sem" lru_w_nat 89 | (fun (m, x) -> 90 | !F.(resize x m |> trim) = sem (list_trim x (F.to_list m))); 91 | ]; 92 | 93 | "promote", [ 94 | test "sem" lru_w_nat 95 | (fun (m, x) -> 96 | !(F.promote x m) = 97 | !(match F.find x m with Some v -> F.add x v m | _ -> m)); 98 | ]; 99 | 100 | "lru", [ 101 | test "lru sem" lru 102 | (fun m -> 103 | QCheck.assume (F.size m > 0); 104 | F.lru m = Some (List.hd (F.to_list m))); 105 | test "drop_lru sem" lru 106 | (fun m -> 107 | QCheck.assume (F.size m > 0); 108 | F.(to_list (drop_lru m) = List.tl (F.to_list m))); 109 | ]; 110 | 111 | "conv", [ 112 | test "to_list inv" lru (fun m -> !F.(of_list (to_list m)) = !m); 113 | test "to_list = fold" lru 114 | (fun m -> F.to_list m = F.fold (fun k v a -> (k, v)::a) [] m); 115 | test "to_list = iter" lru 116 | (fun m -> list_of_iter_2 (fun f -> F.iter f m) = F.to_list m); 117 | test "fold_k sem" lru 118 | (fun m -> 119 | F.fold_k (fun k v a -> (k, v)::a) [] m = sorted_by_k (F.to_list m)); 120 | test "iter_k sem" lru 121 | (fun m -> 122 | list_of_iter_2 (fun f -> F.iter_k f m) = sorted_by_k (F.to_list m)); 123 | ] 124 | 125 | ] 126 | 127 | module M = Lru.M.Make (I) (I) 128 | let pp_m = Fmt.(M.pp_dump int int) 129 | let (!!) m = `Sem M.(to_list m, size m, weight m) 130 | let lru = QCheck.( 131 | map M.of_list bindings ~rev:M.to_list |> 132 | set_print Fmt.(to_to_string pp_m)) 133 | let lru_w_nat = QCheck.(pair lru small_nat) 134 | let lrus = QCheck.( 135 | map (fun xs -> M.of_list xs, F.of_list xs) ~rev:(F.to_list % snd) bindings 136 | |> set_print Fmt.(to_to_string pp_f % snd)) 137 | let lrus_w_nat = QCheck.(pair lrus small_nat) 138 | 139 | let () = Alcotest.run "Lru.M" [ 140 | 141 | "of_list", [ 142 | test "sem" bindings 143 | (fun xs -> !!M.(of_list xs) = sem (uniq_r cmp_k xs)); 144 | test "cap" bindings 145 | (fun xs -> M.(capacity (of_list xs)) = list_weight (uniq_r cmp_k xs)); 146 | ]; 147 | 148 | "membership", [ 149 | test "find" lrus_w_nat (fun ((m, f), x) -> M.find x m = F.find x f); 150 | test "mem" lrus_w_nat (fun ((m, f), x) -> M.mem x m = F.mem x f); 151 | ]; 152 | 153 | "add", [ 154 | test "eqv" lrus_w_nat 155 | (fun ((m, f), x) -> M.add x x m; !!m = !(F.add x x f)) 156 | ]; 157 | 158 | "remove", [ 159 | test "eqv" lrus_w_nat 160 | (fun ((m, f), x) -> M.remove x m; !!m = !(F.remove x f)); 161 | ]; 162 | 163 | "trim", [ 164 | test "eqv" lrus_w_nat 165 | (fun ((m, f), x) -> 166 | M.resize x m; M.trim m; !!m = !F.(resize x f |> trim)); 167 | ]; 168 | 169 | "promote", [ 170 | test "eqv" lrus_w_nat 171 | (fun ((m, f), x) -> M.promote x m; !!m = !(F.promote x f)); 172 | ]; 173 | 174 | "lru", [ 175 | test "eqv" lrus (fun (m, f) -> M.lru m = F.lru f); 176 | test "drop eqv" lrus (fun (m, f) -> M.drop_lru m; !!m = !F.(drop_lru f)); 177 | ]; 178 | 179 | "conv", [ 180 | test "to_list inv" lru (fun m -> !!M.(of_list (to_list m)) = !!m); 181 | test "to_list = fold" lru 182 | (fun m -> M.fold (fun k v a -> (k, v)::a) [] m = M.to_list m); 183 | test "to_list = iter" lru 184 | (fun m -> list_of_iter_2 (fun f -> M.iter f m) = M.to_list m) 185 | ]; 186 | 187 | "pp", [ 188 | test "eqv" lrus 189 | (fun (m, f) -> Fmt.(to_to_string pp_m m = to_to_string pp_f f)); 190 | ] 191 | ] 192 | --------------------------------------------------------------------------------