Define to_rev_seq in Set and Map module (#9075)

Changes

@@ -30,6 +30,9 @@ Working version
   or function, including any enclosing module or class.
   (Nicolás Ojeda Bär, Stephen Dolan, review by Stephen Dolan)
 
+- #9075: define to_rev_seq in Set and Map modules.
+  (Sébastien Briais, review by Gabriel Scherer and Nicolás Ojeda Bär)
+
 ### Other libraries:
 
 * #9206, #9419: update documentation of the threads library;

stdlib/map.ml

@@ -60,6 +60,7 @@ module type S =
     val map: ('a -> 'b) -> 'a t -> 'b t
     val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t
     val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_rev_seq : 'a t -> (key * 'a) Seq.t
     val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
     val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
     val of_seq : (key * 'a) Seq.t -> 'a t
@@ -508,6 +509,19 @@ module Make(Ord: OrderedType) = struct
     let to_seq m =
       seq_of_enum_ (cons_enum m End)
 
+    let rec snoc_enum s e =
+      match s with
+        Empty -> e
+      | Node{l; v; d; r} -> snoc_enum r (More(v, d, l, e))
+
+    let rec rev_seq_of_enum_ c () = match c with
+      | End -> Seq.Nil
+      | More (k,v,t,rest) ->
+          Seq.Cons ((k,v), rev_seq_of_enum_ (snoc_enum t rest))
+
+    let to_rev_seq c =
+      rev_seq_of_enum_ (snoc_enum c End)
+
     let to_seq_from low m =
       let rec aux low m c = match m with
         | Empty -> c

stdlib/map.mli

@@ -332,6 +332,10 @@ module type S =
     (** Iterate on the whole map, in ascending order of keys
         @since 4.07 *)
 
+    val to_rev_seq : 'a t -> (key * 'a) Seq.t
+    (** Iterate on the whole map, in descending order of keys
+        @since 4.12 *)
+
     val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
     (** [to_seq_from k m] iterates on a subset of the bindings of [m],
         in ascending order of keys, from key [k] or above.

stdlib/moreLabels.mli

@@ -172,6 +172,7 @@ module Map : sig
       val map : f:('a -> 'b) -> 'a t -> 'b t
       val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t
       val to_seq : 'a t -> (key * 'a) Seq.t
+      val to_rev_seq : 'a t -> (key * 'a) Seq.t
       val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
       val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
       val of_seq : (key * 'a) Seq.t -> 'a t
@@ -226,6 +227,7 @@ module Set : sig
       val of_list: elt list -> t
       val to_seq_from : elt -> t -> elt Seq.t
       val to_seq : t -> elt Seq.t
+      val to_rev_seq : t -> elt Seq.t
       val add_seq : elt Seq.t -> t -> t
       val of_seq : elt Seq.t -> t
     end

stdlib/set.ml

@@ -64,6 +64,7 @@ module type S =
     val of_list: elt list -> t
     val to_seq_from : elt -> t -> elt Seq.t
     val to_seq : t -> elt Seq.t
+    val to_rev_seq : t -> elt Seq.t
     val add_seq : elt Seq.t -> t -> t
     val of_seq : elt Seq.t -> t
   end
@@ -594,6 +595,17 @@ module Make(Ord: OrderedType) =
 
     let to_seq c = seq_of_enum_ (cons_enum c End)
 
+    let rec snoc_enum s e =
+      match s with
+        Empty -> e
+      | Node{l; v; r} -> snoc_enum r (More(v, l, e))
+
+    let rec rev_seq_of_enum_ c () = match c with
+      | End -> Seq.Nil
+      | More (x, t, rest) -> Seq.Cons (x, rev_seq_of_enum_ (snoc_enum t rest))
+
+    let to_rev_seq c = rev_seq_of_enum_ (snoc_enum c End)
+
     let to_seq_from low s =
       let rec aux low s c = match s with
         | Empty -> c

stdlib/set.mli

@@ -291,6 +291,10 @@ module type S =
     (** Iterate on the whole set, in ascending order
         @since 4.07 *)
 
+    val to_rev_seq : t -> elt Seq.t
+    (** Iterate on the whole set, in descending order
+        @since 4.12 *)
+
     val add_seq : elt Seq.t -> t -> t
     (** Add the given elements to the set, in order.
         @since 4.07 *)

testsuite/tests/generalized-open/accepted_expect.ml

@@ -45,6 +45,7 @@ val find_last_opt : (elt -> bool) -> t -> elt option = <fun>
 val of_list : elt list -> t = <fun>
 val to_seq_from : elt -> t -> elt Seq.t = <fun>
 val to_seq : t -> elt Seq.t = <fun>
+val to_rev_seq : t -> elt Seq.t = <fun>
 val add_seq : elt Seq.t -> t -> t = <fun>
 val of_seq : elt Seq.t -> t = <fun>
 |}]

testsuite/tests/lib-set/testmap.ml

@@ -177,6 +177,9 @@ let test x v s1 s2 =
   checkbool "to_seq_of_seq"
     (M.equal (=) s1 (M.of_seq @@ M.to_seq s1));
 
+  checkbool "to_rev_seq_of_seq"
+    (M.equal (=) s1 (M.of_seq @@ M.to_rev_seq s1));
+
   checkbool "to_seq_from"
     (let seq = M.to_seq_from x s1 in
      let ok1 = List.of_seq seq |> List.for_all (fun (y,_) -> y >= x) in
@@ -187,6 +190,18 @@ let test x v s1 s2 =
      in
      ok1 && ok2);
 
+  checkbool "to_seq_increasing"
+    (let seq = M.to_seq s1 in
+     let last = ref min_int in
+     Seq.iter (fun (x, _) -> assert (!last <= x); last := x) seq;
+     true);
+
+  checkbool "to_rev_seq_decreasing"
+    (let seq = M.to_rev_seq s1 in
+     let last = ref max_int in
+     Seq.iter (fun (x, _) -> assert (x <= !last); last := x) seq;
+     true);
+
   ()
 
 let rkey() = Random.int 10

testsuite/tests/lib-set/testset.ml

@@ -190,6 +190,9 @@ let test x s1 s2 =
   checkbool "to_seq_of_seq"
     (S.equal s1 (S.of_seq @@ S.to_seq s1));
 
+  checkbool "to_seq_of_seq"
+    (S.equal s1 (S.of_seq @@ S.to_rev_seq s1));
+
   checkbool "to_seq_from"
     (let seq = S.to_seq_from x s1 in
      let ok1 = List.of_seq seq |> List.for_all (fun y -> y >= x) in
@@ -200,6 +203,18 @@ let test x s1 s2 =
      in
      ok1 && ok2);
 
+  checkbool "to_seq_increasing"
+    (let seq = S.to_seq s1 in
+     let last = ref min_int in
+     Seq.iter (fun x -> assert (!last <= x); last := x) seq;
+     true);
+
+  checkbool "to_rev_seq_decreasing"
+    (let seq = S.to_rev_seq s1 in
+     let last = ref max_int in
+     Seq.iter (fun x -> assert (x <= !last); last := x) seq;
+     true);
+
   ()
 
 let relt() = Random.int 10

testsuite/tests/typing-implicit_unpack/implicit_unpack.ml

@@ -341,6 +341,7 @@ module type MapT =
     val map : ('a -> 'b) -> 'a t -> 'b t
     val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
     val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_rev_seq : 'a t -> (key * 'a) Seq.t
     val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
     val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
     val of_seq : (key * 'a) Seq.t -> 'a t
@@ -393,6 +394,7 @@ module SSMap :
     val map : ('a -> 'b) -> 'a t -> 'b t
     val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
     val to_seq : 'a t -> (key * 'a) Seq.t
+    val to_rev_seq : 'a t -> (key * 'a) Seq.t
     val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
     val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
     val of_seq : (key * 'a) Seq.t -> 'a t

testsuite/tests/typing-modules/aliases.ml

@@ -318,6 +318,7 @@ module StringSet :
     val of_list : elt list -> t
     val to_seq_from : elt -> t -> elt Seq.t
     val to_seq : t -> elt Seq.t
+    val to_rev_seq : t -> elt Seq.t
     val add_seq : elt Seq.t -> t -> t
     val of_seq : elt Seq.t -> t
   end
@@ -364,6 +365,7 @@ module SSet :
     val of_list : elt list -> t
     val to_seq_from : elt -> t -> elt Seq.t
     val to_seq : t -> elt Seq.t
+    val to_rev_seq : t -> elt Seq.t
     val add_seq : elt Seq.t -> t -> t
     val of_seq : elt Seq.t -> t
   end
@@ -442,6 +444,7 @@ module A :
         val of_list : elt list -> t
         val to_seq_from : elt -> t -> elt Seq.t
         val to_seq : t -> elt Seq.t
+        val to_rev_seq : t -> elt Seq.t
         val add_seq : elt Seq.t -> t -> t
         val of_seq : elt Seq.t -> t
       end
@@ -555,6 +558,7 @@ module SInt :
     val of_list : elt list -> t
     val to_seq_from : elt -> t -> elt Seq.t
     val to_seq : t -> elt Seq.t
+    val to_rev_seq : t -> elt Seq.t
     val add_seq : elt Seq.t -> t -> t
     val of_seq : elt Seq.t -> t
   end

testsuite/tests/typing-modules/pr7818.ml

@@ -274,6 +274,7 @@ module MkT :
       val of_list : elt list -> t
       val to_seq_from : elt -> t -> elt Seq.t
       val to_seq : t -> elt Seq.t
+      val to_rev_seq : t -> elt Seq.t
       val add_seq : elt Seq.t -> t -> t
       val of_seq : elt Seq.t -> t
     end

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

@@ -54,6 +54,7 @@ module Core :
             val map : ('a -> 'b) -> 'a t -> 'b t
             val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
             val to_seq : 'a t -> (key * 'a) Seq.t
+            val to_rev_seq : 'a t -> (key * 'a) Seq.t
             val to_seq_from : key -> 'a t -> (key * 'a) Seq.t
             val add_seq : (key * 'a) Seq.t -> 'a t -> 'a t
             val of_seq : (key * 'a) Seq.t -> 'a t