From 724642747fcce9a167a019ab0185c8492dbde77e Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Fri, 28 Jun 2024 16:32:15 +0200 Subject: [PATCH 1/2] New equality metric that compares numbers Closes #156 --- CHANGES.md | 4 +++ lib/dune | 4 +++ lib/equal.cppo.ml | 60 +++++++++++++++++++++++++++++++++++++++++++++ lib/monomorphic.ml | 52 +++++++++------------------------------ lib/monomorphic.mli | 8 ++++++ 5 files changed, 87 insertions(+), 41 deletions(-) create mode 100644 lib/equal.cppo.ml diff --git a/CHANGES.md b/CHANGES.md index dff87646..e4a9c873 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,10 @@ ### Added +- Add `numeric_equal` function which determines equality preserving JSON + sematics which does not distinguish between integers and floats (#156, + # @Leonidas-from-XIV) + ### Changed ### Deprecated diff --git a/lib/dune b/lib/dune index 3e7dc94b..523df37d 100644 --- a/lib/dune +++ b/lib/dune @@ -8,6 +8,7 @@ (:out t.cppo.ml) type.ml monomorphic.ml + equal.cppo.ml prettyprint.ml write.ml write2.ml) @@ -33,6 +34,7 @@ write.ml prettyprint.ml monomorphic.ml + equal.cppo.ml write2.ml read.ml util.ml) @@ -62,6 +64,7 @@ write.ml prettyprint.ml monomorphic.ml + equal.cppo.ml write2.ml read.ml util.ml) @@ -91,6 +94,7 @@ write.ml prettyprint.ml monomorphic.ml + equal.cppo.ml write2.ml read.ml util.ml) diff --git a/lib/equal.cppo.ml b/lib/equal.cppo.ml new file mode 100644 index 00000000..519ebcdf --- /dev/null +++ b/lib/equal.cppo.ml @@ -0,0 +1,60 @@ +let rec equal a b = + let [@warning "-26"] float_int_equal f i = (float_of_int i) = f in + match a, b with + | `Null, `Null -> true + | `Bool a, `Bool b -> a = b +#ifdef INT + | `Int a, `Int b -> a = b +#endif +#ifdef INTLIT + | `Intlit a, `Intlit b -> a = b + #ifdef NUMERIC_EQUAL + #ifdef INT + | `Intlit s, `Int i + | `Int i, `Intlit s -> (string_of_int i) = s + #endif + #endif +#endif +#ifdef FLOAT + | `Float a, `Float b -> a = b + #ifdef NUMERIC_EQUAL + #ifdef INT + | `Float f, `Int i + | `Int i, `Float f -> float_int_equal f i + #endif + #endif +#endif +#ifdef FLOATLIT + | `Floatlit a, `Floatlit b -> a = b + #ifdef NUMERIC_EQUAL + #ifdef FLOAT + | `Floatlit l, `Float f + | `Float f, `Floatlit l -> (string_of_float f) = l + #endif + #endif +#endif +#ifdef STRING + | `String a, `String b -> a = b +#endif +#ifdef STRINGLIT + | `Stringlit a, `Stringlit b -> a = b +#endif + | `Assoc xs, `Assoc ys -> + let compare_keys = fun (key, _) (key', _) -> String.compare key key' in + let xs = List.stable_sort compare_keys xs in + let ys = List.stable_sort compare_keys ys in + (match List.for_all2 (fun (key, value) (key', value') -> + match key = key' with + | false -> false + | true -> equal value value') xs ys with + | result -> result + | exception Invalid_argument _ -> + (* the lists were of different lengths, thus unequal *) + false) + | `List xs, `List ys -> + (match List.for_all2 equal xs ys with + | result -> result + | exception Invalid_argument _ -> + (* the lists were of different lengths, thus unequal *) + false) + | _ -> false diff --git a/lib/monomorphic.ml b/lib/monomorphic.ml index 912323b4..222066ef 100644 --- a/lib/monomorphic.ml +++ b/lib/monomorphic.ml @@ -71,44 +71,14 @@ let rec pp fmt = let show x = Format.asprintf "%a" pp x -let rec equal a b = - match a, b with - | `Null, `Null -> true - | `Bool a, `Bool b -> a = b -#ifdef INT - | `Int a, `Int b -> a = b -#endif -#ifdef INTLIT - | `Intlit a, `Intlit b -> a = b -#endif -#ifdef FLOAT - | `Float a, `Float b -> a = b -#endif -#ifdef FLOATLIT - | `Floatlit a, `Floatlit b -> a = b -#endif -#ifdef STRING - | `String a, `String b -> a = b -#endif -#ifdef STRINGLIT - | `Stringlit a, `Stringlit b -> a = b -#endif - | `Assoc xs, `Assoc ys -> - let compare_keys = fun (key, _) (key', _) -> String.compare key key' in - let xs = List.stable_sort compare_keys xs in - let ys = List.stable_sort compare_keys ys in - (match List.for_all2 (fun (key, value) (key', value') -> - match key = key' with - | false -> false - | true -> equal value value') xs ys with - | result -> result - | exception Invalid_argument _ -> - (* the lists were of different lengths, thus unequal *) - false) - | `List xs, `List ys -> - (match List.for_all2 equal xs ys with - | result -> result - | exception Invalid_argument _ -> - (* the lists were of different lengths, thus unequal *) - false) - | _ -> false +let equal a b = + #include "equal.cppo.ml" + in + equal a b + +let numeric_equal a b = + #define NUMERIC_EQUAL + #include "equal.cppo.ml" + #undef NUMERIC_EQUAL + in + equal a b diff --git a/lib/monomorphic.mli b/lib/monomorphic.mli index 1bb233d3..625e6800 100644 --- a/lib/monomorphic.mli +++ b/lib/monomorphic.mli @@ -11,3 +11,11 @@ val equal : t -> t -> bool duplicate keys which will be considered equal as long as they are in the same input order. *) + +val numeric_equal : t -> t -> bool +(** [numeric_equal a b] determines whether [a] and [b] are equal, while + attempting to preserve equality according to JSON rules which do not + distinguish between float and integers. + + The remaining semantics are identical to [equal]. + *) From 6937800cd28c4b2f930a3d50fb1855baae32dcb3 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Fri, 28 Jun 2024 16:39:18 +0200 Subject: [PATCH 2/2] Update CHANGES.md Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com> --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index e4a9c873..72c9d320 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,7 +4,7 @@ - Add `numeric_equal` function which determines equality preserving JSON sematics which does not distinguish between integers and floats (#156, - # @Leonidas-from-XIV) + #186 @Leonidas-from-XIV) ### Changed