Source

planck / lib / smemo.ml

open Spotlib.Spot
open Result

type memo_result = (Obj.t, exn) Result.t
type memo = (int, memo_result) Hashtbl.t
let create () = Hashtbl.create 31 (* We should not have so many input tokens *)

module type X = sig
  type stream
  module Memo : sig
    type 'a t  (* abstract memoized function *)
    val register : (stream -> 'a) -> 'a t
    val call : 'a t -> stream -> 'a
  end
end

module type S = sig
  include Stream_intf.S
  include X with type stream := t
end                            

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

  open Base

  module Memo = struct

    type 'a t = int * (Base.t -> 'a)
  
    let cntr = ref 0
  
    let register (f : (Base.t -> 'a)) : 'a t = 
      incr cntr;
      if !cntr > 1000 then assert false; (* Too much memoization. Something must be wrong! *) 
      (!cntr, f)
  
    let call (id, f) str =
      let m = memo (attr str) in
      let res = 
        try Hashtbl.find m id with
        | Not_found ->
            let res = 
              try `Ok (Obj.repr (f str)) with
              | exn -> `Error exn
            in
            Hashtbl.replace m id res;
            res
      in
      match res with
      | `Ok res -> Obj.obj res
      | `Error exn -> raise exn
  end

end

(*
module Make(Base : sig
  include Stream_intf.S
  val memo : Attr.t -> memo
end) = struct
  include Base
  include Extend(Base)
end
*)