@@ -134,13 +134,14 @@ type 'a selector = 'a -> 'a -> 'a
134
134
module O = struct
135
135
external object_ : Obj .t = " Object" [@@ bs.val]
136
136
let is_object : Obj.t -> bool = fun x -> (Obj. magic x)##constructor == object_
137
- type keys
138
- type key = Obj .t
139
- external keys : Obj .t -> keys = "Object.keys" [@@ bs.val]
140
- external length : keys -> int = "%array_length"
141
- external sort : unit -> unit [@ bs.meth] = "" [@@ bs.val]
142
- let sort (keys :keys ) : unit = (Obj. magic keys)##sort ()
143
- external get_key : keys -> int -> key = " %array_unsafe_get"
137
+ type key = string
138
+ let for_in : (Obj.t -> (key -> unit) -> unit) [@bs] = [% bs.raw
139
+ {| function (o, foo) {
140
+ for (var x in o) { foo(x) }
141
+ }
142
+ | }]
143
+ external hasOwnProperty : key -> bool [@ bs.meth] = " " [@@ bs.val]
144
+ let hasOwnProperty (o : Obj.t ) (key : key ) : bool = (Obj. magic o)##hasOwnProperty (key)
144
145
external get_value : Obj .t -> key -> Obj .t = " %array_unsafe_get"
145
146
end
146
147
@@ -210,21 +211,10 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
210
211
else
211
212
let len_a = Bs_obj. length a in
212
213
let len_b = Bs_obj. length b in
213
- if len_a = 0 && len_b = 0 && O. is_object a && O. is_object b then
214
- begin
215
- let keys_a = O. keys a in
216
- let keys_b = O. keys b in
217
- O. sort(keys_a);
218
- O. sort(keys_b);
219
- let len_a = O. length keys_a in
220
- let len_b = O. length keys_b in
221
- let min_len = min len_a len_b in
222
- let default_res = len_a - len_b in
223
- aux_obj_compare a keys_a b keys_b 0 min_len default_res
224
- end
225
- else
226
214
if len_a = len_b then
227
- aux_same_length a b 0 len_a
215
+ if O. is_object a && O. is_object b
216
+ then aux_obj_compare a b
217
+ else aux_same_length a b 0 len_a
228
218
else if len_a < len_b then
229
219
aux_length_a_short a b 0 len_a
230
220
else
@@ -248,16 +238,27 @@ and aux_length_b_short (a : Obj.t) (b : Obj.t) i short_length =
248
238
let res = caml_compare (Obj. field a i) (Obj. field b i) in
249
239
if res <> 0 then res
250
240
else aux_length_b_short a b (i+ 1 ) short_length
251
- and aux_obj_compare (a : Obj.t ) keys_a (b : Obj.t ) keys_b i min_len default_res =
252
- if i = min_len then default_res
253
- else
254
- let key_a = O. get_key keys_a i in
255
- let key_b = O. get_key keys_b i in
256
- let res = caml_compare key_a key_b in
257
- if res <> 0 then res else
258
- let res = caml_compare (O. get_value a key_a) (O. get_value b key_b) in
259
- if res <> 0 then res
260
- else aux_obj_compare a keys_a b keys_b (i+ 1 ) min_len default_res
241
+ and aux_obj_compare (a : Obj.t ) (b : Obj.t ) =
242
+ let min_key_lhs = ref None in
243
+ let min_key_rhs = ref None in
244
+ let do_key (a , b , min_key ) key =
245
+ if not (O. hasOwnProperty b key) ||
246
+ caml_compare (O. get_value a key) (O. get_value b key) > 0
247
+ then
248
+ match ! min_key with
249
+ | None -> min_key := Some key
250
+ | Some mk ->
251
+ if key < mk then min_key := Some key in
252
+ let do_key_a = do_key (a, b, min_key_rhs) in
253
+ let do_key_b = do_key (b, a, min_key_lhs) in
254
+ O. for_in a do_key_a [@ bs];
255
+ O. for_in b do_key_b [@ bs];
256
+ let res = match ! min_key_lhs, ! min_key_rhs with
257
+ | None , None -> 0
258
+ | (Some _ ), None -> - 1
259
+ | None , (Some _ ) -> 1
260
+ | (Some x ), (Some y ) -> compare x y in
261
+ res
261
262
262
263
type eq = Obj .t -> Obj .t -> bool
263
264
@@ -302,35 +303,29 @@ let rec caml_equal (a : Obj.t) (b : Obj.t) : bool =
302
303
else
303
304
let len_a = Bs_obj. length a in
304
305
let len_b = Bs_obj. length b in
305
- if len_a = 0 && len_b = 0 && O. is_object a && O. is_object b then
306
- begin
307
- let keys_a = O. keys a in
308
- let keys_b = O. keys b in
309
- let len_a = O. length keys_a in
310
- let len_b = O. length keys_b in
311
- len_a = len_b &&
312
- let () = O. sort(keys_a) in
313
- let () = O. sort(keys_b) in
314
- aux_obj_equal a keys_a b keys_b 0 len_a
315
- end
316
- else
317
306
if len_a = len_b then
318
- aux_equal_length a b 0 len_a
307
+ if O. is_object a && O. is_object b
308
+ then aux_obj_equal a b
309
+ else aux_equal_length a b 0 len_a
319
310
else false
320
311
and aux_equal_length (a : Obj.t ) (b : Obj.t ) i same_length =
321
312
if i = same_length then
322
313
true
323
314
else
324
315
caml_equal (Obj. field a i) (Obj. field b i)
325
316
&& aux_equal_length a b (i + 1 ) same_length
326
- and aux_obj_equal (a : Obj.t ) keys_a (b : Obj.t ) keys_b i length =
327
- if i = length then true
328
- else
329
- let key_a = O. get_key keys_a i in
330
- let key_b = O. get_key keys_b i in
331
- caml_equal key_a key_b &&
332
- caml_equal (O. get_value a key_a) (O. get_value b key_b) &&
333
- aux_obj_equal a keys_a b keys_b (i+ 1 ) length
317
+ and aux_obj_equal (a : Obj.t ) (b : Obj.t ) =
318
+ let result = ref true in
319
+ let do_key_a key =
320
+ if not (O. hasOwnProperty b key)
321
+ then result := false in
322
+ let do_key_b key =
323
+ if not (O. hasOwnProperty a key) ||
324
+ not (caml_equal (O. get_value b key) (O. get_value a key))
325
+ then result := false in
326
+ O. for_in a do_key_a [@ bs];
327
+ if ! result then O. for_in b do_key_b [@ bs];
328
+ ! result
334
329
335
330
let caml_equal_null (x : Obj.t ) (y : Obj.t Js.null ) =
336
331
match Js. nullToOption y with
0 commit comments