Skip to content

Commit da79f2e

Browse files
authored
Merge pull request #4439 from BuckleScript/tweak
fix #4413 -- make Some (None) not depending on physical equivalence
2 parents 0a19d75 + dd4f597 commit da79f2e

File tree

8 files changed

+202
-208
lines changed

8 files changed

+202
-208
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 = {

jscomp/runtime/release.ninja

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -29,19 +29,19 @@ build runtime/caml_hash_primitive.cmj : cc_cmi runtime/caml_hash_primitive.ml |
2929
build runtime/caml_hash_primitive.cmi : cc runtime/caml_hash_primitive.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
3030
build runtime/caml_int32.cmj : cc_cmi runtime/caml_int32.ml | runtime/caml_int32.cmi runtime/caml_nativeint_extern.cmj
3131
build runtime/caml_int32.cmi : cc runtime/caml_int32.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
32-
build runtime/caml_int64.cmj : cc_cmi runtime/caml_int64.ml | runtime/caml_float.cmj runtime/caml_float_extern.cmj runtime/caml_int64.cmi runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmj runtime/js.cmj
32+
build runtime/caml_int64.cmj : cc_cmi runtime/caml_int64.ml | runtime/caml_float.cmj runtime/caml_float_extern.cmj runtime/caml_int64.cmi runtime/caml_nativeint_extern.cmj runtime/caml_primitive.cmj runtime/caml_string_extern.cmj runtime/js.cmj
3333
build runtime/caml_int64.cmi : cc runtime/caml_int64.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
34-
build runtime/caml_io.cmj : cc_cmi runtime/caml_io.ml | runtime/caml_io.cmi runtime/caml_string_extern.cmj runtime/caml_undefined_extern.cmj runtime/js.cmj
34+
build runtime/caml_io.cmj : cc_cmi runtime/caml_io.ml | runtime/caml_io.cmi runtime/caml_string_extern.cmj runtime/caml_undefined_extern.cmj runtime/curry.cmj runtime/js.cmj
3535
build runtime/caml_io.cmi : cc runtime/caml_io.mli | runtime/bs_stdlib_mini.cmi runtime/caml_undefined_extern.cmj runtime/js.cmi runtime/js.cmj
3636
build runtime/caml_lexer.cmj : cc_cmi runtime/caml_lexer.ml | runtime/caml_lexer.cmi
3737
build runtime/caml_lexer.cmi : cc runtime/caml_lexer.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
3838
build runtime/caml_md5.cmj : cc_cmi runtime/caml_md5.ml | runtime/caml_array_extern.cmj runtime/caml_char.cmj runtime/caml_int32_extern.cmj runtime/caml_md5.cmi runtime/caml_string_extern.cmj
3939
build runtime/caml_md5.cmi : cc runtime/caml_md5.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
4040
build runtime/caml_module.cmj : cc_cmi runtime/caml_module.ml | runtime/caml_array_extern.cmj runtime/caml_module.cmi runtime/caml_obj.cmj
4141
build runtime/caml_module.cmi : cc runtime/caml_module.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
42-
build runtime/caml_obj.cmj : cc_cmi runtime/caml_obj.ml | runtime/caml_array_extern.cmj runtime/caml_obj.cmi runtime/js.cmj
42+
build runtime/caml_obj.cmj : cc_cmi runtime/caml_obj.ml | runtime/caml_array_extern.cmj runtime/caml_obj.cmi runtime/caml_option.cmj runtime/caml_primitive.cmj runtime/js.cmj
4343
build runtime/caml_obj.cmi : cc runtime/caml_obj.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
44-
build runtime/caml_oo.cmj : cc_cmi runtime/caml_oo.ml | runtime/caml_array_extern.cmj runtime/caml_exceptions.cmj runtime/caml_oo.cmi
44+
build runtime/caml_oo.cmj : cc_cmi runtime/caml_oo.ml | runtime/caml_array.cmj runtime/caml_array_extern.cmj runtime/caml_exceptions.cmj runtime/caml_oo.cmi
4545
build runtime/caml_oo.cmi : cc runtime/caml_oo.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
4646
build runtime/caml_option.cmj : cc_cmi runtime/caml_option.ml | runtime/caml_option.cmi runtime/caml_undefined_extern.cmj runtime/js.cmj
4747
build runtime/caml_option.cmi : cc runtime/caml_option.mli | runtime/bs_stdlib_mini.cmi runtime/caml_undefined_extern.cmj runtime/js.cmi runtime/js.cmj
@@ -63,10 +63,10 @@ build runtime/caml_external_polyfill.cmi runtime/caml_external_polyfill.cmj : cc
6363
build runtime/caml_float_extern.cmi runtime/caml_float_extern.cmj : cc runtime/caml_float_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
6464
build runtime/caml_int32_extern.cmi runtime/caml_int32_extern.cmj : cc runtime/caml_int32_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
6565
build runtime/caml_int64_extern.cmi runtime/caml_int64_extern.cmj : cc runtime/caml_int64_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
66-
build runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj : cc runtime/caml_js_exceptions.ml | runtime/bs_stdlib_mini.cmi runtime/caml_exceptions.cmj runtime/js.cmi runtime/js.cmj
66+
build runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj : cc runtime/caml_js_exceptions.ml | runtime/bs_stdlib_mini.cmi runtime/caml_exceptions.cmj runtime/caml_option.cmj runtime/js.cmi runtime/js.cmj
6767
build runtime/caml_nativeint_extern.cmi runtime/caml_nativeint_extern.cmj : cc runtime/caml_nativeint_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
6868
build runtime/caml_oo_curry.cmi runtime/caml_oo_curry.cmj : cc runtime/caml_oo_curry.ml | runtime/bs_stdlib_mini.cmi runtime/caml_oo.cmj runtime/curry.cmj runtime/js.cmi runtime/js.cmj
6969
build runtime/caml_string_extern.cmi runtime/caml_string_extern.cmj : cc runtime/caml_string_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
7070
build runtime/caml_undefined_extern.cmi runtime/caml_undefined_extern.cmj : cc runtime/caml_undefined_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj
71-
build runtime/curry.cmi runtime/curry.cmj : cc runtime/curry.ml | runtime/bs_stdlib_mini.cmi runtime/caml_array_extern.cmj runtime/js.cmi runtime/js.cmj
71+
build runtime/curry.cmi runtime/curry.cmj : cc runtime/curry.ml | runtime/bs_stdlib_mini.cmi runtime/caml_array.cmj runtime/caml_array_extern.cmj runtime/js.cmi runtime/js.cmj
7272
build runtime : phony runtime/bs_stdlib_mini.cmi runtime/js.cmj runtime/js.cmi runtime/caml_array.cmi runtime/caml_array.cmj runtime/caml_bytes.cmi runtime/caml_bytes.cmj runtime/caml_float.cmi runtime/caml_float.cmj runtime/caml_format.cmi runtime/caml_format.cmj runtime/caml_gc.cmi runtime/caml_gc.cmj runtime/caml_hash.cmi runtime/caml_hash.cmj runtime/caml_hash_primitive.cmi runtime/caml_hash_primitive.cmj runtime/caml_int32.cmi runtime/caml_int32.cmj runtime/caml_int64.cmi runtime/caml_int64.cmj runtime/caml_io.cmi runtime/caml_io.cmj runtime/caml_lexer.cmi runtime/caml_lexer.cmj runtime/caml_md5.cmi runtime/caml_md5.cmj runtime/caml_module.cmi runtime/caml_module.cmj runtime/caml_obj.cmi runtime/caml_obj.cmj runtime/caml_oo.cmi runtime/caml_oo.cmj runtime/caml_option.cmi runtime/caml_option.cmj runtime/caml_parser.cmi runtime/caml_parser.cmj runtime/caml_primitive.cmi runtime/caml_primitive.cmj runtime/caml_splice_call.cmi runtime/caml_splice_call.cmj runtime/caml_string.cmi runtime/caml_string.cmj runtime/caml_sys.cmi runtime/caml_sys.cmj runtime/caml_array_extern.cmi runtime/caml_array_extern.cmj runtime/caml_bytes_extern.cmi runtime/caml_bytes_extern.cmj runtime/caml_char.cmi runtime/caml_char.cmj runtime/caml_exceptions.cmi runtime/caml_exceptions.cmj runtime/caml_external_polyfill.cmi runtime/caml_external_polyfill.cmj runtime/caml_float_extern.cmi runtime/caml_float_extern.cmj runtime/caml_int32_extern.cmi runtime/caml_int32_extern.cmj runtime/caml_int64_extern.cmi runtime/caml_int64_extern.cmj runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj runtime/caml_nativeint_extern.cmi runtime/caml_nativeint_extern.cmj runtime/caml_oo_curry.cmi runtime/caml_oo_curry.cmj runtime/caml_string_extern.cmi runtime/caml_string_extern.cmj runtime/caml_undefined_extern.cmi runtime/caml_undefined_extern.cmj runtime/curry.cmi runtime/curry.cmj

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) {

0 commit comments

Comments
 (0)