Add fmt and pp to Map, Set, Ordmap, and Ordset

Add formatters and pretty printers to the map and set collections, using
associative list and list syntactic representations, respectively. Sort the
unordered map/set contents to avoid unnecessary output instability.

bootstrap/src/basis/formattableIntf.ml

@@ -1,14 +1,14 @@
 (** Formattable type functor signature. *)
 
-(** Monomorphic Fmt pretty printing conversion functions. *)
+(** Monomorphic Fmt pretty printing function. *)
 module type SMono = sig
   type t
 
   val pp: t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
   (** [pp t formatter] applies a formatted representation of [t] to the [formatter]. *)
 end
 
-(** Polymorphic Fmt pretty printing conversion functions. *)
+(** Polymorphic Fmt pretty printing function. *)
 module type SPoly = sig
   type 'a t
 
@@ -18,7 +18,7 @@ module type SPoly = sig
         [pp_a] for the parametric type value [a]. *)
 end
 
-(** Polymorphic Fmt pretty printing conversion functions. *)
+(** Polymorphic Fmt pretty printing function. *)
 module type SPoly2 = sig
   type ('a, 'b) t
 

bootstrap/src/basis/map.ml

@@ -939,10 +939,25 @@ end
 let to_array t =
   SetToArray.(to_array (init t))
 
+let fmt ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) fmt_v t formatter =
+  let kvcmp (k0, _) (k1, _) = t.cmper.cmp k0 k1 in
+  let t_sorted = Array.sort ~cmp:kvcmp (to_array t) |> Array.to_list in
+  List.fmt ~alt ~width (fun (k, v) formatter ->
+    formatter
+    |> Fmt.fmt "("
+    |> t.cmper.pp k
+    |> Fmt.fmt ", "
+    |> fmt_v v
+    |> Fmt.fmt ")"
+  ) t_sorted formatter
+
+let pp fmt_v t formatter =
+  fmt fmt_v t formatter
+
 (**************************************************************************************************)
 (* Begin test support. *)
 
-let fmt ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) fmt_v t formatter =
+let fmt_internals ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) fmt_v t formatter =
   let fmt_sep ~alt ~width ?(edge=false) formatter = begin
     formatter
     |> Fmt.fmt (match alt, edge with true, _ -> "\n" | false, false -> "; " | false, true -> "")

bootstrap/src/basis/map.mli

@@ -9,6 +9,7 @@ val bits_per_level: Uns.t
 val bits_per_hash: Uns.t
 val hash_fold: ('v -> Hash.State.t -> Hash.State.t) -> ('k, 'v, 'cmp) t -> Hash.State.t
   -> Hash.State.t
-val fmt: ?alt:bool -> ?width:int64 -> ('v -> (module Fmt.Formatter) -> (module Fmt.Formatter))
-  -> ('k, 'v, 'cmp) t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
+val fmt_internals: ?alt:bool -> ?width:int64
+  -> ('v -> (module Fmt.Formatter) -> (module Fmt.Formatter)) -> ('k, 'v, 'cmp) t
+  -> (module Fmt.Formatter) -> (module Fmt.Formatter)
 val validate: ('k, 'v, 'cmp) t -> unit

bootstrap/src/basis/mapIntf.ml

@@ -42,6 +42,19 @@ module type S = sig
   val cmper: ('k, 'v, 'cmp) t -> ('k, 'cmp) Cmper.t
   (** [cmper t] returns the comparator associated with the map [t]. *)
 
+  (** {1 Formatting} *)
+
+  val fmt: ?alt:bool -> ?width:int64 -> ('v -> (module Fmt.Formatter) -> (module Fmt.Formatter))
+    -> ('k, 'v, 'cmp) t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
+  (** [fmt ~alt ~width fmt_v t] uses the [fmt_v] formatter to format a syntactically valid
+      associative list representation of [t]. If [~alt=true], the output is broken across multiple
+      lines with outermost indentation [~width] (elements are indented to [~width + 4]). *)
+
+  val pp: ('v -> (module Fmt.Formatter) -> (module Fmt.Formatter))
+    -> ('k, 'v, 'cmp) t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
+  (** [pp pp_v t formatter] applies a formatted representation of [t] to the [formatter] using
+      [pp_v] for the parametric type value [v]. *)
+
   (** {1 Creation} *)
 
   val empty: ('k, 'cmp) cmper -> ('k, 'v, 'cmp) t

bootstrap/src/basis/ordmap.ml

@@ -1220,10 +1220,23 @@ let reduce_hlt ~f t =
   | None -> halt "Empty map"
   | Some v -> v
 
+let fmt ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) fmt_v t formatter =
+  List.fmt ~alt ~width (fun (k, v) formatter ->
+    formatter
+    |> Fmt.fmt "("
+    |> t.cmper.pp k
+    |> Fmt.fmt ", "
+    |> fmt_v v
+    |> Fmt.fmt ")"
+  ) (to_alist t) formatter
+
+let pp fmt_v t formatter =
+  fmt fmt_v t formatter
+
 (**************************************************************************************************)
 (* Begin test support. *)
 
-let fmt ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) fmt_v t formatter =
+let fmt_internals ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) fmt_v t formatter =
   let fmt_sep ~alt ~width ?(edge=false) formatter = begin
     formatter
     |> Fmt.fmt (match alt, edge with true, _ -> "\n" | false, false -> "; " | false, true -> "")

bootstrap/src/basis/ordmap.mli

@@ -5,6 +5,7 @@ type ('k, 'v, 'cmp) t
 include MapIntf.SOrd with type ('k, 'v, 'cmp) t := ('k, 'v, 'cmp) t
 
 (* Exposed for testing purposes only. *)
-val fmt: ?alt:bool -> ?width:int64 -> ('v -> (module Fmt.Formatter) -> (module Fmt.Formatter))
-  -> ('k, 'v, 'cmp) t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
+val fmt_internals: ?alt:bool -> ?width:int64
+  -> ('v -> (module Fmt.Formatter) -> (module Fmt.Formatter)) -> ('k, 'v, 'cmp) t
+  -> (module Fmt.Formatter) -> (module Fmt.Formatter)
 val validate: ('k, 'v, 'cmp) t -> unit

bootstrap/src/basis/ordset.ml

@@ -147,3 +147,9 @@ let reduce ~f t =
 
 let reduce_hlt ~f t =
   Ordmap.kreduce_hlt ~f t
+
+let fmt ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) t formatter =
+  List.fmt ~alt ~width (cmper t).pp (to_list t) formatter
+
+let pp t formatter =
+  fmt t formatter

bootstrap/src/basis/set.ml

@@ -137,3 +137,11 @@ end
 
 let to_array t =
   SetToArray.(to_array (init t))
+
+let fmt ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) t formatter =
+  let cmper = cmper t in
+  let t_sorted = Array.sort ~cmp:cmper.cmp (to_array t) |> Array.to_list in
+  List.fmt ~alt ~width cmper.pp t_sorted formatter
+
+let pp t formatter =
+  fmt t formatter

bootstrap/src/basis/setIntf.ml

@@ -40,6 +40,17 @@ module type S = sig
   val cmper: ('a, 'cmp) t -> ('a, 'cmp) Cmper.t
   (** [cmper t] returns the comparator associated with [t]. *)
 
+  (** {1 Formatting} *)
+
+  val fmt: ?alt:bool -> ?width:uns -> ('a, 'cmp) t -> (module Fmt.Formatter)
+    -> (module Fmt.Formatter)
+  (** [fmt ~alt ~width t] formats a syntactically valid list representation of [t]. If [~alt=true],
+      the output is broken across multiple lines with outermost indentation [~width] (elements are
+      indented to [~width + 4]). *)
+
+  val pp: ('a, 'cmp) t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
+  (** [pp t formatter] applies a formatted representation of [t] to the [formatter]. *)
+
   (** {1 Creation} *)
 
   val empty: ('a, 'cmp) cmper -> ('a, 'cmp) t

bootstrap/test/basis/map/dune

@@ -5,6 +5,7 @@
   test_empty_cmper_m_singleton_length
   test_filter
   test_filter_map
+  test_fmt
   test_fold2
   test_fold_until
   test_fold2_until

bootstrap/test/basis/map/test_empty_cmper_m_singleton_length.ml

@@ -8,15 +8,15 @@ let test () =
   validate e;
   assert (length e = 0L);
   File.Fmt.stdout
-  |> (fmt ~alt:true Unit.pp) e
+  |> (fmt_internals ~alt:true Unit.pp) e
   |> Fmt.fmt "\n"
   |> ignore;
 
   let s = singleton (cmper_m e) ~k:0L ~v:"0" in
   validate s;
   assert (length s = 1L);
   File.Fmt.stdout
-  |> (fmt ~alt:true String.pp) s
+  |> (fmt_internals ~alt:true String.pp) s
   |> Fmt.fmt "\n"
   |> ignore
 

bootstrap/test/basis/map/test_fmt.expected

@@ -0,0 +1,5 @@
+fmt (of_klist []) -> []
+fmt (of_klist [0]) -> [(0, 0)]
+fmt (of_klist [0; 1]) -> [(0, 0); (1, 100)]
+fmt (of_klist [0; 2]) -> [(0, 0); (2, 200)]
+fmt (of_klist [2; 3]) -> [(2, 200); (3, 300)]

bootstrap/test/basis/map/test_fmt.ml

@@ -0,0 +1,32 @@
+open! Basis.Rudiments
+open! Basis
+open MapTest
+open Map
+
+let test () =
+  let rec fn = function
+    | [] -> ()
+    | l :: lists' -> begin
+        let map = of_klist l in
+        File.Fmt.stdout
+        |> Fmt.fmt "fmt (of_klist "
+        |> (List.pp Uns.pp) l
+        |> Fmt.fmt ") -> "
+        |> fmt Uns.pp map
+        |> Fmt.fmt "\n"
+        |> ignore;
+        fn lists'
+      end
+  in
+  (* NB: [0; 1] and [0; 2] collide. This is because we're using UnsTestCmper to get stable test
+   * output; the hashing results from all but the last binding hashed are discarded. *)
+  let lists = [
+    [];
+    [0L];
+    [0L; 1L];
+    [0L; 2L];
+    [2L; 3L]
+  ] in
+  fn lists
+
+let _ = test ()

bootstrap/test/basis/map/test_iter2_equal_subset_disjoint.ml

@@ -18,9 +18,9 @@ let test () =
       | Some _, None -> begin
           File.Fmt.stdout
           |> Fmt.fmt "Should be equal: "
-          |> (fmt Uns.pp) map0
+          |> (fmt_internals Uns.pp) map0
           |> Fmt.fmt " "
-          |> (fmt Uns.pp) map1
+          |> (fmt_internals Uns.pp) map1
           |> Fmt.fmt "\n"
           |> ignore;
           assert false;
@@ -40,9 +40,9 @@ let test () =
       | Some _, Some _ -> begin
           File.Fmt.stdout
           |> Fmt.fmt "Should be disjoint: "
-          |> (fmt Uns.pp) map0
+          |> (fmt_internals Uns.pp) map0
           |> Fmt.fmt " "
-          |> (fmt Uns.pp) map1
+          |> (fmt_internals Uns.pp) map1
           |> Fmt.fmt "\n"
           |> ignore;
           assert false;

bootstrap/test/basis/map/test_of_alist_remove.ml

@@ -17,9 +17,9 @@ let test () =
     |> Fmt.fmt "remove "
     |> Uns.pp k
     |> Fmt.fmt "\n"
-    |> (fmt ~alt:true String.pp) map
+    |> (fmt_internals ~alt:true String.pp) map
     |> Fmt.fmt " ->\n"
-    |> (fmt ~alt:true String.pp) map'
+    |> (fmt_internals ~alt:true String.pp) map'
     |> Fmt.fmt "\n"
     |> ignore
   end in

bootstrap/test/basis/map/test_of_alist_remove_hlt.ml

@@ -17,9 +17,9 @@ let test () =
     |> Fmt.fmt "remove_hlt "
     |> Uns.pp k
     |> Fmt.fmt "\n"
-    |> (fmt ~alt:true String.pp) map
+    |> (fmt_internals ~alt:true String.pp) map
     |> Fmt.fmt " ->\n"
-    |> (fmt ~alt:true String.pp) map'
+    |> (fmt_internals ~alt:true String.pp) map'
     |> Fmt.fmt "\n"
     |> ignore
   end in

bootstrap/test/basis/ordmap/dune

@@ -7,6 +7,7 @@
   test_filter_map
   test_filteri
   test_filteri_map
+  test_fmt
   test_fold_right_until
   test_fold_until
   test_fold2

bootstrap/test/basis/ordmap/test_empty_cmper_m_singleton_length.ml

@@ -7,11 +7,11 @@ let test () =
   let e = empty (module Uns) in
   validate e;
   assert (length e = 0L);
-  File.Fmt.stdout |> (fmt Unit.pp) e |> Fmt.fmt "\n" |> ignore;
+  File.Fmt.stdout |> (fmt_internals Unit.pp) e |> Fmt.fmt "\n" |> ignore;
 
   let s = singleton (cmper_m e) ~k:0L ~v:"zero" in
   validate s;
   assert (length s = 1L);
-  File.Fmt.stdout |> (fmt String.pp) s |> Fmt.fmt "\n" |> ignore
+  File.Fmt.stdout |> (fmt_internals String.pp) s |> Fmt.fmt "\n" |> ignore
 
 let _ = test ()

bootstrap/test/basis/ordmap/test_fmt.expected

@@ -0,0 +1,5 @@
+fmt (of_klist []) -> []
+fmt (of_klist [0]) -> [(0, 0)]
+fmt (of_klist [0; 1]) -> [(0, 0); (1, 100)]
+fmt (of_klist [0; 2]) -> [(0, 0); (2, 200)]
+fmt (of_klist [2; 3]) -> [(2, 200); (3, 300)]

bootstrap/test/basis/ordmap/test_fmt.ml

@@ -0,0 +1,30 @@
+open! Basis.Rudiments
+open! Basis
+open OrdmapTest
+open Ordmap
+
+let test () =
+  let rec fn = function
+    | [] -> ()
+    | l :: lists' -> begin
+        let ordmap = of_klist l in
+        File.Fmt.stdout
+        |> Fmt.fmt "fmt (of_klist "
+        |> (List.pp Uns.pp) l
+        |> Fmt.fmt ") -> "
+        |> fmt Uns.pp ordmap
+        |> Fmt.fmt "\n"
+        |> ignore;
+        fn lists'
+      end
+  in
+  let lists = [
+    [];
+    [0L];
+    [0L; 1L];
+    [0L; 2L];
+    [2L; 3L]
+  ] in
+  fn lists
+
+let _ = test ()

bootstrap/test/basis/ordmap/test_iter2_equal_subset_disjoint.ml

@@ -18,9 +18,9 @@ let test () =
       | Some _, None -> begin
           File.Fmt.stdout
           |> Fmt.fmt "Should be equal: "
-          |> (fmt Uns.pp) ordmap0
+          |> (fmt_internals Uns.pp) ordmap0
           |> Fmt.fmt ", "
-          |> (fmt Uns.pp) ordmap1
+          |> (fmt_internals Uns.pp) ordmap1
           |> Fmt.fmt "\n"
           |> ignore;
           assert false;
@@ -40,9 +40,9 @@ let test () =
       | Some _, Some _ -> begin
           File.Fmt.stdout
           |> Fmt.fmt "Should be disjoint: "
-          |> (fmt Uns.pp) ordmap0
+          |> (fmt_internals Uns.pp) ordmap0
           |> Fmt.fmt ", "
-          |> (fmt Uns.pp) ordmap1
+          |> (fmt_internals Uns.pp) ordmap1
           |> Fmt.fmt "\n"
           |> ignore;
           assert false;

bootstrap/test/basis/ordmap/test_of_alist_remove.ml

@@ -17,9 +17,9 @@ let test () =
     |> Fmt.fmt "remove "
     |> Uns.pp k
     |> Fmt.fmt "\n    "
-    |> (fmt ~alt:true ~width:4L String.pp) ordmap
+    |> (fmt_internals ~alt:true ~width:4L String.pp) ordmap
     |> Fmt.fmt " ->\n    "
-    |> (fmt ~alt:true ~width:4L String.pp) ordmap'
+    |> (fmt_internals ~alt:true ~width:4L String.pp) ordmap'
     |> Fmt.fmt "\n"
     |> ignore
   end in

bootstrap/test/basis/ordmap/test_of_alist_remove_hlt.ml

@@ -17,9 +17,9 @@ let test () =
     |> Fmt.fmt "remove_hlt "
     |> Uns.pp k
     |> Fmt.fmt "\n    "
-    |> (fmt ~alt:true ~width:4L String.pp) ordmap
+    |> (fmt_internals ~alt:true ~width:4L String.pp) ordmap
     |> Fmt.fmt " ->\n    "
-    |> (fmt ~alt:true ~width:4L String.pp) ordmap'
+    |> (fmt_internals ~alt:true ~width:4L String.pp) ordmap'
     |> Fmt.fmt "\n"
     |> ignore
   end in

bootstrap/test/basis/ordmap/test_of_array.ml

@@ -10,7 +10,7 @@ let test () =
     |> Fmt.fmt "of_array "
     |> (Array.pp (pp_kv_pair String.pp)) kvs
     |> Fmt.fmt " -> "
-    |> (fmt ~alt:true String.pp) ordmap
+    |> (fmt_internals ~alt:true String.pp) ordmap
     |> Fmt.fmt "\n"
     |> ignore;
     validate ordmap

bootstrap/test/basis/ordmap/test_search_nth.ml

@@ -6,7 +6,7 @@ open Ordmap
 let test () =
   let test_search ordmap (key_max:uns) = begin
     File.Fmt.stdout
-    |> (fmt Uns.pp) ordmap
+    |> (fmt_internals Uns.pp) ordmap
     |> Fmt.fmt "\n"
     |> ignore;
     Range.Uns.iter (0L =:= key_max) ~f:(fun probe ->