add updateWith function, fix CI

jscomp/others/bs_Map.ml

@@ -21,28 +21,7 @@ type ('k,'v,'id) t =
   (('k,'id) Bs_Cmp.t,
    ('k,'v, 'id) t0 ) B.bag 
 
-(** [addCheck0 m k v cmp]
-    return m reference unchanged when [k] already existed
-*)   
-let rec addCheck0  (t : _ t0) newK newD ~cmp : _ t0 =
-  match N.toOpt t with 
-  | None -> N.singleton0 newK newD
-  | Some nt ->
-    let k = N.key nt in 
-    let c = (Bs_Cmp.getCmp cmp) newK k [@bs] in
-    if c = 0 then t 
-    else
-      let l,r,v = N.left nt, N.right nt, N.value nt in 
-      if c < 0 then 
-        let ll = addCheck0 ~cmp l newK newD in 
-        if ll == l then t 
-        else N.bal ll k v r 
-      else 
-        let rr = addCheck0 ~cmp r newK newD in 
-        if rr == r then t 
-        else N.bal l k v rr    
-
-let rec add0  (t : _ t0) newK newD  ~cmp =
+let rec update0  (t : _ t0) newK newD  ~cmp =
   match N.toOpt t with 
   | None -> N.singleton0 newK newD 
   | Some n  ->
@@ -53,16 +32,51 @@ let rec add0  (t : _ t0) newK newD  ~cmp =
     else 
       let l,r,v = N.left n, N.right n, N.value n in 
       if c < 0 then
-        N.bal (add0 ~cmp l newK newD ) k v  r
+        N.bal (update0 ~cmp l newK newD ) k v  r
       else
-        N.bal l k v (add0 ~cmp r newK newD )
+        N.bal l k v (update0 ~cmp r newK newD )
 
-
-
-let rec remove0  n x ~cmp = 
-  match N.toOpt n with 
+let rec updateWithOpt0  (t : _ t0) newK f  ~cmp =
+  match N.toOpt t with 
   | None ->
-    n
+    begin match f None [@bs] with 
+    | None -> t 
+    | Some newD -> N.singleton0 newK newD 
+    end 
+  | Some n  ->
+    let k= N.key n in 
+    let c = (Bs_Cmp.getCmp cmp) newK k [@bs] in
+    if c = 0 then
+      match f (Some k) [@bs] with 
+      | None -> t 
+      | Some newD -> N.updateKV n newK newD 
+    else 
+      let l,r,v = N.left n, N.right n, N.value n in 
+      if c < 0 then
+        N.bal (updateWithOpt0 ~cmp l newK f ) k v  r
+      else
+        N.bal l k v (updateWithOpt0 ~cmp r newK f)
+
+(*  unboxing API was not exported
+    since the correct API is really awkard
+    [bool -> 'k Js.null -> ('a Js.null * bool)]
+    even for specialized [k] the first [bool] can 
+    be erased, maybe the perf boost does not justify the inclusion of such API
+
+    [updateWithNull m x f]
+    the callback to [f exist v] 
+    when [v] is non-null,
+    [exist] is guaranteed to be true
+    [v] is guranteed to be [null],
+    when [exist] is [true], [v] could be [null], 
+    since ['a] is polymorphic
+*)
+
+
+let rec remove0  t x ~cmp = 
+  match N.toOpt t with 
+  | None ->
+    t
   | Some n  ->
     let l,v,r = N.(left n, key n, right n ) in 
     let c = (Bs_Cmp.getCmp cmp) x v [@bs] in
@@ -75,9 +89,13 @@ let rec remove0  n x ~cmp =
         let r = N.removeMinAuxWithRef rn kr vr in 
         N.bal l !kr !vr r
     else if c < 0 then
-      N.(bal (remove0 ~cmp l x ) v (value n) r)
+      let ll = remove0 l x ~cmp in 
+      if ll == l then t
+      else N.bal ll v (N.value n) r
     else
-      N.(bal l v (value n) (remove0 ~cmp r x ))
+      let rr = remove0 ~cmp r x in
+      if rr == r then t 
+      else N.bal l v (N.value n)  rr
 
 let rec splitAuxPivot ~cmp n x pres  =  
   let l,v,d,r = N.(left n , key n, value n, right n) in  
@@ -209,11 +227,16 @@ let mapi map  f =
 
 
 
-let add (type k) (type id) (map : (k,_,id) t) key data  = 
+let update (type k) (type id) (map : (k,_,id) t) key data  = 
   let dict,map = B.(dict map, data map) in 
   let module X = (val dict) in 
-  B.bag ~dict ~data:(add0 ~cmp:X.cmp map key data )
+  B.bag ~dict ~data:(update0 ~cmp:X.cmp map key data )
 
+let updateWithOpt (type k) (type id) (map : (k,_,id) t) key f  = 
+  let dict,map = B.(dict map, data map) in 
+  let module X = (val dict) in 
+  B.bag ~dict ~data:(updateWithOpt0 ~cmp:X.cmp map key f )
+
 let ofArray (type k) (type id) (dict : (k,id) Bs_Cmp.t) data = 
   let module M = (val dict ) in 
   B.bag

jscomp/others/bs_Map.mli

@@ -59,11 +59,18 @@ val ofArray:
 val isEmpty: ('k, 'a, 'id) t -> bool
 val mem: 
    ('k, 'a, 'id) t -> 'k  -> bool
-val add: ('k, 'a, 'id) t -> 'k -> 'a ->  ('k, 'a, 'id) t
-(** [add m x y ] returns a map containing the same bindings as
-    [m], plus a binding of [x] to [y]. If [x] was already bound
+
+val update: ('k, 'a, 'id) t -> 'k -> 'a ->  ('k, 'a, 'id) t
+(** [update m x y ] returns a map containing the same bindings as
+    [m], with a new binding of [x] to [y]. If [x] was already bound
     in [m], its previous binding disappears. *)
 
+val updateWithOpt:     
+    ('k, 'a, 'id) t ->  
+    'k -> 
+    ('k option -> 'a option [@bs]) -> 
+    ('k, 'a, 'id) t 
+
 val singleton: ('k,'id) Bs_Cmp.t ->
   'k -> 'a -> ('k, 'a, 'id) t
 
@@ -179,9 +186,10 @@ val mem0:
    cmp: ('k,'id) Bs_Cmp.cmp -> 
    bool
 
-val add0: 
-    ('k, 'a, 'id) t0 -> 
-  'k -> 'a -> 
+val update0: 
+  ('k, 'a, 'id) t0 -> 
+  'k -> 
+  'a -> 
   cmp: ('k,'id) Bs_Cmp.cmp -> 
   ('k, 'a, 'id) t0 
 

jscomp/others/bs_MapInt.ml

@@ -28,21 +28,43 @@ let length = N.length0
 let toList = N.toList0
 let checkInvariant = N.checkInvariant
 
-let rec add  t (x : key) (data : _)  = 
+let rec update  t (newK : key) (newD : _)  = 
   match N.toOpt t with
   | None -> 
-    N.singleton0 x data 
+    N.singleton0 newK newD
+  | Some n  ->
+    let k = N.key n in 
+    if newK = k then
+      N.updateKV n newK newD
+    else
+      let v = N.value n in 
+      if newK < k then
+        N.bal (update (N.left n) newK newD) k v (N.right n)
+      else
+        N.bal (N.left n) k v (update (N.right n) newK newD)
+
+let rec updateWithOpt  t (x : key) f  = 
+  match N.toOpt t with
+  | None -> 
+    begin match f None [@bs] with 
+    | None -> t 
+    | Some data -> 
+      N.singleton0 x data 
+    end 
   | Some n  ->
     let k = N.key n in 
     if x = k then
-      N.updateKV n x data 
+      begin match f (Some k) [@bs] with 
+      | None -> t 
+      | Some data -> N.updateKV n x data 
+      end 
     else
       let v = N.value n in 
       if x < k then
-        N.bal (add (N.left n) x data ) k v (N.right n)
+        N.bal (updateWithOpt (N.left n) x f) k v (N.right n)
       else
-        N.bal (N.left n) k v (add (N.right n) x data )
-        
+        N.bal (N.left n) k v (updateWithOpt (N.right n) x f)        
+
 let rec remove n (x : key) = 
   match N.toOpt n with 
   |  None -> n    

jscomp/others/bs_MapInt.mli

@@ -12,10 +12,15 @@ val isEmpty: 'a t -> bool
 
 val mem:  'a t -> key -> bool
 
-val add: 'a t ->  key -> 'a -> 'a t
+val update: 'a t ->  key -> 'a -> 'a t
 (** [add m x y] returns a map containing the same bindings as
    [m], plus a binding of [x] to [y]. If [x] was already bound
    in [m], its previous binding disappears. *)
+val updateWithOpt:
+    'a t -> 
+    key -> 
+    (key option -> 'a option [@bs]) -> 
+    'a t 
 
 val singleton: key -> 'a -> 'a t
 

jscomp/others/bs_MapString.ml

@@ -28,21 +28,43 @@ let length = N.length0
 let toList = N.toList0
 let checkInvariant = N.checkInvariant
 
-let rec add  t (x : key) (data : _)  = 
+let rec update  t (newK : key) (newD : _)  = 
   match N.toOpt t with
   | None -> 
-    N.singleton0 x data 
+    N.singleton0 newK newD
+  | Some n  ->
+    let k = N.key n in 
+    if newK = k then
+      N.updateKV n newK newD
+    else
+      let v = N.value n in 
+      if newK < k then
+        N.bal (update (N.left n) newK newD) k v (N.right n)
+      else
+        N.bal (N.left n) k v (update (N.right n) newK newD)
+
+let rec updateWithOpt  t (x : key) f  = 
+  match N.toOpt t with
+  | None -> 
+    begin match f None [@bs] with 
+    | None -> t 
+    | Some data -> 
+      N.singleton0 x data 
+    end 
   | Some n  ->
     let k = N.key n in 
     if x = k then
-      N.updateKV n x data 
+      begin match f (Some k) [@bs] with 
+      | None -> t 
+      | Some data -> N.updateKV n x data 
+      end 
     else
       let v = N.value n in 
       if x < k then
-        N.bal (add (N.left n) x data ) k v (N.right n)
+        N.bal (updateWithOpt (N.left n) x f) k v (N.right n)
       else
-        N.bal (N.left n) k v (add (N.right n) x data )
-        
+        N.bal (N.left n) k v (updateWithOpt (N.right n) x f)        
+
 let rec remove n (x : key) = 
   match N.toOpt n with 
   |  None -> n    

jscomp/others/bs_MapString.mli

@@ -12,10 +12,15 @@ val isEmpty: 'a t -> bool
 
 val mem:  'a t -> key -> bool
 
-val add: 'a t ->  key -> 'a -> 'a t
+val update: 'a t ->  key -> 'a -> 'a t
 (** [add m x y] returns a map containing the same bindings as
    [m], plus a binding of [x] to [y]. If [x] was already bound
    in [m], its previous binding disappears. *)
+val updateWithOpt:
+    'a t -> 
+    key -> 
+    (key option -> 'a option [@bs]) -> 
+    'a t 
 
 val singleton: key -> 'a -> 'a t
 

jscomp/others/bs_Set.ml

@@ -12,11 +12,12 @@ type ('elt,'id) t = (('elt,'id) Bs_Cmp.t , ('elt,'id) t0) B.bag
 *)  
 let rec add0  (t : _ t0) x  ~cmp : _ t0 =
   match N.toOpt t with 
-    None -> N.singleton0 x 
+  | None -> N.singleton0 x 
   | Some nt ->
     let k = N.key nt in 
     let c = (Bs_Cmp.getCmp cmp) x k [@bs] in
-    if c = 0 then t else
+    if c = 0 then t
+    else
       let l,r = N.(left nt, right nt) in 
       if c < 0 then 
         let ll = add0 ~cmp l x in 
@@ -27,7 +28,7 @@ let rec add0  (t : _ t0) x  ~cmp : _ t0 =
         if rr == r then t 
         else N.bal l k rr 
 
-let rec remove0 ~cmp (t : _ t0) x : _ t0 = 
+let rec remove0 (t : _ t0) x  ~cmp : _ t0 = 
   match N.toOpt t with 
     None -> t
   | Some n  ->

jscomp/others/bs_Set.mli

@@ -123,8 +123,10 @@ val removeArray0:
 
 val singleton0: 'elt -> ('elt, 'id) t0
 val remove0: 
+  ('elt, 'id) t0 -> 
+  'elt ->  
   cmp: ('elt,'id) Bs_Cmp.cmp ->
-  ('elt, 'id) t0 -> 'elt ->  ('elt, 'id) t0
+  ('elt, 'id) t0
 val union0: 
   cmp: ('elt,'id) Bs_Cmp.cmp ->
   ('elt, 'id) t0 -> ('elt, 'id) t0 -> ('elt, 'id) t0

jscomp/others/map.cppo.ml

@@ -33,21 +33,43 @@ let length = N.length0
 let toList = N.toList0
 let checkInvariant = N.checkInvariant
 
-let rec add  t (x : key) (data : _)  = 
+let rec update  t (newK : key) (newD : _)  = 
   match N.toOpt t with
   | None -> 
-    N.singleton0 x data 
+    N.singleton0 newK newD
+  | Some n  ->
+    let k = N.key n in 
+    if newK = k then
+      N.updateKV n newK newD
+    else
+      let v = N.value n in 
+      if newK < k then
+        N.bal (update (N.left n) newK newD) k v (N.right n)
+      else
+        N.bal (N.left n) k v (update (N.right n) newK newD)
+
+let rec updateWithOpt  t (x : key) f  = 
+  match N.toOpt t with
+  | None -> 
+    begin match f None [@bs] with 
+    | None -> t 
+    | Some data -> 
+      N.singleton0 x data 
+    end 
   | Some n  ->
     let k = N.key n in 
     if x = k then
-      N.updateKV n x data 
+      begin match f (Some k) [@bs] with 
+      | None -> t 
+      | Some data -> N.updateKV n x data 
+      end 
     else
       let v = N.value n in 
       if x < k then
-        N.bal (add (N.left n) x data ) k v (N.right n)
+        N.bal (updateWithOpt (N.left n) x f) k v (N.right n)
       else
-        N.bal (N.left n) k v (add (N.right n) x data )
-        
+        N.bal (N.left n) k v (updateWithOpt (N.right n) x f)        
+
 let rec remove n (x : key) = 
   match N.toOpt n with 
   |  None -> n    

jscomp/others/map.cppo.mli

@@ -16,10 +16,15 @@ val isEmpty: 'a t -> bool
 
 val mem:  'a t -> key -> bool
 
-val add: 'a t ->  key -> 'a -> 'a t
+val update: 'a t ->  key -> 'a -> 'a t
 (** [add m x y] returns a map containing the same bindings as
    [m], plus a binding of [x] to [y]. If [x] was already bound
    in [m], its previous binding disappears. *)
+val updateWithOpt:
+    'a t -> 
+    key -> 
+    (key option -> 'a option [@bs]) -> 
+    'a t 
 
 val singleton: key -> 'a -> 'a t