1 (** A bounded key-value cache with first-in-first-out eviction. 2 3 Keys are strings; values are whatever the instance stores. When the cache 4 is full, adding a new key evicts the oldest one. Adding a key that is 5 already present is a no-op: callers build keys from content identifiers (a 6 repository head hash, for example), so a key's value never changes. 7 8 No locking: the server runs on a single Lwt event loop, and no operation 9 here yields. *) 10 11 type 'a t = { 12 capacity : int; 13 table : (string, 'a) Hashtbl.t; 14 order : string Queue.t; 15 } 16 17 let create ~capacity = 18 { capacity; table = Hashtbl.create 64; order = Queue.create () } 19 20 let find cache key = Hashtbl.find_opt cache.table key 21 22 let add cache key value = 23 if not (Hashtbl.mem cache.table key) then ( 24 if Queue.length cache.order >= cache.capacity then ( 25 match Queue.take_opt cache.order with 26 | Some oldest -> Hashtbl.remove cache.table oldest 27 | None -> ()); 28 Hashtbl.replace cache.table key value; 29 Queue.add key cache.order) 30