From baec3433a110b4f5154d03b765be1b904fc7862e Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Fri, 28 Jun 2024 11:55:12 +0200 Subject: [PATCH] Always output JSON compliant floats (if possible) This disables the `std` argument but keeps it and the functions to not create additional unnecessary API breakage. --- CHANGES.md | 6 ++++ lib/prettyprint.ml | 23 +++++++-------- lib/write.ml | 72 +++++++--------------------------------------- 3 files changed, 26 insertions(+), 75 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index dff87646..bfd936f0 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,12 @@ ### Changed +- Floats are now always output to JSON in a standard-conformant way or not at + all (raising an exception). This makes the `std` variants of functions + identical to the non-`std` variants and the `std` arguments have no effect. + Users are encouraged to switch to the non-`std` affixed variants, the others + will be deprecated in the future. (#, @Leonidas-from-XIV) + ### Deprecated ### Fixed diff --git a/lib/prettyprint.ml b/lib/prettyprint.ml index 317d0aac..56422e2a 100644 --- a/lib/prettyprint.ml +++ b/lib/prettyprint.ml @@ -70,7 +70,7 @@ let is_atom_list l = bar ] *) -let rec format ~inside_box std (out:Format.formatter) (x:t) : unit = +let rec format ~inside_box (out : Format.formatter) (x : t) : unit = match x with | `Null -> Format.pp_print_string out "null" | `Bool x -> Format.pp_print_bool out x @@ -79,11 +79,7 @@ let rec format ~inside_box std (out:Format.formatter) (x:t) : unit = #endif #ifdef FLOAT | `Float x -> - let s = - if std then std_json_string_of_float x - else json_string_of_float x - in - Format.pp_print_string out s + Format.pp_print_string out (json_string_of_float x) #endif #ifdef STRING | `String s -> Format.pp_print_string out (json_string_of_string s) @@ -103,24 +99,25 @@ let rec format ~inside_box std (out:Format.formatter) (x:t) : unit = if is_atom_list l then (* use line wrapping like we would do for a paragraph of text *) Format.fprintf out "[@;<1 0>@[%a@]@;<1 -2>]" - (pp_list "," (format ~inside_box:false std)) l + (pp_list "," (format ~inside_box:false)) l else (* print the elements horizontally if they fit on the line, otherwise print them in a column *) Format.fprintf out "[@;<1 0>@[%a@]@;<1 -2>]" - (pp_list "," (format ~inside_box:false std)) l; + (pp_list "," (format ~inside_box:false)) l; if not inside_box then Format.fprintf out "@]"; | `Assoc [] -> Format.pp_print_string out "{}" | `Assoc l -> if not inside_box then Format.fprintf out "@["; - Format.fprintf out "{@;<1 0>%a@;<1 -2>}" (pp_list "," (format_field std)) l; + Format.fprintf out "{@;<1 0>%a@;<1 -2>}" (pp_list "," (format_field)) l; if not inside_box then Format.fprintf out "@]"; -and format_field std out (name, x) = - Format.fprintf out "@[%s: %a@]" (json_string_of_string name) (format ~inside_box:true std) x +and format_field out (name, x) = + Format.fprintf out "@[%s: %a@]" (json_string_of_string name) (format ~inside_box:true) x -let pp ?(std = false) out x = - Format.fprintf out "@[%a@]" (format ~inside_box:true std) (x :> t) +(* [std] argument to be deprecated *) +let pp ?(std = true) out x = + Format.fprintf out "@[%a@]" (format ~inside_box:true) (x :> t) let to_string ?std x = Format.asprintf "%a" (pp ?std) x diff --git a/lib/write.ml b/lib/write.ml index 6f7f8f24..c69bc63e 100644 --- a/lib/write.ml +++ b/lib/write.ml @@ -144,23 +144,12 @@ let write_normal_float_prec significant_figures ob x = if float_needs_period s then Buffer.add_string ob ".0" -(* used by atdgen *) -let write_float_prec significant_figures ob x = - match classify_float x with - FP_nan -> - Buffer.add_string ob "NaN" - | FP_infinite -> - Buffer.add_string ob (if x > 0. then "Infinity" else "-Infinity") - | _ -> - write_normal_float_prec significant_figures ob x - let json_string_of_float x = let ob = Buffer.create 20 in write_float ob x; Buffer.contents ob - -let write_std_float ob x = +let write_float ob x = match classify_float x with FP_nan -> Common.json_error "NaN value not allowed in standard JSON" @@ -180,8 +169,11 @@ let write_std_float ob x = if float_needs_period s then Buffer.add_string ob ".0" +(* to be deprecated in a future release *) +let write_std_float = write_float + (* used by atdgen *) -let write_std_float_prec significant_figures ob x = +let write_float_prec significant_figures ob x = match classify_float x with FP_nan -> Common.json_error "NaN value not allowed in standard JSON" @@ -194,11 +186,7 @@ let write_std_float_prec significant_figures ob x = | _ -> write_normal_float_prec significant_figures ob x -let std_json_string_of_float x = - let ob = Buffer.create 20 in - write_std_float ob x; - Buffer.contents ob - +let write_std_float_prec = write_float_prec let write_intlit = Buffer.add_string let write_floatlit = Buffer.add_string @@ -262,51 +250,11 @@ and write_list ob l = let write_t = write_json -let rec write_std_json ob (x : t) = - match x with - `Null -> write_null ob () - | `Bool b -> write_bool ob b -#ifdef INT - | `Int i -> write_int ob i -#endif -#ifdef INTLIT - | `Intlit s -> Buffer.add_string ob s -#endif -#ifdef FLOAT - | `Float f -> write_std_float ob f -#endif -#ifdef FLOATLIT - | `Floatlit s -> Buffer.add_string ob s -#endif -#ifdef STRING - | `String s -> write_string ob s -#endif -#ifdef STRINGLIT - | `Stringlit s -> Buffer.add_string ob s -#endif - | `Assoc l -> write_std_assoc ob l - | `List l -> write_std_list ob l +let write_std_json = write_json -and write_std_assoc ob l = - let f_elt ob (s, x) = - write_string ob s; - Buffer.add_char ob ':'; - write_std_json ob x - in - Buffer.add_char ob '{'; - iter2 f_elt f_sep ob l; - Buffer.add_char ob '}'; - -and write_std_list ob l = - Buffer.add_char ob '['; - iter2 write_std_json f_sep ob l; - Buffer.add_char ob ']' - -let to_buffer ?(suf = "") ?(std = false) ob x = - if std then - write_std_json ob x - else - write_json ob x; +(* std argument is going to be deprecated *) +let to_buffer ?(suf = "") ?(std = true) ob x = + write_json ob x; Buffer.add_string ob suf let to_string ?buf ?(len = 256) ?(suf = "") ?std x =