diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index e821fd533..85d1af61f 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -163,6 +163,9 @@ Any user-visible change should have a Changelog entry: - with the issue number `PR#{N}` if from mantis, `GPR#{N}` if from github (several numbers separated by commas can be used) +- maintaining the order: each section lists Mantis PRs first in ascending + numerical order, followed by Github PRs + - with a concise readable description of the change (possibly taken from a commit message, but it should make sense to end-users reading release notes) diff --git a/Changes b/Changes index c76c2b7c5..d86fe1560 100644 --- a/Changes +++ b/Changes @@ -105,6 +105,8 @@ Runtime system: Shinwell, review by Damien Doligez) Standard library: +- PR#6017, PR#7034, GPR#267: More efficient ifprintf implementation + (Jeremy Yallop, review by Gabriel Scherer) - PR#6316: Scanf.scanf failure on %u formats when reading big integers (Xavier Leroy, BenoƮt Vaugon) - PR#6390, GPR#36: expose Sys.{int_size,max_wosize} for improved js_of_ocaml diff --git a/stdlib/camlinternalFormat.ml b/stdlib/camlinternalFormat.ml index 22f555a6f..8d9f8d345 100644 --- a/stdlib/camlinternalFormat.ml +++ b/stdlib/camlinternalFormat.ml @@ -1709,7 +1709,6 @@ and make_float_padding_precision : type x y a b c d e f . fun w p x -> let str = fix_padding padty w (convert_float fconv p x) in make_printf k o (Acc_data_string (acc, str)) fmt - and make_custom : type x y a b c d e f . (b -> (b, c) acc -> f) -> b -> (b, c) acc -> (a, b, c, d, e, f) fmt -> @@ -1720,6 +1719,108 @@ and make_custom : type x y a b c d e f . fun x -> make_custom k o acc rest arity (f x) +let const x _ = x + +let rec make_iprintf : type a b c d e f. + (b -> f) -> b -> (a, b, c, d, e, f) fmt -> a = + fun k o fmt -> match fmt with + | Char rest -> + const (make_iprintf k o rest) + | Caml_char rest -> + const (make_iprintf k o rest) + | String (No_padding, rest) -> + const (make_iprintf k o rest) + | String (Lit_padding _, rest) -> + const (make_iprintf k o rest) + | String (Arg_padding _, rest) -> + const (const (make_iprintf k o rest)) + | Caml_string (No_padding, rest) -> + const (make_iprintf k o rest) + | Caml_string (Lit_padding _, rest) -> + const (make_iprintf k o rest) + | Caml_string (Arg_padding _, rest) -> + const (const (make_iprintf k o rest)) + | Int (_, pad, prec, rest) -> + fn_of_padding_precision k o rest pad prec + | Int32 (_, pad, prec, rest) -> + fn_of_padding_precision k o rest pad prec + | Nativeint (_, pad, prec, rest) -> + fn_of_padding_precision k o rest pad prec + | Int64 (_, pad, prec, rest) -> + fn_of_padding_precision k o rest pad prec + | Float (_, pad, prec, rest) -> + fn_of_padding_precision k o rest pad prec + | Bool rest -> + const (make_iprintf k o rest) + | Alpha rest -> + const (const (make_iprintf k o rest)) + | Theta rest -> + const (make_iprintf k o rest) + | Custom (arity, _, rest) -> + fn_of_custom_arity k o rest arity + | Reader _ -> + (* This case is impossible, by typing of formats. See the + note in the corresponding case for make_printf. *) + assert false + | Flush rest -> + make_iprintf k o rest + | String_literal (_, rest) -> + make_iprintf k o rest + | Char_literal (_, rest) -> + make_iprintf k o rest + | Format_arg (_, _, rest) -> + const (make_iprintf k o rest) + | Format_subst (_, fmtty, rest) -> + fun (Format (fmt, _)) -> + make_iprintf k o + (concat_fmt (recast fmt fmtty) rest) + | Scan_char_set (_, _, rest) -> + const (make_iprintf k o rest) + | Scan_get_counter (_, rest) -> + const (make_iprintf k o rest) + | Scan_next_char rest -> + const (make_iprintf k o rest) + | Ignored_param (ign, rest) -> + make_ignored_param (fun x _ -> k x) o (End_of_acc) ign rest + | Formatting_lit (_, rest) -> + make_iprintf k o rest + | Formatting_gen (Open_tag (Format (fmt', _)), rest) -> + make_iprintf (fun koc -> make_iprintf k koc rest) o fmt' + | Formatting_gen (Open_box (Format (fmt', _)), rest) -> + make_iprintf (fun koc -> make_iprintf k koc rest) o fmt' + | End_of_format -> + k o +and fn_of_padding_precision : + type x y z a b c d e f. + (b -> f) -> b -> (a, b, c, d, e, f) fmt -> + (x, y) padding -> (y, z -> a) precision -> x = + fun k o fmt pad prec -> match pad, prec with + | No_padding , No_precision -> + const (make_iprintf k o fmt) + | No_padding , Lit_precision _ -> + const (make_iprintf k o fmt) + | No_padding , Arg_precision -> + const (const (make_iprintf k o fmt)) + | Lit_padding _, No_precision -> + const (make_iprintf k o fmt) + | Lit_padding _, Lit_precision _ -> + const (make_iprintf k o fmt) + | Lit_padding _, Arg_precision -> + const (const (make_iprintf k o fmt)) + | Arg_padding _, No_precision -> + const (const (make_iprintf k o fmt)) + | Arg_padding _, Lit_precision _ -> + const (const (make_iprintf k o fmt)) + | Arg_padding _, Arg_precision -> + const (const (const (make_iprintf k o fmt))) +and fn_of_custom_arity : type x y a b c d e f . + (b -> f) -> b -> (a, b, c, d, e, f) fmt -> (a, x, y) custom_arity -> y = + fun k o fmt -> function + | Custom_zero -> + make_iprintf k o fmt + | Custom_succ arity -> + const (fn_of_custom_arity k o fmt arity) + (******************************************************************************) (* Continuations for make_printf *) diff --git a/stdlib/camlinternalFormat.mli b/stdlib/camlinternalFormat.mli index 036bcb0ec..2fb81f8bc 100644 --- a/stdlib/camlinternalFormat.mli +++ b/stdlib/camlinternalFormat.mli @@ -59,6 +59,8 @@ val make_printf : ('b -> ('b, 'c) acc -> 'd) -> 'b -> ('b, 'c) acc -> ('a, 'b, 'c, 'c, 'c, 'd) CamlinternalFormatBasics.fmt -> 'a +val make_iprintf : ('b -> 'f) -> 'b -> ('a, 'b, 'c, 'd, 'e, 'f) fmt -> 'a + val output_acc : out_channel -> (out_channel, unit) acc -> unit val bufput_acc : Buffer.t -> (Buffer.t, unit) acc -> unit val strput_acc : Buffer.t -> (unit, string) acc -> unit diff --git a/stdlib/format.ml b/stdlib/format.ml index 3ab79e254..194d3fcd3 100644 --- a/stdlib/format.ml +++ b/stdlib/format.ml @@ -1181,10 +1181,7 @@ let kfprintf k ppf (Format (fmt, _)) = ppf End_of_acc fmt and ikfprintf k ppf (Format (fmt, _)) = - make_printf - (fun _ _ -> k ppf) - ppf End_of_acc fmt -;; + make_iprintf k ppf fmt let fprintf ppf = kfprintf ignore ppf;; let ifprintf ppf = ikfprintf ignore ppf;; diff --git a/stdlib/printf.ml b/stdlib/printf.ml index 1152429f9..e6f264074 100644 --- a/stdlib/printf.ml +++ b/stdlib/printf.ml @@ -19,7 +19,7 @@ let kfprintf k o (Format (fmt, _)) = let kbprintf k b (Format (fmt, _)) = make_printf (fun b acc -> bufput_acc b acc; k b) b End_of_acc fmt let ikfprintf k oc (Format (fmt, _)) = - make_printf (fun oc _ -> k oc) oc End_of_acc fmt + make_iprintf k oc fmt let fprintf oc fmt = kfprintf ignore oc fmt let bprintf b fmt = kbprintf ignore b fmt