diff --git a/jscomp/runtime/caml_obj.ml b/jscomp/runtime/caml_obj.ml index 8586d3a4a2..a8a9a67b20 100644 --- a/jscomp/runtime/caml_obj.ml +++ b/jscomp/runtime/caml_obj.ml @@ -131,6 +131,18 @@ let caml_update_dummy x y = type 'a selector = 'a -> 'a -> 'a +module O = struct + external isArray : 'a -> bool = "Array.isArray" [@@bs.val] + type key = string + let for_in : (Obj.t -> (key -> unit) -> unit) [@bs] = [%bs.raw + {|function (o, foo) { + for (var x in o) { foo(x) } + } + |}] + external hasOwnProperty : key -> bool [@bs.meth] = "" [@@bs.val] + let hasOwnProperty (o: Obj.t) (key: key) : bool = (Obj.magic o)##hasOwnProperty(key) + external get_value : Obj.t -> key -> Obj.t = "%array_unsafe_get" +end let unsafe_js_compare x y = if x == y then 0 else @@ -199,7 +211,9 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int = let len_a = Bs_obj.length a in let len_b = Bs_obj.length b in if len_a = len_b then - aux_same_length a b 0 len_a + if O.isArray(a) + then aux_same_length a b 0 len_a + else aux_obj_compare a b else if len_a < len_b then aux_length_a_short a b 0 len_a else @@ -223,6 +237,27 @@ and aux_length_b_short (a : Obj.t) (b : Obj.t) i short_length = let res = caml_compare (Obj.field a i) (Obj.field b i) in if res <> 0 then res else aux_length_b_short a b (i+1) short_length +and aux_obj_compare (a: Obj.t) (b: Obj.t) = + let min_key_lhs = ref None in + let min_key_rhs = ref None in + let do_key (a, b, min_key) key = + if not (O.hasOwnProperty b key) || + caml_compare (O.get_value a key) (O.get_value b key) > 0 + then + match !min_key with + | None -> min_key := Some key + | Some mk -> + if key < mk then min_key := Some key in + let do_key_a = do_key (a, b, min_key_rhs) in + let do_key_b = do_key (b, a, min_key_lhs) in + O.for_in a do_key_a [@bs]; + O.for_in b do_key_b [@bs]; + let res = match !min_key_lhs, !min_key_rhs with + | None, None -> 0 + | (Some _), None -> -1 + | None, (Some _) -> 1 + | (Some x), (Some y) -> compare x y in + res type eq = Obj.t -> Obj.t -> bool @@ -268,7 +303,9 @@ let rec caml_equal (a : Obj.t) (b : Obj.t) : bool = let len_a = Bs_obj.length a in let len_b = Bs_obj.length b in if len_a = len_b then - aux_equal_length a b 0 len_a + if O.isArray(a) + then aux_equal_length a b 0 len_a + else aux_obj_equal a b else false and aux_equal_length (a : Obj.t) (b : Obj.t) i same_length = if i = same_length then @@ -276,7 +313,18 @@ and aux_equal_length (a : Obj.t) (b : Obj.t) i same_length = else caml_equal (Obj.field a i) (Obj.field b i) && aux_equal_length a b (i + 1) same_length - +and aux_obj_equal (a: Obj.t) (b: Obj.t) = + let result = ref true in + let do_key_a key = + if not (O.hasOwnProperty b key) + then result := false in + let do_key_b key = + if not (O.hasOwnProperty a key) || + not (caml_equal (O.get_value b key) (O.get_value a key)) + then result := false in + O.for_in a do_key_a [@bs]; + if !result then O.for_in b do_key_b [@bs]; + !result let caml_equal_null (x : Obj.t) (y : Obj.t Js.null) = match Js.nullToOption y with diff --git a/jscomp/test/caml_compare_test.js b/jscomp/test/caml_compare_test.js index e6d4950d02..bd7fd638ea 100644 --- a/jscomp/test/caml_compare_test.js +++ b/jscomp/test/caml_compare_test.js @@ -497,7 +497,419 @@ var suites_001 = /* :: */[ ]); }) ], - /* [] */0 + /* :: */[ + /* tuple */[ + "cmp_id", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: 1, + y: 2 + }, { + x: 1, + y: 2 + }), + 0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_val", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: 1 + }, { + x: 2 + }), + -1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_val2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: 2 + }, { + x: 1 + }), + 1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_empty", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare(({}), ({})), + 0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_empty2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare(({}), ({x:1})), + -1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_swap", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: 1, + y: 2 + }, { + y: 2, + x: 1 + }), + 0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_size", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare(({x:1}), ({x:1, y:2})), + -1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_size2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare(({x:1, y:2}), ({x:1})), + 1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_order", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: 0, + y: 1 + }, { + x: 1, + y: 0 + }), + -1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_order2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: 1, + y: 0 + }, { + x: 0, + y: 1 + }), + 1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_in_list", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare(/* :: */[ + { + x: 1 + }, + /* [] */0 + ], /* :: */[ + { + x: 2 + }, + /* [] */0 + ]), + -1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_in_list2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare(/* :: */[ + { + x: 2 + }, + /* [] */0 + ], /* :: */[ + { + x: 1 + }, + /* [] */0 + ]), + 1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_with_list", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: /* :: */[ + 0, + /* [] */0 + ] + }, { + x: /* :: */[ + 1, + /* [] */0 + ] + }), + -1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "cmp_with_list2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_compare({ + x: /* :: */[ + 1, + /* [] */0 + ] + }, { + x: /* :: */[ + 0, + /* [] */0 + ] + }), + 1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_id", + (function () { + return /* Ok */Block.__(4, [Caml_obj.caml_equal({ + x: 1, + y: 2 + }, { + x: 1, + y: 2 + })]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_val", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal({ + x: 1 + }, { + x: 2 + }), + /* false */0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_val2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal({ + x: 2 + }, { + x: 1 + }), + /* false */0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_empty", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal(({}), ({})), + /* true */1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_empty2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal(({}), ({x:1})), + /* false */0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_swap", + (function () { + return /* Ok */Block.__(4, [Caml_obj.caml_equal({ + x: 1, + y: 2 + }, { + y: 2, + x: 1 + })]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_size", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal(({x:1}), ({x:1, y:2})), + /* false */0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_size2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal(({x:1, y:2}), ({x:1})), + /* false */0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_in_list", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal(/* :: */[ + { + x: 1 + }, + /* [] */0 + ], /* :: */[ + { + x: 2 + }, + /* [] */0 + ]), + /* false */0 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_in_list2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal(/* :: */[ + { + x: 2 + }, + /* [] */0 + ], /* :: */[ + { + x: 2 + }, + /* [] */0 + ]), + /* true */1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_with_list", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal({ + x: /* :: */[ + 0, + /* [] */0 + ] + }, { + x: /* :: */[ + 0, + /* [] */0 + ] + }), + /* true */1 + ]); + }) + ], + /* :: */[ + /* tuple */[ + "eq_with_list2", + (function () { + return /* Eq */Block.__(0, [ + Caml_obj.caml_equal({ + x: /* :: */[ + 0, + /* [] */0 + ] + }, { + x: /* :: */[ + 1, + /* [] */0 + ] + }), + /* false */0 + ]); + }) + ], + /* [] */0 + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] + ] ] ] ] diff --git a/jscomp/test/caml_compare_test.ml b/jscomp/test/caml_compare_test.ml index 9095bc47b0..3c06fff916 100644 --- a/jscomp/test/caml_compare_test.ml +++ b/jscomp/test/caml_compare_test.ml @@ -50,7 +50,33 @@ let suites = Mt.[ __LOC__ , begin fun _ -> Eq(false, [2;6;1;1;2;1;4;2;1;409] = [2;6;1;1;2;1;4;2;1]) end; - + + "cmp_id", (fun _ -> Eq (compare [%bs.obj {x=1; y=2}] [%bs.obj {x=1; y=2}], 0)); + "cmp_val", (fun _ -> Eq (compare [%bs.obj {x=1}] [%bs.obj {x=2}], -1)); + "cmp_val2", (fun _ -> Eq (compare [%bs.obj {x=2}] [%bs.obj {x=1}], 1)); + "cmp_empty", (fun _ -> Eq (compare [%bs.raw "{}"] [%bs.raw "{}"], 0)); + "cmp_empty2", (fun _ -> Eq (compare [%bs.raw "{}"] [%bs.raw "{x:1}"], -1)); + "cmp_swap", (fun _ -> Eq (compare [%bs.obj {x=1; y=2}] [%bs.obj {y=2; x=1}], 0)); + "cmp_size", (fun _ -> Eq (compare [%bs.raw "{x:1}"] [%bs.raw "{x:1, y:2}"], -1)); + "cmp_size2", (fun _ -> Eq (compare [%bs.raw "{x:1, y:2}"] [%bs.raw "{x:1}"], 1)); + "cmp_order", (fun _ -> Eq (compare [%bs.obj {x=0; y=1}] [%bs.obj {x=1; y=0}], -1)); + "cmp_order2", (fun _ -> Eq (compare [%bs.obj {x=1; y=0}] [%bs.obj {x=0; y=1}], 1)); + "cmp_in_list", (fun _ -> Eq (compare [[%bs.obj {x=1}]] [[%bs.obj {x=2}]], -1)); + "cmp_in_list2", (fun _ -> Eq (compare [[%bs.obj {x=2}]] [[%bs.obj {x=1}]], 1)); + "cmp_with_list", (fun _ -> Eq (compare [%bs.obj {x=[0]}] [%bs.obj {x=[1]}], -1)); + "cmp_with_list2", (fun _ -> Eq (compare [%bs.obj {x=[1]}] [%bs.obj {x=[0]}], 1)); + "eq_id", (fun _ -> Ok ([%bs.obj {x=1; y=2}] = [%bs.obj {x=1; y=2}])); + "eq_val", (fun _ -> Eq ([%bs.obj {x=1}] = [%bs.obj {x=2}], false)); + "eq_val2", (fun _ -> Eq ([%bs.obj {x=2}] = [%bs.obj {x=1}], false)); + "eq_empty", (fun _ -> Eq ([%bs.raw "{}"] = [%bs.raw "{}"], true)); + "eq_empty2", (fun _ -> Eq ([%bs.raw "{}"] = [%bs.raw "{x:1}"], false)); + "eq_swap", (fun _ -> Ok ([%bs.obj {x=1; y=2}] = [%bs.obj {y=2; x=1}])); + "eq_size", (fun _ -> Eq ([%bs.raw "{x:1}"] = [%bs.raw "{x:1, y:2}"], false)); + "eq_size2", (fun _ -> Eq ([%bs.raw "{x:1, y:2}"] = [%bs.raw "{x:1}"], false)); + "eq_in_list", (fun _ -> Eq ([[%bs.obj {x=1}]] = [[%bs.obj {x=2}]], false)); + "eq_in_list2", (fun _ -> Eq ([[%bs.obj {x=2}]] = [[%bs.obj {x=2}]], true)); + "eq_with_list", (fun _ -> Eq ([%bs.obj {x=[0]}] = [%bs.obj {x=[0]}], true)); + "eq_with_list2", (fun _ -> Eq ([%bs.obj {x=[0]}] = [%bs.obj {x=[1]}], false)); ] ;; diff --git a/lib/js/caml_obj.js b/lib/js/caml_obj.js index 82eef7e3b7..e7148ee0cd 100644 --- a/lib/js/caml_obj.js +++ b/lib/js/caml_obj.js @@ -56,6 +56,11 @@ function caml_update_dummy(x, y) { } } +var for_in = (function (o, foo) { + for (var x in o) { foo(x) } + } + ); + function caml_compare(_a, _b) { while(true) { var b = _b; @@ -119,27 +124,89 @@ function caml_compare(_a, _b) { var len_a = a.length | 0; var len_b = b.length | 0; if (len_a === len_b) { - var a$1 = a; - var b$1 = b; - var _i = 0; - var same_length = len_a; - while(true) { - var i = _i; - if (i === same_length) { - return 0; - } else { - var res = caml_compare(a$1[i], b$1[i]); - if (res !== 0) { - return res; + if (Array.isArray(a)) { + var a$1 = a; + var b$1 = b; + var _i = 0; + var same_length = len_a; + while(true) { + var i = _i; + if (i === same_length) { + return 0; } else { - _i = i + 1 | 0; - continue ; + var res = caml_compare(a$1[i], b$1[i]); + if (res !== 0) { + return res; + } else { + _i = i + 1 | 0; + continue ; + } + } + }; + } else { + var a$2 = a; + var b$2 = b; + var min_key_lhs = [/* None */0]; + var min_key_rhs = [/* None */0]; + var do_key = function (param, key) { + var min_key = param[2]; + var b = param[1]; + if (!b.hasOwnProperty(key) || caml_compare(param[0][key], b[key]) > 0) { + var match = min_key[0]; + if (match) { + if (key < match[0]) { + min_key[0] = /* Some */[key]; + return /* () */0; + } else { + return 0; + } + } else { + min_key[0] = /* Some */[key]; + return /* () */0; + } + } else { + return 0; } + }; + var partial_arg = /* tuple */[ + a$2, + b$2, + min_key_rhs + ]; + var do_key_a = (function(partial_arg){ + return function do_key_a(param) { + return do_key(partial_arg, param); } - }; + }(partial_arg)); + var partial_arg$1 = /* tuple */[ + b$2, + a$2, + min_key_lhs + ]; + var do_key_b = (function(partial_arg$1){ + return function do_key_b(param) { + return do_key(partial_arg$1, param); + } + }(partial_arg$1)); + for_in(a$2, do_key_a); + for_in(b$2, do_key_b); + var match = min_key_lhs[0]; + var match$1 = min_key_rhs[0]; + if (match) { + if (match$1) { + return Caml_primitive.caml_string_compare(match[0], match$1[0]); + } else { + return -1; + } + } else if (match$1) { + return 1; + } else { + return 0; + } + } } else if (len_a < len_b) { - var a$2 = a; - var b$2 = b; + var a$3 = a; + var b$3 = b; var _i$1 = 0; var short_length = len_a; while(true) { @@ -147,7 +214,7 @@ function caml_compare(_a, _b) { if (i$1 === short_length) { return -1; } else { - var res$1 = caml_compare(a$2[i$1], b$2[i$1]); + var res$1 = caml_compare(a$3[i$1], b$3[i$1]); if (res$1 !== 0) { return res$1; } else { @@ -157,8 +224,8 @@ function caml_compare(_a, _b) { } }; } else { - var a$3 = a; - var b$3 = b; + var a$4 = a; + var b$4 = b; var _i$2 = 0; var short_length$1 = len_b; while(true) { @@ -166,7 +233,7 @@ function caml_compare(_a, _b) { if (i$2 === short_length$1) { return 1; } else { - var res$2 = caml_compare(a$3[i$2], b$3[i$2]); + var res$2 = caml_compare(a$4[i$2], b$4[i$2]); if (res$2 !== 0) { return res$2; } else { @@ -224,21 +291,52 @@ function caml_equal(_a, _b) { var len_a = a.length | 0; var len_b = b.length | 0; if (len_a === len_b) { - var a$1 = a; - var b$1 = b; - var _i = 0; - var same_length = len_a; - while(true) { - var i = _i; - if (i === same_length) { - return /* true */1; - } else if (caml_equal(a$1[i], b$1[i])) { - _i = i + 1 | 0; - continue ; - } else { - return /* false */0; + if (Array.isArray(a)) { + var a$1 = a; + var b$1 = b; + var _i = 0; + var same_length = len_a; + while(true) { + var i = _i; + if (i === same_length) { + return /* true */1; + } else if (caml_equal(a$1[i], b$1[i])) { + _i = i + 1 | 0; + continue ; + } else { + return /* false */0; + } + }; + } else { + var a$2 = a; + var b$2 = b; + var result = [/* true */1]; + var do_key_a = (function(b$2,result){ + return function do_key_a(key) { + if (b$2.hasOwnProperty(key)) { + return 0; + } else { + result[0] = /* false */0; + return /* () */0; + } } - }; + }(b$2,result)); + var do_key_b = (function(a$2,b$2,result){ + return function do_key_b(key) { + if (!a$2.hasOwnProperty(key) || !caml_equal(b$2[key], a$2[key])) { + result[0] = /* false */0; + return /* () */0; + } else { + return 0; + } + } + }(a$2,b$2,result)); + for_in(a$2, do_key_a); + if (result[0]) { + for_in(b$2, do_key_b); + } + return result[0]; + } } else { return /* false */0; } @@ -326,4 +424,4 @@ exports.caml_lessthan = caml_lessthan; exports.caml_lessequal = caml_lessequal; exports.caml_min = caml_min; exports.caml_max = caml_max; -/* No side effect */ +/* for_in Not a pure module */