Modify API of update.

lex/lexgen.ml

@@ -685,8 +685,8 @@ let env_to_class m =
     MemMap.fold
       (fun _ (tag,s) r ->
          TagMap.update tag (function
-             | None -> StateSetSet.singleton s
-             | Some ss -> StateSetSet.add s ss
+             | None -> Some (StateSetSet.singleton s)
+             | Some ss -> Some (StateSetSet.add s ss)
            ) r)
       m TagMap.empty in
   TagMap.fold
@@ -699,10 +699,10 @@ let inverse_mem_map trans m r =
   TagMap.fold
     (fun tag addr r ->
        MemMap.update addr (function
-           | None -> tag, StateSet.singleton trans
+           | None -> Some (tag, StateSet.singleton trans)
            | Some (otag, s) ->
                assert (tag = otag);
-               (tag, StateSet.add trans s)
+               Some (tag, StateSet.add trans s)
          ) r)
     m r
 

stdlib/map.ml

@@ -27,7 +27,7 @@ module type S =
     val is_empty: 'a t -> bool
     val mem:  key -> 'a t -> bool
     val add: key -> 'a -> 'a t -> 'a t
-    val update: key -> ('a option -> 'a) -> 'a t -> 'a t
+    val update: key -> ('a option -> 'a option) -> 'a t -> 'a t
     val singleton: key -> 'a -> 'a t
     val remove: key -> 'a t -> 'a t
     val merge:
@@ -126,21 +126,6 @@ module Make(Ord: OrderedType) = struct
             let rr = add x data r in
             if r == rr then m else bal l v d rr
 
-    let rec update x f = function
-        Empty ->
-          Node(Empty, x, f None, Empty, 1)
-      | Node(l, v, d, r, h) as m ->
-          let c = Ord.compare x v in
-          if c = 0 then
-            let data = f (Some d) in
-            if d == data then m else Node(l, x, data, r, h)
-          else if c < 0 then
-            let ll = update x f l in
-            if l == ll then m else bal ll v d r
-          else
-            let rr = update x f r in
-            if r == rr then m else bal l v d rr
-
     let rec find x = function
         Empty ->
           raise Not_found
@@ -280,6 +265,26 @@ module Make(Ord: OrderedType) = struct
           else
             let rr = remove x r in if r == rr then m else bal l v d rr
 
+    let rec update x f = function
+        Empty ->
+          begin match f None with
+          | None -> Empty
+          | Some data -> Node(Empty, x, data, Empty, 1)
+          end
+      | Node(l, v, d, r, h) as m ->
+          let c = Ord.compare x v in
+          if c = 0 then begin
+            match f (Some d) with
+            | None -> merge l r
+            | Some data ->
+                if d == data then m else Node(l, x, data, r, h)
+          end else if c < 0 then
+            let ll = update x f l in
+            if l == ll then m else bal ll v d r
+          else
+            let rr = update x f r in
+            if r == rr then m else bal l v d rr
+
     let rec iter f = function
         Empty -> ()
       | Node {l; v; d; r} ->

stdlib/map.mli

@@ -86,14 +86,16 @@ module type S =
        of [x] in [m] disappears.
        @before 4.03 Physical equality was not ensured. *)
 
-    val update: key -> ('a option -> 'a) -> 'a t -> 'a t
+    val update: key -> ('a option -> 'a option) -> 'a t -> 'a t
     (** [update x f m] returns a map containing the same bindings as
-        [m], plus a binding of [x] to [f z] where [z] is equal to
-        [find_opt x m].  If [x] was already bound in [m] to a value
-        that is physically equal to [f z], [m] is returned unchanged
-        (the result of the function is then physically equal to
-        [m]). Otherwise, the previous binding of [x] in [m]
-        disappears.  *)
+        [m], except for the binding of [x]. Depending on the value of
+        [y] where [y] is [f (find_opt x m)], the binding of [x] is
+        added, removed or updated. If [y] is [None], the binding is
+        removed if it exists; otherwise, if [y] is [Some z] then [x]
+        is associated to [z] in the resulting map.  If [x] was already
+        bound in [m] to a value that is physically equal to [z], [m]
+        is returned unchanged (the result of the function is then
+        physically equal to [m]).  *)
 
     val singleton: key -> 'a -> 'a t
     (** [singleton x y] returns the one-element map that contains a binding [y]

stdlib/moreLabels.mli

@@ -115,7 +115,7 @@ module Map : sig
       val is_empty: 'a t -> bool
       val mem : key -> 'a t -> bool
       val add : key:key -> data:'a -> 'a t -> 'a t
-      val update: key:key -> f:('a option -> 'a) -> 'a t -> 'a t
+      val update: key:key -> f:('a option -> 'a option) -> 'a t -> 'a t
       val singleton: key -> 'a -> 'a t
       val remove : key -> 'a t -> 'a t
       val merge:

testsuite/tests/typing-implicit_unpack/implicit_unpack.ml.reference

@@ -82,7 +82,7 @@ module type MapT =
     val is_empty : 'a t -> bool
     val mem : key -> 'a t -> bool
     val add : key -> 'a -> 'a t -> 'a t
-    val update : key -> ('a option -> 'a) -> 'a t -> 'a t
+    val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
     val singleton : key -> 'a -> 'a t
     val remove : key -> 'a t -> 'a t
     val merge :
@@ -129,7 +129,7 @@ module SSMap :
     val is_empty : 'a t -> bool
     val mem : key -> 'a t -> bool
     val add : key -> 'a -> 'a t -> 'a t
-    val update : key -> ('a option -> 'a) -> 'a t -> 'a t
+    val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
     val singleton : key -> 'a -> 'a t
     val remove : key -> 'a t -> 'a t
     val merge :

testsuite/tests/typing-short-paths/short-paths.ml.reference

@@ -20,7 +20,7 @@
             val is_empty : 'a t -> bool
             val mem : key -> 'a t -> bool
             val add : key -> 'a -> 'a t -> 'a t
-            val update : key -> ('a option -> 'a) -> 'a t -> 'a t
+            val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
             val singleton : key -> 'a -> 'a t
             val remove : key -> 'a t -> 'a t
             val merge :