(* This file is part of our reusable OCaml BRICKS library
Copyright (C) 2007 Jean-Vincent Loddo
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. *)
(** Module implementing polymorphic unbounded maps (environments). *) |
(** The default size of the hash used in the implementation *) |
let default_size = 251;;
(** The hashmap class *) |
class ['a,'b] hashmap = fun ?(size=default_size) () ->
object(self)
(** The state of the hashmap. *) |
val current : ('a,'b) Hashtbl.t = (Hashtbl.create size)
method get = current
(** Return the object bound to the given key, or raise Not_found: *) |
method lookup x = (Hashtbl.find current x)
(** Answer (quickly!) to the question if (x,y) is a member of the map. *) |
method mem x y : bool = try y = (Hashtbl.find current x) with Not_found -> false
(** Answer (quickly!) to the question if (x,y) is a member of the map. *) |
method memq x y : bool = try y == (Hashtbl.find current x) with Not_found -> false
(** Answer if x is bound in the map. *) |
method bound x = Hashtbl.mem current x
(** Add a binding to the map *) |
method add x y = Hashtbl.replace current x y
(** Alias for add *) |
method replace x y = Hashtbl.replace current x y
(** Remove the binding for the given key. *) |
method remove x = Hashtbl.remove current x
(** Make an alist from the map, returning the bindings as <key, value> pairs in some unspecified order. *) |
method to_list =
Hashtbl.fold (fun a b current_list -> (a, b) :: current_list) current []
(** Add all the binding from the given alist to the map. In case of multiple values for a single key it's undefined which value prevails. *) |
method add_list alist =
ignore (List.map (fun (key, datum) -> self#add key datum) alist)
end;; (* class hashmap *)
(* Functional interface. *)
(** The abstract type of an hashmap. *) |
type ('a,'b) t = ('a,'b) hashmap ;;
(** The hashmap constructor. *) |
let make ?(size=default_size) () : ('a,'b) t = new hashmap ~size () ;;
(** Return the object bound to the given key, or raise Not_found: *) |
let lookup (h:('a,'b) t) x = h#lookup x
(** The member predicate. *) |
let mem (h:('a,'b) t) (x:'a) (y:'b) = h#mem x y;;
(** The member predicate with the physical equality. *) |
let memq (h:('a,'b) t) (x:'a) (y:'b) = h#memq x y;;
(** Answer if x is bound in the map. *) |
let bound (h:('a,'b) t) (x:'a) = h#bound x ;;
(** Add a binding to the hashmap. *) |
let add (h:('a,'b) t) (x:'a) (y:'b) = h#add x y;;
(** Add all the binding from the given alist to the map. In case of multiple values for a single key it's undefined which value prevails. *) |
let add_list (h:('a,'b) t) (alist:('a * 'b) list) = h#add_list alist;;
(** Replace or add (when not existing) a binding to a map. *) |
let replace (h:('a,'b) t) (x:'a) (y:'b) = h#replace x y;;
(** Remove one or all (default) bindings of the given key. *) |
let remove (h:('a,'b) t) (x:'a) = h#remove x;;
(** update t1 t2 updates the map t1 adding all the bindings from t2 .*) |
let update (h1:('a,'b) t) (h2:('a,'b) t) : unit = Hashtbl.iter (h1#add) (h2#get) ;;
(** Make an alist from an hashmap, returning the bindings as <key, value> pairs in some unspecified order. *) |
let to_list (h:('a,'b) t) = h#to_list;;
(** Make a new hashmap from an alist made of <key, value> pairs. If more than one binding is specified for a single key it's undefined which value prevails. *) |
let of_list ?size:(size=default_size) alist =
let h : ('a,'b) t = new hashmap ~size () in
h#add_list alist;
h;;