Source

planck / smemo.ml

open Result

type 'key memo = ('key, (Obj.t, exn) Result.t) Hashtbl.t
let create = Hashtbl.create

module Extend(Base : sig
  include Stream_intf.S
  type key
  val memo : t -> key memo
end) = struct
  open Base

  type key = Base.key

  (* CR jfuruse: key equality is by polymoprhic equal!!! 
     Possible bottle neck!
  *)
  (* key uniqueness is the user's responsibility *)
  let memoize (key : Base.key) (f : (t -> 'a)) (str : t) : 'a =
    let memo = memo str in
    let res = 
      try Hashtbl.find memo key with
      | Not_found ->
          let res = 
            try Ok (Obj.repr (f str)) with
            | exn -> Error exn
          in
          Hashtbl.replace memo key res;
          res
    in
    match res with
    | Ok res -> Obj.obj res (* Type safe! Only if the key is unique... *)
    | Error exn -> raise exn

end