Commits

camlspotter committed f2991ae Merge

merge and prof results

Comments (0)

Files changed (14)

File contents unchanged.

memo.ml

-open Stream_intf
-
-(* CR jfuruse: stdlib's Hashtbl access is by compare_val. Too slow! *)
-(* CR jfuruse: Evil ugly. Need to be fixed. Just exists since it is indispensable for efficiency *)
-type memo = (Obj.t (* key... :-) *), [`Done of Obj.t | `Exn of exn]) Hashtbl.t
-(* It's evil but type-safe!, AFA key string is unique for each function. *)
-
-type 'a with_memo = { elem : 'a; memo : memo } 
-(* CR jfuruse: elem is now a bad name *)
-
-let elem_with_memo e = { elem = e; memo = Hashtbl.create 107 }
-
-open Lazylist
-
-let rec with_memo (t : ('elem, 'attr) zlist) : ('elem, 'attr with_memo) zlist = 
-  lazy (match desc t with
-  | Null attr -> Null { elem = attr; memo = Hashtbl.create 107 }
-  | Cons (elem, attr, t') -> Cons (elem, { elem = attr; memo = Hashtbl.create 107}, with_memo t'))
-
-
-let rec without_memo (t : ('elem, 'attr with_memo) zlist) : ('elem, 'attr) zlist =
-    lazy (match desc t with
-    | Null attr -> Null attr.elem
-    | Cons (elem, attr, t) -> Cons (elem, attr.elem, without_memo t))
-
-let memo (t : ('elem, 'attr with_memo) zlist) : memo = (attr t).memo
-
-module Make(P : sig
-  include Planck_intf.S
-  val memo : Str.t -> memo
-end) = struct
-  open P
-
-  type key = Obj.t
-
-  let memoize key (f : unit -> Str.t -> 'a) (st : Str.t) : 'a =
-    let memo = P.memo st in
-    let _pos = P.Str.position st in
-    match 
-      try Some (Hashtbl.find memo key) with Not_found -> None 
-    with
-    | Some (`Exn exn) -> raise exn
-    | Some (`Done o) -> Obj.obj o
-    | None ->
-        let res = try `Done (f () st) with exn -> `Exn exn in
-        let res_cache = match res with
-          | `Done v -> `Done (Obj.repr v)
-          | `Exn exn -> `Exn exn
-        in
-        Hashtbl.replace memo key res_cache;
-        match res with
-        | `Done v -> v
-        | `Exn exn -> raise exn
-end
-
-module WithMemo(B : Base) = Stream.Make(struct
-  module Pos = B.Pos
-  type elem = B.elem
-  type attr = B.attr with_memo
-  let show_elem = B.show_elem
-  let position_of_attr x = B.position_of_attr x.elem
-  (* let create_attr b_attr = { elem = b_attr; memo = Hashtbl.create 107 } *)
-end)

memo.mli

-open Stream_intf
-open Lazylist
-
-type memo = (Obj.t, [`Done of Obj.t | `Exn of exn ]) Hashtbl.t
-(* It's evil but type-safe!, AFA key string is unique for each function. *)
-
-type 'a with_memo = { elem : 'a; memo : memo }
-
-val elem_with_memo : 'a -> 'a with_memo
-
-val with_memo : ('elem, 'attr) zlist -> ('elem, 'attr with_memo) zlist
-val without_memo : ('elem, 'attr with_memo) zlist -> ('elem, 'attr) zlist
-
-val memo : ('elem, 'attr with_memo) zlist -> memo
-
-module Make(P : sig
-  include Planck_intf.S
-  val memo : Str.t -> memo
-end) : sig
-  open P
-  type key = Obj.t (* evil *)
-  val memoize : key -> (unit -> 'a t) -> 'a t
-end
-
-module WithMemo(B : Stream_intf.Base) : 
-  Stream_intf.S with type elem = B.elem
-                and  module Pos = B.Pos
-                and  type attr = B.attr with_memo