Add dprintf, the delayed printf function.

stdlib/format.ml

@@ -1345,6 +1345,13 @@ let ifprintf ppf = ikfprintf ignore ppf
 let printf fmt = fprintf std_formatter fmt
 let eprintf fmt = fprintf err_formatter fmt
 
+let kdprintf k (Format (fmt, _)) =
+  make_printf
+    (fun acc -> k (fun ppf -> output_acc ppf acc))
+    End_of_acc fmt
+
+let dprintf fmt = kdprintf (fun i -> i) fmt
+
 let ksprintf k (Format (fmt, _)) =
   let b = pp_make_buffer () in
   let ppf = formatter_of_buffer b in

stdlib/format.mli

@@ -1068,6 +1068,18 @@ val asprintf : ('a, formatter, unit, string) format4 -> 'a
   @since 4.01.0
 *)
 
+val dprintf :
+  ('a, formatter, unit, formatter -> unit) format4 -> 'a
+(** Same as {!fprintf}, except the formatter is the last argument.
+  All printing actions are delayed until the formatter is provided.
+  In particular, [printff "..." a b c] is a
+  function of type [formatter -> unit] which can be given to
+  a format specifier [%t].
+
+  @since NEXT_VERSION
+*)
+
+
 val ifprintf : formatter -> ('a, formatter, unit) format -> 'a
 (** Same as [fprintf] above, but does not print anything.
   Useful to ignore some material when conditionally printing.
@@ -1083,6 +1095,15 @@ val kfprintf :
 (** Same as [fprintf] above, but instead of returning immediately,
   passes the formatter to its first argument at the end of printing. *)
 
+val kdprintf :
+  ((formatter -> unit) -> 'a) ->
+  ('b, formatter, unit, 'a) format4 -> 'b
+(** Same as {!dprintf} above, but instead of returning immediately,
+  passes the suspended printer to its first argument at the end of printing.
+
+  @since NEXT_VERSION
+*)
+
 val ikfprintf :
   (formatter -> 'a) -> formatter ->
   ('b, formatter, unit, 'a) format4 -> 'b

testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference

@@ -1,6 +1,6 @@
 File "cannot_shadow_error.ml", line 23, characters 2-36:
-Error: Illegal shadowing of included type t/1141 by t/1145
+Error: Illegal shadowing of included type t/1143 by t/1147
        File "cannot_shadow_error.ml", line 22, characters 2-19:
-         Type t/1141 came from this include
+         Type t/1143 came from this include
        File "cannot_shadow_error.ml", line 13, characters 2-43:
-         The value print has no valid type if t/1141 is shadowed
+         The value print has no valid type if t/1143 is shadowed

testsuite/tests/typing-sigsubst/sigsubst.ml

@@ -25,11 +25,11 @@ end
 Line 3, characters 2-36:
     include Comparable with type t = t
     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Illegal shadowing of included type t/1152 by t/1156
+Error: Illegal shadowing of included type t/1154 by t/1158
        Line 2, characters 2-19:
-         Type t/1152 came from this include
+         Type t/1154 came from this include
        Line 3, characters 2-43:
-         The value print has no valid type if t/1152 is shadowed
+         The value print has no valid type if t/1154 is shadowed
 |}]
 
 module type Sunderscore = sig