diff --git a/infer/src/IR/Procname.ml b/infer/src/IR/Procname.ml index 69fcdcde3..f97dab69c 100644 --- a/infer/src/IR/Procname.ml +++ b/infer/src/IR/Procname.ml @@ -742,6 +742,7 @@ module Hashable = struct end module Hash = Hashtbl.Make (Hashable) +module LRUHash = LRUHashtbl.Make (Hashable) module HashQueue = Hash_queue.Make (Hashable) module Map = PrettyPrintable.MakePPMap (struct diff --git a/infer/src/IR/Procname.mli b/infer/src/IR/Procname.mli index 7100ca9bd..883c244c0 100644 --- a/infer/src/IR/Procname.mli +++ b/infer/src/IR/Procname.mli @@ -223,6 +223,8 @@ val is_objc_method : t -> bool module Hash : Caml.Hashtbl.S with type key = t (** Hash tables with proc names as keys. *) +module LRUHash : LRUHashtbl.S with type key = t + module HashQueue : Hash_queue.S with type key = t module Map : PrettyPrintable.PPMap with type key = t diff --git a/infer/src/bufferoverrun/bufferOverrunUtils.ml b/infer/src/bufferoverrun/bufferOverrunUtils.ml index f7abec23b..a85748132 100644 --- a/infer/src/bufferoverrun/bufferOverrunUtils.ml +++ b/infer/src/bufferoverrun/bufferOverrunUtils.ml @@ -363,13 +363,15 @@ module ReplaceCallee = struct module CacheForMakeShared = struct - let results : Procname.t option Procname.Hash.t lazy_t = lazy (Procname.Hash.create 128) + let results : Procname.t option Procname.LRUHash.t lazy_t = + lazy (Procname.LRUHash.create ~initial_size:128 ~max_size:200) - let add pname value = Procname.Hash.replace (Lazy.force results) pname value - let find_opt pname = Procname.Hash.find_opt (Lazy.force results) pname + let add pname value = Procname.LRUHash.replace (Lazy.force results) pname value - let clear () = if Lazy.is_val results then Procname.Hash.clear (Lazy.force results) + let find_opt pname = Procname.LRUHash.find_opt (Lazy.force results) pname + + let clear () = if Lazy.is_val results then Procname.LRUHash.clear (Lazy.force results) end let get_cpp_constructor_of_make_shared = diff --git a/infer/src/istd/LRUHashtbl.ml b/infer/src/istd/LRUHashtbl.ml new file mode 100644 index 000000000..9b98f198a --- /dev/null +++ b/infer/src/istd/LRUHashtbl.ml @@ -0,0 +1,94 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd +module F = Format +module Hashtbl = Caml.Hashtbl + +module type S = sig + type key + + type 'a t + + val create : initial_size:int -> max_size:int -> 'a t + + val find_opt : 'a t -> key -> 'a option + + val replace : 'a t -> key -> 'a -> unit + + val clear : 'a t -> unit + + val pp : + pp_key:(F.formatter -> key -> unit) + -> pp_v:(F.formatter -> 'a -> unit) + -> F.formatter + -> 'a t + -> unit + + val bindings : 'a t -> (key * 'a) list +end + +module Make (Key : Hashtbl.HashedType) = struct + type key = Key.t + + module Hash = Hashtbl.Make (Key) + + module LRU = struct + type t = {list: Key.t Doubly_linked.t; max: int} + + let create max = + assert (max > 0) ; + {list= Doubly_linked.create (); max} + + + let insert_first {list; max} k = + let new_node = Doubly_linked.insert_first list k in + let removed_key = + if Doubly_linked.length list > max then Doubly_linked.remove_last list else None + in + (new_node, removed_key) + + + let use {list} n = Doubly_linked.move_to_front list n + + let clear {list} = Doubly_linked.clear list + end + + type 'a t = {map: ('a * key Doubly_linked.Elt.t) Hash.t; lru: LRU.t} + + let create ~initial_size ~max_size = {map= Hash.create initial_size; lru= LRU.create max_size} + + let find_opt {map; lru} k = + match Hash.find_opt map k with None -> None | Some (v, e) -> LRU.use lru e ; Some v + + + let replace {map; lru} k v = + let n = + match Hash.find_opt map k with + | None -> + let n, removed_key = LRU.insert_first lru k in + Option.iter removed_key ~f:(Hash.remove map) ; + n + | Some (_, n) -> + LRU.use lru n ; n + in + Hash.replace map k (v, n) + + + let clear {map; lru} = Hash.clear map ; LRU.clear lru + + let pp ~pp_key ~pp_v f {map} = + let is_first = ref true in + let pp_key_v key (v, _node) = + if !is_first then is_first := false else F.pp_print_string f ", " ; + F.fprintf f "%a->%a" pp_key key pp_v v + in + F.pp_print_string f "{" ; Hash.iter pp_key_v map ; F.pp_print_string f "}" + + + let bindings {map} = Seq.fold_left (fun acc (k, (v, _node)) -> (k, v) :: acc) [] (Hash.to_seq map) +end diff --git a/infer/src/istd/LRUHashtbl.mli b/infer/src/istd/LRUHashtbl.mli new file mode 100644 index 000000000..62ad13c87 --- /dev/null +++ b/infer/src/istd/LRUHashtbl.mli @@ -0,0 +1,35 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd + +(** Hash table the size of which is limited by LRU *) + +module type S = sig + type key + + type 'a t + + val create : initial_size:int -> max_size:int -> 'a t + + val find_opt : 'a t -> key -> 'a option + + val replace : 'a t -> key -> 'a -> unit + + val clear : 'a t -> unit + + val pp : + pp_key:(Format.formatter -> key -> unit) + -> pp_v:(Format.formatter -> 'a -> unit) + -> Format.formatter + -> 'a t + -> unit + + val bindings : 'a t -> (key * 'a) list +end + +module Make (Key : Caml.Hashtbl.HashedType) : S with type key = Key.t diff --git a/infer/src/unit/LRUHashtblTests.ml b/infer/src/unit/LRUHashtblTests.ml new file mode 100644 index 000000000..7c42608eb --- /dev/null +++ b/infer/src/unit/LRUHashtblTests.ml @@ -0,0 +1,58 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd +open OUnit2 +module LRUHash = LRUHashtbl.Make (Int) + +let inputs = + [ ("empty", (fun () -> LRUHash.create ~initial_size:5 ~max_size:3), []) + ; ( "singleton" + , (fun () -> + let map = LRUHash.create ~initial_size:5 ~max_size:3 in + LRUHash.replace map 0 10 ; map ) + , [(0, 10)] ) + ; ( "LRU1" + , (fun () -> + let map = LRUHash.create ~initial_size:5 ~max_size:3 in + LRUHash.replace map 0 10 ; + LRUHash.replace map 1 10 ; + LRUHash.replace map 2 10 ; + let (_ : int option) = LRUHash.find_opt map 1 in + LRUHash.replace map 3 10 ; LRUHash.replace map 4 10 ; map ) + , [(1, 10); (3, 10); (4, 10)] ) + ; ( "LRU2" + , (fun () -> + let map = LRUHash.create ~initial_size:5 ~max_size:3 in + LRUHash.replace map 0 10 ; + LRUHash.replace map 1 10 ; + LRUHash.replace map 2 10 ; + LRUHash.replace map 0 20 ; + LRUHash.replace map 3 10 ; + map ) + , [(0, 20); (2, 10); (3, 10)] ) + ; ( "clear" + , (fun () -> + let map = LRUHash.create ~initial_size:5 ~max_size:3 in + LRUHash.replace map 0 10 ; + LRUHash.replace map 1 10 ; + LRUHash.replace map 2 10 ; + LRUHash.clear map ; + map ) + , [] ) ] + + +let tests = + let compare (k1, v1) (k2, v2) = + let c = k1 - k2 in + if c <> 0 then c else v1 - v2 + in + "LRUHashtble" + >::: List.map inputs ~f:(fun (name, input, expected) -> + name + >:: fun _ -> assert_equal (input () |> LRUHash.bindings |> List.sort ~compare) expected + ) diff --git a/infer/src/unit/inferunit.ml b/infer/src/unit/inferunit.ml index 4b4dd7b29..6588334a7 100644 --- a/infer/src/unit/inferunit.ml +++ b/infer/src/unit/inferunit.ml @@ -37,6 +37,7 @@ let () = ; IListTests.tests ; JavaProfilerSamplesTest.tests ; LivenessTests.tests + ; LRUHashtblTests.tests ; MaximumSharingTests.tests ; PerfProfilerATDParserTest.tests ; ProcCfgTests.tests