64 lines
1.7 KiB
OCaml
64 lines
1.7 KiB
OCaml
(* Polymorphic maps *)
|
|
|
|
module RB = RedBlack
|
|
|
|
type ('key, 'value) t = {
|
|
tree : ('key * 'value) RB.t;
|
|
cmp : 'key -> 'key -> int
|
|
}
|
|
|
|
type ('key, 'value) map = ('key, 'value) t
|
|
|
|
let create ~cmp = {tree = RB.empty; cmp}
|
|
|
|
let empty map = {tree = RB.empty; cmp=map.cmp}
|
|
|
|
let is_empty map = RB.is_empty map.tree
|
|
|
|
let add key value map =
|
|
let cmp (k1,_) (k2,_) = map.cmp k1 k2 in
|
|
{map with tree = RB.add ~cmp RB.New (key, value) map.tree}
|
|
|
|
let remove key map =
|
|
let cmp k1 (k2,_) = map.cmp k1 k2 in
|
|
{map with tree = RB.remove ~cmp key map.tree}
|
|
|
|
let find key map =
|
|
let cmp k1 (k2,_) = map.cmp k1 k2 in
|
|
try snd (RB.find ~cmp key map.tree) with
|
|
Not_found -> raise Not_found
|
|
|
|
let find_opt key map =
|
|
try Some (find key map) with Not_found -> None
|
|
|
|
let has_key key map =
|
|
match find_opt key map with
|
|
Some _ -> true
|
|
| None -> false
|
|
|
|
let update key updater map =
|
|
match updater (find_opt key map) with
|
|
| None -> remove key map
|
|
| Some v -> add key v map
|
|
|
|
type ('key, 'value) added = {map : ('key, 'value) t; duplicates : ('key * 'value) list; added : ('key * 'value) list}
|
|
let add_list elts map =
|
|
let aux = fun {map ; duplicates ; added} ((key, value) as kv) ->
|
|
if has_key key map
|
|
then {map; duplicates = kv :: duplicates ; added}
|
|
else {map = add key value map; duplicates; added = kv :: added} in
|
|
List.fold_left aux {map; duplicates=[]; added = []} elts
|
|
|
|
let from_list ~cmp elts =
|
|
match add_list elts (create ~cmp) with
|
|
{ map; duplicates = []; added = _ } -> Some map
|
|
| _ -> None (* Refuse to create a map from a list with duplicates *)
|
|
|
|
|
|
let bindings map =
|
|
RB.fold_dec (fun ~elt ~acc -> elt::acc) ~init:[] map.tree
|
|
|
|
let iter f map = RB.iter (fun (k,v) -> f k v) map.tree
|
|
|
|
let fold_inc f map = RB.fold_inc (fun ~elt:(k,v) -> f k v) map.tree
|