Skip to content

Commit 0518798

Browse files
committed
fix #4413 -- make Some (None) not depending on physical equivalence
1 parent 14153aa commit 0518798

File tree

7 files changed

+196
-202
lines changed

7 files changed

+196
-202
lines changed

jscomp/runtime/caml_obj.ml

Lines changed: 11 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -166,32 +166,32 @@ let rec caml_compare (a : Obj.t) (b : Obj.t) : int =
166166
| "number", "number" ->
167167
Pervasives.compare (Obj.magic a : int) (Obj.magic b : int)
168168
| "number", _ ->
169-
if b == Obj.repr Js.null || Obj.tag b = 256 then 1 (* Some (Some ..) < x *)
169+
if b == Obj.repr Js.null || Caml_option.isNested b then 1 (* Some (Some ..) < x *)
170170
else
171171
-1 (* Integer < Block in OCaml runtime GPR #1195, except Some.. *)
172172
| _, "number" ->
173-
if a == Obj.repr Js.null || Obj.tag a = 256 then -1
173+
if a == Obj.repr Js.null || Caml_option.isNested a then -1
174174
else 1
175175
| _ ->
176176
if a == Obj.repr Js.null then
177177
(* [b] could not be null otherwise would equal *)
178-
if Obj.tag b = 256 then 1 else -1
178+
if Caml_option.isNested b then 1 else -1
179179
else if b == Obj.repr Js.null then
180-
if Obj.tag a = 256 then -1 else 1
180+
if Caml_option.isNested a then -1 else 1
181181
else
182-
let tag_a = Obj.tag a in
183-
let tag_b = Obj.tag b in
184182
(* double_array_tag: 254
185183
*)
186-
if tag_a = 256 then
187-
if tag_b = 256 then
188-
Pervasives.compare (Obj.magic (Obj.field a 1) : int)
189-
(Obj.magic (Obj.field b 1) : int)
184+
if Caml_option.isNested a then
185+
if Caml_option.isNested b then
186+
aux_obj_compare a b
190187
(* Some None < Some (Some None)) *)
191188
else (* b could not be undefined/None *)
192189
(* Some None < Some ..*)
193190
-1
194-
else if tag_a = 248 (* object/exception *) then
191+
else
192+
let tag_a = Obj.tag a in
193+
let tag_b = Obj.tag b in
194+
if tag_a = 248 (* object/exception *) then
195195
Pervasives.compare (Obj.magic (Obj.field a 1) : int) (Obj.magic (Obj.field b 1 ))
196196
else if tag_a = 251 (* abstract_tag *) then
197197
raise (Invalid_argument "equal: abstract value")
@@ -286,8 +286,6 @@ let rec caml_equal (a : Obj.t) (b : Obj.t) : bool =
286286
raise (Invalid_argument "equal: abstract value")
287287
else if tag_a <> tag_b then
288288
false
289-
else if tag_a = 256 then
290-
(Obj.magic (Obj.field a 1) : int) = Obj.magic (Obj.field b 1)
291289
else
292290
let len_a = Obj.size a in
293291
let len_b = Obj.size b in

jscomp/runtime/caml_option.ml

Lines changed: 16 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -22,27 +22,26 @@
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

25-
let%private undefinedHeader = [| |]
26-
type nest = (int array * int)
2725

26+
type nested = {
27+
depth : int ; [@bs.as "BS_PRIVATE_NESTED_SOME_NONE"]
28+
}
29+
30+
(* INPUT: [x] should not be nullable *)
31+
let isNested (x : Obj.t) : bool =
32+
Obj.repr ((Obj.magic x : nested).depth) != Obj.repr Js.undefined
2833

2934
let some ( x : Obj.t) : Obj.t =
3035
if Obj.magic x = None then
31-
(let block = Obj.repr (undefinedHeader, 0) in
32-
Obj.set_tag block 256;
33-
block)
36+
(Obj.repr {depth = 0})
3437
else
35-
if x != Obj.repr Js.null && match (Obj.magic x :nest ) with (x,_) -> x == undefinedHeader then
36-
(
37-
let nid = match (Obj.magic x : nest) with (_,x) -> x + 1 in
38-
let block = Obj.repr (undefinedHeader, nid) in
39-
Obj.set_tag block 256;
40-
block
41-
)
38+
(* [x] is neither None nor null so it is safe to do property access *)
39+
if x != Obj.repr Js.null && isNested x then
40+
Obj.repr {depth = (Obj.magic x : nested).depth + 1}
4241
else x
4342

44-
let nullable_to_opt (type t) ( x : t Js.null_undefined) : t option =
45-
if (Obj.magic x) == Js.null || (Obj.magic x) == Js.undefined then
43+
let nullable_to_opt (type t) ( x : t Js.nullable) : t option =
44+
if Js.isNullable x then
4645
None
4746
else Obj.magic (some (Obj.magic x : 'a))
4847

@@ -62,11 +61,11 @@ let null_to_opt (type t ) ( x : t Js.null) : t option =
6261
(** The input is already of [Some] form, [x] is not None,
6362
make sure [x[0]] will not throw *)
6463
let valFromOption (x : Obj.t) : Obj.t =
65-
if x != Obj.repr Js.null && match (Obj.magic x : nest) with (x,_) -> x == undefinedHeader
64+
if x != Obj.repr Js.null && isNested x
6665
then
67-
(match (Obj.magic x : nest) with _, depth ->
66+
let {depth } : nested = Obj.magic x in
6867
if depth = 0 then Obj.magic None
69-
else Obj.magic (undefinedHeader, depth - 1))
68+
else Obj.repr {depth = depth - 1}
7069
else Obj.magic x
7170

7271

jscomp/runtime/caml_option.mli

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,9 @@
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

25+
type nested = {
26+
depth : int ; [@bs.as "BS_PRIVATE_NESTED_SOME_NONE"]
27+
}
2528

2629
val nullable_to_opt : 'a Js.null_undefined -> 'a option
2730

@@ -33,6 +36,8 @@ val valFromOption : Obj.t -> Obj.t
3336

3437
val some : Obj.t -> Obj.t
3538

39+
val isNested : Obj.t -> bool
40+
3641
val option_get : Obj.t option -> Obj.t Caml_undefined_extern.t
3742

3843
type poly = {

lib/es6/caml_obj.js

Lines changed: 64 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -92,42 +92,42 @@ function caml_compare(a, b) {
9292
return -1;
9393
}
9494
if (a_type === "number") {
95-
if (b === null || b.TAG === 256) {
95+
if (b === null || b.BS_PRIVATE_NESTED_SOME_NONE !== undefined) {
9696
return 1;
9797
} else {
9898
return -1;
9999
}
100100
}
101101
if (b_type === "number") {
102-
if (a === null || a.TAG === 256) {
102+
if (a === null || a.BS_PRIVATE_NESTED_SOME_NONE !== undefined) {
103103
return -1;
104104
} else {
105105
return 1;
106106
}
107107
}
108108
if (a === null) {
109-
if (b.TAG === 256) {
109+
if (b.BS_PRIVATE_NESTED_SOME_NONE !== undefined) {
110110
return 1;
111111
} else {
112112
return -1;
113113
}
114114
}
115115
if (b === null) {
116-
if (a.TAG === 256) {
116+
if (a.BS_PRIVATE_NESTED_SOME_NONE !== undefined) {
117117
return -1;
118118
} else {
119119
return 1;
120120
}
121121
}
122-
var tag_a = a.TAG | 0;
123-
var tag_b = b.TAG | 0;
124-
if (tag_a === 256) {
125-
if (tag_b === 256) {
126-
return Caml_primitive.caml_int_compare(a[1], b[1]);
122+
if (a.BS_PRIVATE_NESTED_SOME_NONE !== undefined) {
123+
if (b.BS_PRIVATE_NESTED_SOME_NONE !== undefined) {
124+
return aux_obj_compare(a, b);
127125
} else {
128126
return -1;
129127
}
130128
}
129+
var tag_a = a.TAG | 0;
130+
var tag_b = b.TAG | 0;
131131
if (tag_a === 248) {
132132
return Caml_primitive.caml_int_compare(a[1], b[1]);
133133
}
@@ -165,57 +165,7 @@ function caml_compare(a, b) {
165165
} else if ((a instanceof Date && b instanceof Date)) {
166166
return (a - b);
167167
} else {
168-
var min_key_lhs = {
169-
contents: undefined
170-
};
171-
var min_key_rhs = {
172-
contents: undefined
173-
};
174-
var do_key = function (param, key) {
175-
var min_key = param[2];
176-
var b = param[1];
177-
if (!(!b.hasOwnProperty(key) || caml_compare(param[0][key], b[key]) > 0)) {
178-
return ;
179-
}
180-
var mk = min_key.contents;
181-
if (mk !== undefined && key >= mk) {
182-
return ;
183-
} else {
184-
min_key.contents = key;
185-
return ;
186-
}
187-
};
188-
var partial_arg = [
189-
a,
190-
b,
191-
min_key_rhs
192-
];
193-
var do_key_a = function (param) {
194-
return do_key(partial_arg, param);
195-
};
196-
var partial_arg$1 = [
197-
b,
198-
a,
199-
min_key_lhs
200-
];
201-
var do_key_b = function (param) {
202-
return do_key(partial_arg$1, param);
203-
};
204-
for_in(a, do_key_a);
205-
for_in(b, do_key_b);
206-
var match = min_key_lhs.contents;
207-
var match$1 = min_key_rhs.contents;
208-
if (match !== undefined) {
209-
if (match$1 !== undefined) {
210-
return Caml_primitive.caml_string_compare(match, match$1);
211-
} else {
212-
return -1;
213-
}
214-
} else if (match$1 !== undefined) {
215-
return 1;
216-
} else {
217-
return 0;
218-
}
168+
return aux_obj_compare(a, b);
219169
}
220170
} else if (len_a < len_b) {
221171
var _i$1 = 0;
@@ -249,6 +199,60 @@ function caml_compare(a, b) {
249199
}
250200
}
251201

202+
function aux_obj_compare(a, b) {
203+
var min_key_lhs = {
204+
contents: undefined
205+
};
206+
var min_key_rhs = {
207+
contents: undefined
208+
};
209+
var do_key = function (param, key) {
210+
var min_key = param[2];
211+
var b = param[1];
212+
if (!(!b.hasOwnProperty(key) || caml_compare(param[0][key], b[key]) > 0)) {
213+
return ;
214+
}
215+
var mk = min_key.contents;
216+
if (mk !== undefined && key >= mk) {
217+
return ;
218+
} else {
219+
min_key.contents = key;
220+
return ;
221+
}
222+
};
223+
var partial_arg = [
224+
a,
225+
b,
226+
min_key_rhs
227+
];
228+
var do_key_a = function (param) {
229+
return do_key(partial_arg, param);
230+
};
231+
var partial_arg$1 = [
232+
b,
233+
a,
234+
min_key_lhs
235+
];
236+
var do_key_b = function (param) {
237+
return do_key(partial_arg$1, param);
238+
};
239+
for_in(a, do_key_a);
240+
for_in(b, do_key_b);
241+
var match = min_key_lhs.contents;
242+
var match$1 = min_key_rhs.contents;
243+
if (match !== undefined) {
244+
if (match$1 !== undefined) {
245+
return Caml_primitive.caml_string_compare(match, match$1);
246+
} else {
247+
return -1;
248+
}
249+
} else if (match$1 !== undefined) {
250+
return 1;
251+
} else {
252+
return 0;
253+
}
254+
}
255+
252256
function caml_equal(a, b) {
253257
if (a === b) {
254258
return true;
@@ -283,9 +287,6 @@ function caml_equal(a, b) {
283287
if (tag_a !== tag_b) {
284288
return false;
285289
}
286-
if (tag_a === 256) {
287-
return a[1] === b[1];
288-
}
289290
var len_a = a.length | 0;
290291
var len_b = b.length | 0;
291292
if (len_a === len_b) {

lib/es6/caml_option.js

Lines changed: 18 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,26 @@
11

22

33

4-
var undefinedHeader = [];
4+
function isNested(x) {
5+
return x.BS_PRIVATE_NESTED_SOME_NONE !== undefined;
6+
}
57

68
function some(x) {
79
if (x === undefined) {
8-
var block = [
9-
undefinedHeader,
10-
0
11-
];
12-
block.TAG = 256;
13-
return block;
14-
}
15-
if (!(x !== null && x[0] === undefinedHeader)) {
10+
return {
11+
BS_PRIVATE_NESTED_SOME_NONE: 0
12+
};
13+
} else if (x !== null && x.BS_PRIVATE_NESTED_SOME_NONE !== undefined) {
14+
return {
15+
BS_PRIVATE_NESTED_SOME_NONE: x.BS_PRIVATE_NESTED_SOME_NONE + 1 | 0
16+
};
17+
} else {
1618
return x;
1719
}
18-
var nid = x[1] + 1 | 0;
19-
var block$1 = [
20-
undefinedHeader,
21-
nid
22-
];
23-
block$1.TAG = 256;
24-
return block$1;
2520
}
2621

2722
function nullable_to_opt(x) {
28-
if (x === null || x === undefined) {
23+
if (x == null) {
2924
return ;
3025
} else {
3126
return some(x);
@@ -49,17 +44,16 @@ function null_to_opt(x) {
4944
}
5045

5146
function valFromOption(x) {
52-
if (!(x !== null && x[0] === undefinedHeader)) {
47+
if (!(x !== null && x.BS_PRIVATE_NESTED_SOME_NONE !== undefined)) {
5348
return x;
5449
}
55-
var depth = x[1];
50+
var depth = x.BS_PRIVATE_NESTED_SOME_NONE;
5651
if (depth === 0) {
5752
return ;
5853
} else {
59-
return [
60-
undefinedHeader,
61-
depth - 1 | 0
62-
];
54+
return {
55+
BS_PRIVATE_NESTED_SOME_NONE: depth - 1 | 0
56+
};
6357
}
6458
}
6559

@@ -85,6 +79,7 @@ export {
8579
null_to_opt ,
8680
valFromOption ,
8781
some ,
82+
isNested ,
8883
option_get ,
8984
option_unwrap ,
9085

0 commit comments

Comments
 (0)