diff --git a/stdlib/format.ml b/stdlib/format.ml index 9aebeb272..71bfa4b69 100644 --- a/stdlib/format.ml +++ b/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 diff --git a/stdlib/format.mli b/stdlib/format.mli index 404118b69..b6997cd81 100644 --- a/stdlib/format.mli +++ b/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 diff --git a/testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference b/testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference index 3cd3266d3..5cdab83ab 100644 --- a/testsuite/tests/shadow_include/cannot_shadow_error.compilers.reference +++ 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 diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml index 3ed8b13b0..1885afd63 100644 --- a/testsuite/tests/typing-sigsubst/sigsubst.ml +++ b/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