Move fmt to stdune

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/import.ml

@@ -96,62 +96,6 @@ module No_io = struct
   module Io = struct end
 end
 
-module Fmt = struct
-  (* CR-someday diml: we should define a GADT for this:
-
-     {[
-       type 'a t =
-         | Int : int t
-         | Box : ...
-         | Colored : ...
-     ]}
-
-     This way we could separate the creation of messages from the
-     actual rendering.
-  *)
-  type 'a t = Format.formatter -> 'a -> unit
-
-  let kstrf f fmt =
-    let buf = Buffer.create 17 in
-    let f fmt = Format.pp_print_flush fmt () ; f (Buffer.contents buf) in
-    Format.kfprintf f (Format.formatter_of_buffer buf) fmt
-
-  let failwith fmt = kstrf failwith fmt
-
-  let list = Format.pp_print_list
-  let string s ppf = Format.pp_print_string ppf s
-
-  let nl = Format.pp_print_newline
-
-  let prefix f g ppf x = f ppf; g ppf x
-
-  let ocaml_list pp fmt = function
-    | [] -> Format.pp_print_string fmt "[]"
-    | l ->
-      Format.fprintf fmt "@[<hv>[ %a@ ]@]"
-        (list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
-           pp) l
-
-  let quoted fmt = Format.fprintf fmt "%S"
-
-  let const
-    : 'a t -> 'a -> unit t
-    = fun pp a' fmt () -> pp fmt a'
-
-  let record fmt = function
-    | [] -> Format.pp_print_string fmt "{}"
-    | xs ->
-      let pp fmt (field, pp) =
-        Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
-          field pp () in
-      let pp_sep fmt () = Format.fprintf fmt "@,; " in
-      Format.fprintf fmt "@[<hv>{ %a@ }@]"
-        (Format.pp_print_list ~pp_sep pp) xs
-
-  let tuple ppfa ppfb fmt (a, b) =
-    Format.fprintf fmt "@[<hv>(%a, %a)@]" ppfa a ppfb b
-end
-
 (* This is ugly *)
 let printer = ref (Printf.eprintf "%s%!")
 let print_to_console s = !printer s

src/stdune/fmt.ml

@@ -0,0 +1,54 @@
+
+(* CR-someday diml: we should define a GADT for this:
+
+   {[
+     type 'a t =
+       | Int : int t
+       | Box : ...
+           | Colored : ...
+   ]}
+
+   This way we could separate the creation of messages from the
+   actual rendering.
+*)
+type 'a t = Format.formatter -> 'a -> unit
+
+let kstrf f fmt =
+  let buf = Buffer.create 17 in
+  let f fmt = Format.pp_print_flush fmt () ; f (Buffer.contents buf) in
+  Format.kfprintf f (Format.formatter_of_buffer buf) fmt
+
+let failwith fmt = kstrf failwith fmt
+
+let list = Format.pp_print_list
+let string s ppf = Format.pp_print_string ppf s
+
+let nl = Format.pp_print_newline
+
+let prefix f g ppf x = f ppf; g ppf x
+
+let ocaml_list pp fmt = function
+  | [] -> Format.pp_print_string fmt "[]"
+  | l ->
+    Format.fprintf fmt "@[<hv>[ %a@ ]@]"
+      (list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
+         pp) l
+
+let quoted fmt = Format.fprintf fmt "%S"
+
+let const
+  : 'a t -> 'a -> unit t
+  = fun pp a' fmt () -> pp fmt a'
+
+let record fmt = function
+  | [] -> Format.pp_print_string fmt "{}"
+  | xs ->
+    let pp fmt (field, pp) =
+      Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
+        field pp () in
+    let pp_sep fmt () = Format.fprintf fmt "@,; " in
+    Format.fprintf fmt "@[<hv>{ %a@ }@]"
+      (Format.pp_print_list ~pp_sep pp) xs
+
+let tuple ppfa ppfb fmt (a, b) =
+  Format.fprintf fmt "@[<hv>(%a, %a)@]" ppfa a ppfb b

src/stdune/fmt.mli

@@ -0,0 +1,24 @@
+type 'a t = Format.formatter -> 'a -> unit
+
+val list : ?pp_sep:unit t -> 'a t -> 'a list t
+
+val failwith : ('a, Format.formatter, unit, 'b) format4 -> 'a
+
+val string : string -> Format.formatter -> unit
+
+val prefix
+  : (Format.formatter -> unit)
+  -> (Format.formatter -> 'b -> 'c)
+  -> (Format.formatter -> 'b -> 'c)
+
+val ocaml_list : 'a t -> 'a list t
+
+val quoted : string t
+
+val const : 'a t -> 'a -> unit t
+
+val record : (string * unit t) list t
+
+val tuple : 'a t -> 'b t -> ('a * 'b) t
+
+val nl : unit t

src/stdune/stdune.ml

@@ -20,6 +20,7 @@ module String     = String
 module Char       = Char
 module Sexp       = Sexp
 module Path       = Path
+module Fmt        = Fmt
 
 external reraise : exn -> _ = "%reraise"