Add Pp.Fmt_labelled module

Summary:
`Fmt` provides two very useful `iter` and `iter_bindings` functions that can be used to pretty-print
data-structures using their iterator functions.

Those iterator are expected to follow the "stdlib" style, taking their arguments (in particular, the
`'a -> unit` function being called) without labels. However, the Core library uses a different
convention, with some labels added here and there.

This commit provides adapters for `iter` and `iter_bindings` that expect there arguments to be
Core-style iterators. This makes it easier to define pretty-printers for Core-based data structures.

Reviewed By: jvillard

Differential Revision: D45357585

fbshipit-source-id: 15c51ca3a16ddbab3fcfcf369c78acd975747f7d

infer/src/checkers/SimpleLineage.ml

@@ -769,9 +769,7 @@ end = struct
 
     let pp pp_data =
       let sep = Fmt.any ":@ " in
-      Fmt.iter_bindings ~sep:Fmt.comma
-        (fun f -> iteri ~f:(fun ~key ~data -> f key data))
-        Fmt.(pair ~sep int pp_data)
+      IFmt.Labelled.iter_bindings ~sep:Fmt.comma iteri Fmt.(pair ~sep int pp_data)
   end
 
   (** A [Tito.t] is a map from arguments indexes [i] to the set of [fields] field sequences such

infer/src/checkers/SimpleShape.ml

@@ -204,9 +204,7 @@ end = struct
     let sep = Fmt.semi in
     let pp_binding = pp_binding ~bind pp_key pp_value in
     Format.fprintf fmt "@[(%a)@]"
-      (Fmt.iter_bindings ~sep
-         (fun f -> Hashtbl.iteri ~f:(fun ~key ~data -> f key data))
-         pp_binding )
+      (IFmt.Labelled.iter_bindings ~sep Hashtbl.iteri pp_binding)
       hashtbl
 
 
@@ -248,7 +246,8 @@ end = struct
       Format.fprintf fmt "@[<v>@[<v4>VAR_SHAPES@ @[%a@]@]@ @[<v4>SHAPE_FIELDS@ @[%a@]@]@]"
         (pp_hashtbl ~bind:pp_arrow Var.pp pp_shape)
         var_shapes
-        (pp_hashtbl ~bind:pp_arrow Shape_id.pp (pp_hashtbl ~bind:Pp.colon_sp Fieldname.pp pp_shape))
+        (pp_hashtbl ~bind:pp_arrow Shape_id.pp
+           (pp_hashtbl ~bind:IFmt.colon_sp Fieldname.pp pp_shape) )
         shape_fields
 
 
@@ -343,7 +342,7 @@ end = struct
         (pp_caml_hashtbl ~bind:pp_arrow Var.pp Shape_id.pp)
         var_shapes
         (pp_caml_hashtbl ~bind:pp_arrow Shape_id.pp
-           (pp_caml_hashtbl ~bind:Pp.colon_sp Fieldname.pp Shape_id.pp) )
+           (pp_caml_hashtbl ~bind:IFmt.colon_sp Fieldname.pp Shape_id.pp) )
         shape_fields
 
 
@@ -469,7 +468,7 @@ end = struct
 
     let pp_field_table field_table =
       Fmt.iter_bindings ~sep:Fmt.comma Caml.Hashtbl.iter
-        (Fmt.pair ~sep:Pp.colon_sp Fieldname.pp Shape_id.pp)
+        (Fmt.pair ~sep:IFmt.colon_sp Fieldname.pp Shape_id.pp)
         field_table
 
 

infer/src/istd/IFmt.ml

@@ -0,0 +1,20 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+open! IStd
+
+let colon_sp ppf _ =
+  Format.pp_print_string ppf ":" ;
+  Fmt.sp ppf ()
+
+
+module Labelled = struct
+  let iter ?sep iter pp_elt = Fmt.iter ?sep (fun f x -> iter x ~f) pp_elt
+
+  let iter_bindings ?sep iteri pp_binding =
+    Fmt.iter_bindings ?sep (fun f x -> iteri x ~f:(fun ~key ~data -> f key data)) pp_binding
+end

infer/src/istd/IFmt.mli

@@ -0,0 +1,27 @@
+(*
+ * Copyright (c) Facebook, Inc. and its affiliates.
+ *
+ * This source code is licensed under the MIT license found in the
+ * LICENSE file in the root directory of this source tree.
+ *)
+
+(** Low-level combinators built on {!Fmt}. Sophisticated pretty-printing functions should rather go
+    in {!Pp}. *)
+
+val colon_sp : 'a Fmt.t
+(** [colon_sp] is [Fmt.any ":@ "]. It prints a colon and a space break hint. *)
+
+module Labelled : sig
+  (** Adapters of {!Fmt} functions using labelled interfaces *)
+
+  val iter : ?sep:unit Fmt.t -> ('a -> f:('elt -> unit) -> unit) -> 'elt Fmt.t -> 'a Fmt.t
+    [@@warning "-unused-value-declaration"]
+  (** {!Fmt.iter} using a Core-style labelled iterator function *)
+
+  val iter_bindings :
+       ?sep:unit Fmt.t
+    -> ('a -> f:(key:'key -> data:'data -> unit) -> unit)
+    -> ('key * 'data) Fmt.t
+    -> 'a Fmt.t
+  (** {!Fmt.iter_bindings} using a Core-style (key, data) labelled iterator function *)
+end

infer/src/istd/Pp.ml

@@ -115,11 +115,6 @@ let color_wrapper pe ppf x ~f =
       f pe ppf x
 
 
-let colon_sp ppf _ =
-  Format.pp_print_string ppf ":" ;
-  Fmt.sp ppf ()
-
-
 let seq ?(print_env = text) ?sep:(sep_text = " ") ?(sep_html = sep_text) pp =
   let rec aux f = function
     | [] ->

infer/src/istd/Pp.mli

@@ -64,9 +64,6 @@ val color_string : color -> string
 
 val html_with_color : color -> (F.formatter -> 'a -> unit) -> F.formatter -> 'a -> unit
 
-val colon_sp : F.formatter -> 'a -> unit
-(** [colon_sp] is [Fmt.any ":@ "]. It prints a colon and a space break hint. *)
-
 val option : (F.formatter -> 'a -> unit) -> F.formatter -> 'a option -> unit
 
 val cli_args : F.formatter -> string list -> unit