breaking the API, it's more safe now :)

previously, union and merge could invalidate the invariant:
foreach k \in m . m[k] = (key, value) /\ k = key

which could lead to assertion fail in find. Now, their signature uses
semi-explicit polymorphism with a record type:

* S.equal : { f : 'a key -> 'a -> 'a -> bool } -> t -> t -> bool
* S.merge : { f : 'a key -> 'a option -> 'a option -> 'a option } -> t -> t -> t
* S.union : { f : 'a key -> 'a -> 'a -> 'a option } -> t -> t -> t
* new function S.map : { f : 'a key -> 'a -> 'a } -> t -> t

In addition, some interface duplication for "bindings" and "value" were removed,
namely: S.findb, S.getb, S.addb, S.addb_unless_bound. Use the counterparts
S.find, S.get, S.add, S.add_unless_bound instead.

The pretty-printer S.pp was removed, and K.pp is no longer required! S.pp was
let pp ppf m = M.iter (fun (M.B (k, v)) -> Fmt.pf ppf (K.pp k) v) m
This removes the Fmt dependency.

Added some initial tests

CHANGES.md

@@ -1,3 +1,21 @@
+## 0.3.0 (2019-04-20)
+
+* S.union and S.merge could invalidate the invariant:
+  foreach k \in m . m[k] = (key, value) /\ k = key
+  which could lead to assertion fail in find
+* The signatures uses semi-explicit polymorphism with a record type:
+  * S.equal : { f : 'a key -> 'a -> 'a -> bool } -> t -> t -> bool
+  * S.merge : { f : 'a key -> 'a option -> 'a option -> 'a option } -> t -> t -> t
+  * S.union : { f : 'a key -> 'a -> 'a -> 'a option } -> t -> t -> t
+  * new function S.map : { f : 'a key -> 'a -> 'a } -> t -> t
+* Interface duplication for "bindings" and "value" were removed:
+  S.findb, S.getb, S.addb, S.addb_unless_bound no longer exist,
+  use S.find, S.get, S.add, S.add_unless_bound instead.
+* The pretty-printer S.pp was removed, and K.pp is no longer required! S.pp is:
+  let pp ppf = M.iter (fun (M.B (k, v)) -> Fmt.pf ppf (K.pp k) v)
+* no more Fmt dependency
+* added some initial tests
+
 ## 0.2.1 (2019-02-16)
 
 * move build system to dune

README.md

@@ -10,23 +10,18 @@ This removes the need for additional packing.  It uses OCaml's stdlib
 structure.
 
 ```OCaml
-type _ k =
-  | A : int k
-  | B : string k
+type _ key =
+  | I : int key
+  | S : string key
 
 module K = struct
-  type 'a t = 'a k
+  type 'a t = 'a key
 
   let compare : type a b. a t -> b t -> (a, b) Gmap.Order.t = fun t t' ->
     let open Gmap.Order in
     match t, t' with
-    | A, A -> Eq | A, _ -> Lt | _, A -> Gt
-    | B, B -> Eq
-
-  let pp : type a. Format.formatter -> a t -> a -> unit = fun ppf t v ->
-    match t, v with
-    | A, x -> Fmt.pf ppf "A %d" x
-    | B, s -> Fmt.pf ppf "B %s" s
+    | I, I -> Eq | I, _ -> Lt | _, I -> Gt
+    | S, S -> Eq
 end
 
 module M = Gmap.Make(K)
@@ -35,7 +30,7 @@ module M = Gmap.Make(K)
 let () =
   let m = M.empty in
   ...
-  match M.find A m with
+  match M.find I m with
   | Some x -> Printf.printf "got %d\n" x
   | None -> Printf.printf "found nothing\n"
 ```

dune

@@ -1,5 +1,9 @@
 (library
   (name gmap)
   (public_name gmap)
-  (modules gmap)
-  (libraries fmt))
+  (modules gmap))
+
+(test
+  (name tests)
+  (modules tests)
+  (libraries alcotest fmt gmap))

gmap.ml

@@ -12,7 +12,6 @@ end
 module type KEY = sig
   type _ t
   val compare : 'a t -> 'b t -> ('a, 'b) Order.t
-  val pp : Format.formatter -> 'a t -> 'a -> unit
 end
 
 module type S = sig
@@ -32,27 +31,27 @@ module type S = sig
   val update : 'a key -> ('a option -> 'a option) -> t -> t
 
   type b = B : 'a key * 'a -> b
+
   val min_binding : t -> b option
   val max_binding : t -> b option
   val any_binding :  t -> b option
   val bindings : t -> b list
 
-  val findb : 'a key -> t -> b option
-  val getb : 'a key -> t -> b
-
-  val addb_unless_bound : b -> t -> t option
-  val addb : b -> t -> t
+  type eq = { f : 'a . 'a key -> 'a -> 'a -> bool }
+  val equal : eq -> t -> t -> bool
 
-  val equal : (b -> b -> bool) -> t -> t -> bool
+  type mapper = { f : 'a. 'a key -> 'a -> 'a }
+  val map : mapper -> t -> t
 
   val iter : (b -> unit) -> t -> unit
   val fold : (b -> 'a -> 'a) -> t -> 'a -> 'a
   val for_all : (b -> bool) -> t -> bool
   val exists : (b -> bool) -> t -> bool
   val filter : (b -> bool) -> t -> t
-  val merge : (b option -> b option -> b option) -> t -> t -> t
-  val union : (b -> b -> b option) -> t -> t -> t
-  val pp : Format.formatter -> t -> unit
+  type merger = { f : 'a. 'a key -> 'a option -> 'a option -> 'a option }
+  val merge : merger -> t -> t -> t
+  type unionee = { f : 'a. 'a key -> 'a -> 'a -> 'a option }
+  val union : unionee -> t -> t -> t
 end
 
 module Make (Key : KEY) : S with type 'a key = 'a Key.t = struct
@@ -63,9 +62,7 @@ module Make (Key : KEY) : S with type 'a key = 'a Key.t = struct
   module M = Map.Make(struct
       type t = k
       let compare (K a) (K b) = match Key.compare a b with
-        | Order.Lt -> -1
-        | Order.Eq -> 0
-        | Order.Gt -> 1
+        | Order.Lt -> -1 | Order.Eq -> 0 | Order.Gt -> 1
     end)
 
   type t = b M.t
@@ -77,31 +74,27 @@ module Make (Key : KEY) : S with type 'a key = 'a Key.t = struct
   let mem k m = M.mem (K k) m
 
   let add k v m = M.add (K k) (B (k, v)) m
-  let addb (B (k, v)) m = add k v m
 
   let add_unless_bound k v m = if mem k m then None else Some (add k v m)
 
-  let addb_unless_bound (B (k, v)) m = add_unless_bound k v m
-
   let remove k m = M.remove (K k) m
 
-  let getb : type a. a key -> t -> b = fun k m ->
-    match M.find (K k) m with
-    | B (k', v) ->
-      match Key.compare k k' with
-      | Order.Eq -> B (k, v)
-      | _ -> assert false
-
   let get : type a. a key -> t -> a = fun k m ->
     match M.find (K k) m with
     | B (k', v) ->
+      (* TODO this compare (and further below similar ones) is only needed for
+         the type checker (to get the k = k' proof), because the invariant
+         foreach k . t [K k] = B (k', v) -> k = k' is preserved by this library
+
+         it could be replaced by:
+          - Obj.magic
+          - vendor and slight modification of Stdlib.Map
+          - using integers as key -> compare can be a single instruction
+         Stay better safe than sorry (at least for now) *)
       match Key.compare k k' with
       | Order.Eq -> v
       | _ -> assert false
 
-  let findb : type a. a key -> t -> b option = fun k m ->
-    try Some (getb k m) with Not_found -> None
-
   let find : type a. a key -> t -> a option = fun k m ->
     try Some (get k m) with Not_found -> None
 
@@ -110,7 +103,6 @@ module Make (Key : KEY) : S with type 'a key = 'a Key.t = struct
     | None -> remove k m
     | Some v -> add k v m
 
-
   let any_binding m = try Some (snd (M.choose m)) with Not_found -> None
   let min_binding m = try Some (snd (M.min_binding m)) with Not_found -> None
   let max_binding m = try Some (snd (M.max_binding m)) with Not_found -> None
@@ -125,15 +117,64 @@ module Make (Key : KEY) : S with type 'a key = 'a Key.t = struct
   let fold f m acc = M.fold (fun _ b acc -> f b acc) m acc
   let filter p m = M.filter (fun _ b -> p b) m
 
-  let merge f m m' = M.merge (fun _ b b' -> f b b') m m'
-
-  let union f m m' = M.union (fun _ b b' -> f b b') m m'
-
-  let pp ppf m =
-    let pp ppf = function
-      | B (k, v) -> Key.pp ppf k v
-    in
-    Fmt.(list ~sep:(unit "@.") pp) ppf (bindings m)
-
-  let equal cmp m m' = M.equal cmp m m'
+  type mapper = { f : 'a. 'a key -> 'a -> 'a }
+  let map f m = M.map (fun (B (k, v)) -> B (k, f.f k v)) m
+
+  type merger = { f : 'a. 'a key -> 'a option -> 'a option -> 'a option }
+  let merge f m m' =
+    M.merge (fun (K k) b b' ->
+        match b, b' with
+        | None, None ->
+          begin match f.f k None None with
+            | None -> None
+            | Some v -> Some (B (k, v))
+          end
+        | None, Some (B (k', v)) ->
+          (* see above comment about compare *)
+          begin match Key.compare k k' with
+            | Order.Eq ->
+              (match f.f k None (Some v) with
+               | None -> None
+               | Some v -> Some (B (k, v)))
+            | _ -> assert false
+          end
+        | Some (B (k', v)), None ->
+          (* see above comment about compare *)
+          begin match Key.compare k k' with
+            | Order.Eq ->
+              (match f.f k (Some v) None with
+               | None -> None
+               | Some v -> Some (B (k, v)))
+            | _ -> assert false
+          end
+        | Some (B (k', v)), Some (B (k'', v')) ->
+          (* see above comment about compare *)
+          begin match Key.compare k k', Key.compare k k'' with
+           | Order.Eq, Order.Eq ->
+             (match f.f k (Some v) (Some v') with
+              | None -> None
+              | Some v -> Some (B (k, v)))
+           | _ -> assert false
+          end)
+      m m'
+
+  type unionee = { f : 'a. 'a key -> 'a -> 'a -> 'a option }
+  let union f m m' =
+    M.union
+      (fun (K k) (B (k', v)) (B (k'', v')) ->
+         (* see above comment about compare *)
+         match Key.compare k k', Key.compare k k'' with
+         | Order.Eq, Order.Eq ->
+           (match f.f k v v' with None -> None | Some v'' -> Some (B (k, v'')))
+         | _ -> assert false)
+      m m'
+
+  type eq = { f : 'a . 'a key -> 'a -> 'a -> bool }
+  let equal cmp m m' =
+    M.equal (fun (B (k, v)) (B (k', v')) ->
+        (* see above comment about compare *)
+        match Key.compare k k' with
+        | Order.Eq -> cmp.f k v v'
+        | _ -> assert false)
+      m m'
 end