src/memo.ml

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

(** *)

(** {1:tuning Tuning} *)

(**/**)

(** Default for the initial size when creating a cache. *)
let default_cache_size = 512

(** Current value for the initial cache size. *)
let initial_cache_size = ref default_cache_size

(**/**)

(** Get the value used as an initial size when creating a cache. *)
let get_initial_cache_size () = !initial_cache_size

(** Set the value used as an initial size when creating a cache. *)
let set_initial_cache_size size = initial_cache_size := size

(** Reset to default the value used as an initial size when creating a cache. *)
let reset_initial_cache_size () = initial_cache_size := default_cache_size

(**/**)

(** [mk_memo create find add ff] gives a memoïzed version of the functional [ff]
    using the functions [create], [find] and [add] for the cache. It's used
    internally and you shouldn't have to use it. *)
let mk_memo create find add ff =
  let cache = create (get_initial_cache_size ()) in
  let rec f k =
    try find cache k
    with Not_found ->
      let v = ff f k in
      add cache k v ; v
  in
  f

(**/**)

(** {1:generic Generic interface} *)

(** [memo ff] gives you a memoïzed version of the [ff] functional. *)
let memo ff =
  let open Hashtbl in
  mk_memo create find add ff

(** {1:functors Functorial interface } *)

(** The output signature of the functors {!module:Mk}, {!module:Make}, {!module:MakeWeak} and {!module:Fake}.*)
module type S = sig
  type t

  val memo : ((t -> 'a) -> t -> 'a) -> t -> 'a
end

(** With the {!module:Mk} functor, you can also directly provide a [Cache] module, which
    should have the signature [Hashtbl.S]. We will include your cache module and
    use it to define a [memo] function. It should be useful only if you want to
    use another [Hashtbl] implementation or things like this. *)
module Mk (Cache : Hashtbl.S) = struct
  include Cache

  let memo ff = mk_memo Cache.create Cache.find Cache.add ff
end

(** Functor that can be useful in case you don't want to use polymorphic
    equality or you are doing things like hashconsing and you know how to compare
    or hash your type more efficiently. *)
module Make (H : Hashtbl.HashedType) = Mk (Hashtbl.Make (H))

(** Functor that works like the [Make] one, but the bindings in the memoïzation
    cache will be weak, allowing the garbage collector to remove them if they are
    not used somewhere else. *)
module MakeWeak (H : Hashtbl.HashedType) = Mk (Ephemeron.K1.Make (H))

(** Functor that is useful if you want to quickly test a function you memoïzed
    with our {!module:Make} or {!module:MakeWeak} functor, but without memoïzing it. It'll
    basically do nothing and should be equivalent to your initial non-memoïzed
    function. *)
module Fake (H : Hashtbl.HashedType) = Mk (struct
  include Hashtbl.Make (H)

  let find _ _ = raise_notrace Not_found

  let add _ _ _ = ()
end)