first commit

src/dune

@@ -0,0 +1,3 @@
+(library
+ (public_name memo)
+ (wrapped false))

src/memo.ml

@@ -0,0 +1,106 @@
+(** *)
+
+(** {1:tuning Tuning} *)
+
+(**/**)
+
+let get_initial_cache_size, set_initial_cache_size, reset_initial_cache_size =
+  let default = 512 in
+  let initial_cache_size = ref default in
+  ( (fun () -> !initial_cache_size)
+  , (fun size -> initial_cache_size := size)
+  , fun () -> initial_cache_size := default )
+
+(**/**)
+
+(** [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
+
+(** The type of custom cache modules. *)
+module type Cache = sig
+  (** The type of keys. *)
+  type key
+
+  (** The type of caches with ['a] values. *)
+  type !'a t
+
+  (** [create n] creates a new, empty cache, with initial size [n]. For best
+      results, [n] should be on the order of the expected number of elements
+      that will be in the cache. The cache must grow as needed, so [n] is just
+      an initial guess. *)
+  val create : int -> 'a t
+
+  (** Empty a cache. *)
+  val clear : 'a t -> unit
+
+  (** [add cache key v] adds a binding of [key] to [v] in cache [cache]. *)
+  val add : 'a t -> key -> 'a -> unit
+
+  (** [find cache v] returns the current binding of [v] in [cache], or must
+      raise [Not_found] if [v] is not in [cache]. *)
+  val find : 'a t -> key -> 'a
+end
+
+(** With the {!module:Mk} functor, you can also directly provide a [Cache]
+    module, which should have the signature [Cache]. 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 : Cache) = 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 [@inlined hint] (Hashtbl.Make [@inlined hint] (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 [@inlined hint] (Ephemeron.K1.Make [@inlined hint] (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 [@inlined hint] (struct
+  include Hashtbl.Make (H)
+
+  let find _ _ = raise_notrace Not_found
+
+  let add _ _ _ = ()
+end)