Memoize.ml 2.02 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

POTTIER Francois's avatar
POTTIER Francois committed
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
module type MEMOIZER = sig
  (* A fixed type of keys. *)
  type key
  (* A memoization combinator for this type. *)
  val memoize: (key -> 'a) -> (key -> 'a)
end

module type IMPERATIVE_MAP = sig
  (* A type of keys. *)
  type key
  (* A type of imperative maps. *)
  type 'a t
  (* Creation, insertion, lookup. *)
  val create: int -> 'a t
  val add: 'a t -> key -> 'a -> unit
  val find: 'a t -> key -> 'a
end

module Make (M : IMPERATIVE_MAP) = struct
  type key = M.key
  let memoize (f : key -> 'a) =
    let table = M.create 127 in
    fun x ->
      try
	M.find table x
      with Not_found ->
	let y = f x in
	M.add table x y;
	y
end

module MakeViaMap (O : Map.OrderedType) =
  Make(struct
    module M = Map.Make(O)
    type key = O.t
    type 'a t = 'a M.t ref
    let create _ = ref M.empty
    let add table key data = table := M.add key data !table
    let find table key = M.find key !table
  end)

module MakeViaHashtbl (H : Hashtbl.HashedType) =
  Make(Hashtbl.Make(H))

module Int =
  MakeViaHashtbl(struct
  type t = int
  let equal = (=)
  let hash = Hashtbl.hash
end)