Skip to content

Commit 495428a

Browse files
author
Cristiano Calcagno
committed
Extend polymorphic compare to support objects.
Extend polymorphic compare to support objects created as e.g. `[%bs.obj {x=1; y=2}]`. TODO: equality and hash. Objects, when viewed as blocks, have size 0 and no tag. Here an object `o` is recognized by checking that `o.constructor === Objects`. Then, the keys and values can be extracted. The compare function keeps the same structure, with one extra while loop, and does not change unless objects are encountered. Presumably `Object.keys(o)` performs some allocation.
1 parent 5c38c80 commit 495428a

File tree

3 files changed

+127
-21
lines changed

3 files changed

+127
-21
lines changed

‎jscomp/runtime/caml_obj.ml‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -131,6 +131,16 @@ let caml_update_dummy x y =
131131

132132
type 'a selector = 'a -> 'a -> 'a
133133

134+
module O = struct
135+
external object_ : Obj.t = "Object" [@@bs.val]
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 get_key : keys -> int -> key = "%array_unsafe_get"
142+
external get_value : Obj.t -> key -> Obj.t = "%array_unsafe_get"
143+
end
134144

135145
let unsafe_js_compare x y =
136146
if x == y then 0 else
@@ -198,6 +208,17 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
198208
else
199209
let len_a = Bs_obj.length a in
200210
let len_b = Bs_obj.length b in
211+
if len_a = 0 && len_b = 0 && O.is_object a && O.is_object b then
212+
begin
213+
let keys_a = O.keys a in
214+
let keys_b = O.keys b in
215+
let len_a = O.length keys_a in
216+
let len_b = O.length keys_b in
217+
let min_len = min len_a len_b in
218+
let default_res = len_a - len_b in
219+
aux_obj_compare a keys_a b keys_b 0 min_len default_res
220+
end
221+
else
201222
if len_a = len_b then
202223
aux_same_length a b 0 len_a
203224
else if len_a < len_b then
@@ -223,6 +244,16 @@ and aux_length_b_short (a : Obj.t) (b : Obj.t) i short_length =
223244
let res = caml_compare (Obj.field a i) (Obj.field b i) in
224245
if res <> 0 then res
225246
else aux_length_b_short a b (i+1) short_length
247+
and aux_obj_compare (a: Obj.t) keys_a (b: Obj.t) keys_b i min_len default_res =
248+
if i = min_len then default_res
249+
else
250+
let key_a = O.get_key keys_a i in
251+
let key_b = O.get_key keys_b i in
252+
let res = caml_compare key_a key_b in
253+
if res <> 0 then res else
254+
let res = caml_compare (O.get_value a key_a) (O.get_value b key_b) in
255+
if res <> 0 then res
256+
else aux_obj_compare a keys_a b keys_b (i+1) min_len default_res
226257

227258
type eq = Obj.t -> Obj.t -> bool
228259

‎jscomp/test/record_with_test.ml‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,46 @@ let u_v = {v with imports = 0}
3232

3333
let f g h = { (g h) with imports = 0 }
3434

35+
(*
36+
37+
module O = struct
38+
external object_ : Obj.t = "Object" [@@bs.val]
39+
let is_object : Obj.t -> bool = fun x -> (Obj.magic x)##constructor == object_
40+
type keys
41+
type key = Obj.t
42+
external keys : Obj.t -> keys = "Object.keys" [@@bs.val]
43+
external length : keys -> int = "%array_length"
44+
external get_key : keys -> int -> key = "%array_unsafe_get"
45+
external get_value : Obj.t -> key -> Obj.t = "%array_unsafe_get"
46+
end
47+
48+
let o1 = [%bs.obj {x=1; y=2}]
49+
let o2 = [%bs.obj {x=3; y=4}]
50+
let o3 = [%bs.obj {x=3; y=4}]
51+
52+
53+
let o1_is_object = O.is_object(Obj.repr o1)
54+
let list_is_object = O.is_object(Obj.repr [1;2;3])
55+
let () = Js.log2 "o1_is_object: " o1_is_object
56+
let () = Js.log2 "list_is_object: " list_is_object
57+
58+
let keys1 = O.keys(Obj.repr o1)
59+
let () = Js.log2 "keys1: " keys1
60+
61+
let cmp1 = compare o1 o2
62+
let cmp2 = compare o2 o1
63+
let cmp3 = compare o2 o3
64+
65+
let () = Js.log2 "cmp1: " cmp1
66+
let () = Js.log2 "cmp2: " cmp2
67+
let () = Js.log2 "cmp3: " cmp3
68+
69+
let () = for i = 0 to O.length keys1 - 1 do
70+
Js.log2 ("key" ^ string_of_int i ^ ": ") (O.get_key keys1 i);
71+
Js.log2 ("val" ^ string_of_int i ^ ": ") (O.get_value (Obj.repr o1) (O.get_key keys1 i))
72+
done
73+
*)
74+
3575
let suites = Mt.[
3676
"eq_with", (fun _ -> Eq (v, u_v))
3777
]

‎lib/js/caml_obj.js‎

Lines changed: 56 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -118,63 +118,98 @@ function caml_compare(_a, _b) {
118118
} else {
119119
var len_a = a.length | 0;
120120
var len_b = b.length | 0;
121-
if (len_a === len_b) {
121+
if (len_a === 0 && len_b === 0 && a.constructor === Object && b.constructor === Object) {
122+
var keys_a = Object.keys(a);
123+
var keys_b = Object.keys(b);
124+
var len_a$1 = keys_a.length;
125+
var len_b$1 = keys_b.length;
126+
var min_len = len_a$1 < len_b$1 ? len_a$1 : len_b$1;
127+
var default_res = len_a$1 - len_b$1 | 0;
122128
var a$1 = a;
129+
var keys_a$1 = keys_a;
123130
var b$1 = b;
131+
var keys_b$1 = keys_b;
124132
var _i = 0;
125-
var same_length = len_a;
133+
var min_len$1 = min_len;
134+
var default_res$1 = default_res;
126135
while(true) {
127136
var i = _i;
128-
if (i === same_length) {
129-
return 0;
137+
if (i === min_len$1) {
138+
return default_res$1;
130139
} else {
131-
var res = caml_compare(a$1[i], b$1[i]);
140+
var key_a = keys_a$1[i];
141+
var key_b = keys_b$1[i];
142+
var res = caml_compare(key_a, key_b);
132143
if (res !== 0) {
133144
return res;
134145
} else {
135-
_i = i + 1 | 0;
136-
continue ;
146+
var res$1 = caml_compare(a$1[key_a], b$1[key_b]);
147+
if (res$1 !== 0) {
148+
return res$1;
149+
} else {
150+
_i = i + 1 | 0;
151+
continue ;
152+
}
137153
}
138154
}
139155
};
140-
} else if (len_a < len_b) {
156+
} else if (len_a === len_b) {
141157
var a$2 = a;
142158
var b$2 = b;
143159
var _i$1 = 0;
144-
var short_length = len_a;
160+
var same_length = len_a;
145161
while(true) {
146162
var i$1 = _i$1;
147-
if (i$1 === short_length) {
148-
return -1;
163+
if (i$1 === same_length) {
164+
return 0;
149165
} else {
150-
var res$1 = caml_compare(a$2[i$1], b$2[i$1]);
151-
if (res$1 !== 0) {
152-
return res$1;
166+
var res$2 = caml_compare(a$2[i$1], b$2[i$1]);
167+
if (res$2 !== 0) {
168+
return res$2;
153169
} else {
154170
_i$1 = i$1 + 1 | 0;
155171
continue ;
156172
}
157173
}
158174
};
159-
} else {
175+
} else if (len_a < len_b) {
160176
var a$3 = a;
161177
var b$3 = b;
162178
var _i$2 = 0;
163-
var short_length$1 = len_b;
179+
var short_length = len_a;
164180
while(true) {
165181
var i$2 = _i$2;
166-
if (i$2 === short_length$1) {
167-
return 1;
182+
if (i$2 === short_length) {
183+
return -1;
168184
} else {
169-
var res$2 = caml_compare(a$3[i$2], b$3[i$2]);
170-
if (res$2 !== 0) {
171-
return res$2;
185+
var res$3 = caml_compare(a$3[i$2], b$3[i$2]);
186+
if (res$3 !== 0) {
187+
return res$3;
172188
} else {
173189
_i$2 = i$2 + 1 | 0;
174190
continue ;
175191
}
176192
}
177193
};
194+
} else {
195+
var a$4 = a;
196+
var b$4 = b;
197+
var _i$3 = 0;
198+
var short_length$1 = len_b;
199+
while(true) {
200+
var i$3 = _i$3;
201+
if (i$3 === short_length$1) {
202+
return 1;
203+
} else {
204+
var res$4 = caml_compare(a$4[i$3], b$4[i$3]);
205+
if (res$4 !== 0) {
206+
return res$4;
207+
} else {
208+
_i$3 = i$3 + 1 | 0;
209+
continue ;
210+
}
211+
}
212+
};
178213
}
179214
}
180215
}

0 commit comments

Comments
 (0)