refactor: make backtrackable table polymorphic in values

This commit is contained in:
Simon Cruanes 2019-06-11 10:19:07 -05:00
parent af0635dab7
commit 1212e219eb
2 changed files with 40 additions and 55 deletions

View file

@ -1,57 +1,49 @@
module type S = sig module type S = sig
type key type key
type value type 'a t
type t
val create : ?size:int -> unit -> t val create : ?size:int -> unit -> 'a t
val find : t -> key -> value val find : 'a t -> key -> 'a
(** @raise Not_found if the key is not present *) (** @raise Not_found if the key is not present *)
val get : t -> key -> value option val get : 'a t -> key -> 'a option
val mem : t -> key -> bool val mem : _ t -> key -> bool
val length : t -> int val length : _ t -> int
val iter : (key -> value -> unit) -> t -> unit val iter : (key -> 'a -> unit) -> 'a t -> unit
val to_iter : t -> (key * value) Iter.t val to_iter : 'a t -> (key * 'a) Iter.t
val add : t -> key -> value -> unit val add : 'a t -> key -> 'a -> unit
val remove : t -> key -> unit val remove : _ t -> key -> unit
val push_level : t -> unit val push_level : _ t -> unit
val pop_levels : t -> int -> unit val pop_levels : _ t -> int -> unit
end end
module type ARG = sig module type ARG = sig
module Key : sig type t
type t val equal : t -> t -> bool
val equal : t -> t -> bool val hash : t -> int
val hash : t -> int
end
module Value : sig
type t
val equal : t -> t -> bool
end
end end
module Make(A : ARG) = struct module Make(A : ARG) = struct
type key = A.Key.t type key = A.t
type value = A.Value.t module M = CCHashtbl.Make(A)
module M = CCHashtbl.Make(A.Key)
module BS = Backtrack_stack module BS = Backtrack_stack
type undo_op = Add of key * value | Remove of key type 'a undo_op = Add of key * 'a | Remove of key
type t = { type 'a t = {
tbl: value M.t; tbl: 'a M.t;
undo: undo_op BS.t; undo: 'a undo_op BS.t;
} }
let create ?(size=32) () : t = { tbl=M.create size; undo=BS.create() } let create ?(size=32) () : _ t = { tbl=M.create size; undo=BS.create() }
let apply_undo self u = let apply_undo self u =
match u with match u with
| Add (k,v) -> M.replace self.tbl k v | Add (k,v) -> M.replace self.tbl k v
| Remove k -> M.remove self.tbl k | Remove k -> M.remove self.tbl k
let[@inline] find (self:t) k : value = M.find self.tbl k let[@inline] find (self:_ t) k = M.find self.tbl k
let[@inline] get (self:t) k : value option = M.get self.tbl k let[@inline] get (self:_ t) k : _ option = M.get self.tbl k
let[@inline] mem self k = M.mem self.tbl k let[@inline] mem self k = M.mem self.tbl k
let[@inline] length self = M.length self.tbl let[@inline] length self = M.length self.tbl
let[@inline] iter f self = M.iter f self.tbl let[@inline] iter f self = M.iter f self.tbl

View file

@ -2,35 +2,28 @@
module type S = sig module type S = sig
type key type key
type value type 'a t
type t
val create : ?size:int -> unit -> t val create : ?size:int -> unit -> 'a t
val find : t -> key -> value val find : 'a t -> key -> 'a
(** @raise Not_found if the key is not present *) (** @raise Not_found if the key is not present *)
val get : t -> key -> value option val get : 'a t -> key -> 'a option
val mem : t -> key -> bool val mem : _ t -> key -> bool
val length : t -> int val length : _ t -> int
val iter : (key -> value -> unit) -> t -> unit val iter : (key -> 'a -> unit) -> 'a t -> unit
val to_iter : t -> (key * value) Iter.t val to_iter : 'a t -> (key * 'a) Iter.t
val add : t -> key -> value -> unit val add : 'a t -> key -> 'a -> unit
val remove : t -> key -> unit val remove : _ t -> key -> unit
val push_level : t -> unit val push_level : _ t -> unit
val pop_levels : t -> int -> unit val pop_levels : _ t -> int -> unit
end end
module type ARG = sig module type ARG = sig
module Key : sig type t
type t val equal : t -> t -> bool
val equal : t -> t -> bool val hash : t -> int
val hash : t -> int
end
module Value : sig
type t
val equal : t -> t -> bool
end
end end
module Make(A : ARG) : S with type key = A.Key.t and type value = A.Value.t module Make(A : ARG) : S with type key = A.t