Add Format.pp_print_iter and Format.pp_print_array (#10859)

6 files changed, 82 insertions, 21 deletions

diff --git a/Changes b/Changes
index b13ddbb6a4..2ff000d6aa 100644
--- a/Changes
+++ b/Changes
@@ -44,6 +44,9 @@ Working version
 - #11128: Add In_channel.isatty, Out_channel.isatty.
   (Nicolás Ojeda Bär, review by Gabriel Scherer and Florian Angeletti)
 
+- #10859: Add `Format.pp_print_iter` and `Format.pp_print_array`.
+  (Léo Andrès and Daniel Bünzli, review by David Allsopp and Hugo Heuzard)
+
 - #10789: Add `Stack.drop`
   (Léo Andrès, review by Gabriel Scherer)
 
diff --git a/stdlib/.depend b/stdlib/.depend
index 41f14fb66a..b13de05fd6 100644
--- a/stdlib/.depend
+++ b/stdlib/.depend
@@ -322,6 +322,7 @@ stdlib__Format.cmo : format.ml \
     camlinternalFormat.cmi \
     stdlib__Bytes.cmi \
     stdlib__Buffer.cmi \
+    stdlib__Array.cmi \
     stdlib__Format.cmi
 stdlib__Format.cmx : format.ml \
     stdlib__String.cmx \
@@ -337,6 +338,7 @@ stdlib__Format.cmx : format.ml \
     camlinternalFormat.cmx \
     stdlib__Bytes.cmx \
     stdlib__Buffer.cmx \
+    stdlib__Array.cmx \
     stdlib__Format.cmi
 stdlib__Format.cmi : format.mli \
     stdlib.cmi \
diff --git a/stdlib/format.ml b/stdlib/format.ml
index d8f7a934f1..669494be53 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -1250,30 +1250,25 @@ and set_tags v =
 
 (* Convenience functions *)
 
+let pp_print_iter ?(pp_sep = pp_print_cut) iter pp_v ppf v =
+  let is_first = ref true in
+  let pp_v v =
+    if !is_first then is_first := false else pp_sep ppf ();
+    pp_v ppf v
+  in
+  iter pp_v v
+
 (* To format a list *)
-let rec pp_print_list ?(pp_sep = pp_print_cut) pp_v ppf = function
-  | [] -> ()
-  | [v] -> pp_v ppf v
-  | v :: vs ->
-    pp_v ppf v;
-    pp_sep ppf ();
-    pp_print_list ~pp_sep pp_v ppf vs
+let pp_print_list ?(pp_sep = pp_print_cut) pp_v ppf v =
+  pp_print_iter ~pp_sep List.iter pp_v ppf v
 
-(* To format a sequence *)
-let rec pp_print_seq_in ~pp_sep pp_v ppf seq =
-  match seq () with
-  | Seq.Nil -> ()
-  | Seq.Cons (v, seq) ->
-    pp_sep ppf ();
-    pp_v ppf v;
-    pp_print_seq_in ~pp_sep pp_v ppf seq
+(* To format an array *)
+let pp_print_array ?(pp_sep = pp_print_cut) pp_v ppf v =
+  pp_print_iter ~pp_sep Array.iter pp_v ppf v
 
+(* To format a sequence *)
 let pp_print_seq ?(pp_sep = pp_print_cut) pp_v ppf seq =
-  match seq () with
-  | Seq.Nil -> ()
-  | Seq.Cons (v, seq) ->
-    pp_v ppf v;
-    pp_print_seq_in ~pp_sep pp_v ppf seq
+  pp_print_iter ~pp_sep Seq.iter pp_v ppf seq
 
 (* To format free-flowing text *)
 let pp_print_text ppf s =
diff --git a/stdlib/format.mli b/stdlib/format.mli
index 32e0850f6a..40748ff801 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -1152,17 +1152,43 @@ val formatter_of_symbolic_output_buffer : symbolic_output_buffer -> formatter
 
 (** {1 Convenience formatting functions.} *)
 
+val pp_print_iter :
+  ?pp_sep:(formatter -> unit -> unit) ->
+  (('a -> unit) -> 'b -> unit) ->
+  (formatter -> 'a -> unit) -> formatter -> 'b -> unit
+(** [pp_print_iter ~pp_sep iter pp_v ppf v] formats on [ppf] the iterations of
+  [iter] over a collection [v] of values using [pp_v]. Iterations are
+  separated by [pp_sep] (defaults to {!pp_print_cut}).
+
+  @since 5.1.0
+*)
+
 val pp_print_list:
   ?pp_sep:(formatter -> unit -> unit) ->
   (formatter -> 'a -> unit) -> (formatter -> 'a list -> unit)
 (** [pp_print_list ?pp_sep pp_v ppf l] prints items of list [l],
   using [pp_v] to print each item, and calling [pp_sep]
-  between items ([pp_sep] defaults to {!pp_print_cut}.
+  between items ([pp_sep] defaults to {!pp_print_cut}).
   Does nothing on empty lists.
 
   @since 4.02.0
 *)
 
+val pp_print_array:
+  ?pp_sep:(formatter -> unit -> unit) ->
+  (formatter -> 'a -> unit) -> (formatter -> 'a array -> unit)
+(** [pp_print_array ?pp_sep pp_v ppf a] prints items of array [a],
+  using [pp_v] to print each item, and calling [pp_sep]
+  between items ([pp_sep] defaults to {!pp_print_cut}).
+  Does nothing on empty arrays.
+
+  If [a] is mutated after [pp_print_array] is called, the printed values
+  may not be what is expected because [Format] can delay the printing.
+  This can be avoided by flushing [ppf].
+
+  @since 5.1.0
+*)
+
 val pp_print_seq:
   ?pp_sep:(formatter -> unit -> unit) ->
   (formatter -> 'a -> unit) -> (formatter -> 'a Seq.t -> unit)
diff --git a/testsuite/tests/lib-format/print_array.ml b/testsuite/tests/lib-format/print_array.ml
new file mode 100644
index 0000000000..dc6481c884
--- /dev/null
+++ b/testsuite/tests/lib-format/print_array.ml
@@ -0,0 +1,28 @@
+(* TEST
+   include testing
+*)
+
+(*
+
+A test file for the Format module.
+
+*)
+
+open Testing;;
+open Format;;
+
+let say s = Printf.printf (s ^^ "\n%!");;
+
+let pp_print_intarray = pp_print_array ~pp_sep:(fun fmt () -> pp_print_char fmt ' ') pp_print_int;;
+
+let () =
+
+  say "empty";
+  test (asprintf "%a" pp_print_intarray [||] = "");
+
+  say "\nmisc";
+  test (asprintf "%a" pp_print_intarray [| 0 |]       = "0");
+  test (asprintf "%a" pp_print_intarray [| 0; 1; 2 |] = "0 1 2");
+  test (asprintf "%a" pp_print_intarray [| 0; 0 |]    = "0 0");
+
+  say "\nend of tests"
diff --git a/testsuite/tests/lib-format/print_array.reference b/testsuite/tests/lib-format/print_array.reference
new file mode 100644
index 0000000000..1b34bf6898
--- /dev/null
+++ b/testsuite/tests/lib-format/print_array.reference
@@ -0,0 +1,7 @@
+empty
+ 0
+misc
+ 1 2 3
+end of tests
+
+All tests succeeded.