From bf74e36357444306a0bdd19b3316bbc935756715 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Nov 2019 12:10:18 -0800 Subject: [PATCH 1/2] prepare for singleton variant -> undefined 1. is_type_number has to be adjusted in several ways for singleton variant -- its type is now undefined for non-singleton variant -- it has to still be number 2. Change Lam_compile_const.Const_pointer compilation 3. Check Pisint --- jscomp/runtime/release.ninja | 2 +- jscomp/test/singular_unit_test.ml | 14 ++++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 jscomp/test/singular_unit_test.ml diff --git a/jscomp/runtime/release.ninja b/jscomp/runtime/release.ninja index ca2e89181a..2ad795dd69 100644 --- a/jscomp/runtime/release.ninja +++ b/jscomp/runtime/release.ninja @@ -32,7 +32,7 @@ build runtime/caml_format.cmj : cc_cmi runtime/caml_format.ml | runtime/caml_bui build runtime/caml_format.cmi : cc runtime/caml_format.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj build runtime/caml_gc.cmj : cc_cmi runtime/caml_gc.ml | runtime/caml_gc.cmi build runtime/caml_gc.cmi : cc runtime/caml_gc.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -build runtime/caml_hash.cmj : cc_cmi runtime/caml_hash.ml | runtime/caml_builtin_exceptions.cmj runtime/caml_hash.cmi runtime/caml_hash_primitive.cmj runtime/caml_nativeint_extern.cmj runtime/caml_obj_extern.cmj runtime/caml_undefined_extern.cmj runtime/js.cmj +build runtime/caml_hash.cmj : cc_cmi runtime/caml_hash.ml | runtime/caml_builtin_exceptions.cmj runtime/caml_hash.cmi runtime/caml_hash_primitive.cmj runtime/caml_nativeint_extern.cmj runtime/caml_obj_extern.cmj runtime/js.cmj build runtime/caml_hash.cmi : cc runtime/caml_hash.mli | runtime/bs_stdlib_mini.cmi runtime/caml_obj_extern.cmj runtime/js.cmi runtime/js.cmj build runtime/caml_hash_primitive.cmj : cc_cmi runtime/caml_hash_primitive.ml | runtime/caml_char.cmj runtime/caml_hash_primitive.cmi runtime/caml_int32.cmj runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmj build runtime/caml_hash_primitive.cmi : cc runtime/caml_hash_primitive.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj diff --git a/jscomp/test/singular_unit_test.ml b/jscomp/test/singular_unit_test.ml new file mode 100644 index 0000000000..42afb0697f --- /dev/null +++ b/jscomp/test/singular_unit_test.ml @@ -0,0 +1,14 @@ +type t = A + +let f0 ( x : t) = + match x with + | A as y -> y + +let f1 (x : t) = + match x with + | A -> 2 + +let f3 x = + match x with + | Some (A as y) -> y + | None -> A \ No newline at end of file From 547df72ef3738c50b9d3fdd3e28f7b84ceb4c83f Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 24 Nov 2019 14:42:38 -0800 Subject: [PATCH 2/2] use enhanced pointer info --- jscomp/core/lam.ml | 2 +- jscomp/core/lam_compile_util.ml | 4 +- jscomp/core/lam_constant_convert.ml | 4 +- jscomp/core/lam_pointer_info.ml | 4 +- jscomp/core/lam_pointer_info.mli | 4 +- jscomp/test/build.ninja | 1 + jscomp/test/class3_test.js | 10 +-- jscomp/test/class4_test.js | 8 +- jscomp/test/class5_test.js | 4 +- jscomp/test/class6_test.js | 4 +- jscomp/test/class7_test.js | 8 +- jscomp/test/class8_test.js | 4 +- jscomp/test/class_fib_open_recursion_test.js | 2 +- jscomp/test/flow_parser_reg_test.js | 92 ++++++++++---------- jscomp/test/gpr_1539_test.js | 4 +- jscomp/test/gpr_3931_test.js | 8 +- jscomp/test/rec_module_test.js | 28 +++--- jscomp/test/record_name_test.js | 5 ++ jscomp/test/record_name_test.ml | 14 +++ jscomp/test/recursive_module.js | 20 ++--- jscomp/test/recursive_module_test.js | 8 +- jscomp/test/recursive_unbound_module_test.js | 4 +- jscomp/test/singular_unit_test.js | 26 ++++++ jscomp/test/singular_unit_test.ml | 5 +- lib/4.06.1/bsdep.ml | 8 +- lib/4.06.1/bsppx.ml | 8 +- lib/4.06.1/unstable/js_compiler.ml | 53 +++++------ lib/4.06.1/unstable/native_ppx.ml | 8 +- lib/4.06.1/whole_compiler.ml | 53 +++++------ ocaml | 2 +- 30 files changed, 230 insertions(+), 175 deletions(-) create mode 100644 jscomp/test/singular_unit_test.js diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml index 7bd02a9752..3cbb94c26d 100644 --- a/jscomp/core/lam.ml +++ b/jscomp/core/lam.ml @@ -410,7 +410,7 @@ let false_ : t = Lconst (Const_js_false) let unit : t = - Lconst (Const_pointer( 0, Pt_constructor "()")) + Lconst (Const_pointer( 0, Pt_constructor {name = "()"; cstrs = 1,0})) diff --git a/jscomp/core/lam_compile_util.ml b/jscomp/core/lam_compile_util.ml index b1c0411cc4..9a22841657 100644 --- a/jscomp/core/lam_compile_util.ml +++ b/jscomp/core/lam_compile_util.ml @@ -61,7 +61,7 @@ let comment_of_tag_info (x : Lam_tag_info.t) = | Blk_na s -> if s = "" then None else Some s let comment_of_pointer_info (x : Lam_pointer_info.t)= match x with - | Pt_constructor x -> Some x - | Pt_variant x -> Some x + | Pt_constructor {name} + | Pt_variant {name} -> Some name | Pt_module_alias -> None (* FIXME *) | Pt_na -> None diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index 8c0b02babf..319a3cafac 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -40,8 +40,8 @@ let rec convert_constant ( const : Lambda.structured_constant) : Lam_constant.t | Const_base (Const_nativeint i) -> (Const_nativeint i) | Const_pointer(i,p) -> begin match p with - | Pt_constructor p -> Const_pointer(i, Pt_constructor p) - | Pt_variant p -> Const_pointer(i,Pt_variant p) + | Pt_constructor {name;cstrs} -> Const_pointer(i, Pt_constructor {name; cstrs}) + | Pt_variant {name} -> Const_pointer(i,Pt_variant {name}) | Pt_module_alias -> Const_pointer(i, Pt_module_alias) | Pt_builtin_boolean -> if i = 0 then Const_js_false else Const_js_true | Pt_shape_none -> diff --git a/jscomp/core/lam_pointer_info.ml b/jscomp/core/lam_pointer_info.ml index 4e3a013583..f6e02fad0b 100644 --- a/jscomp/core/lam_pointer_info.ml +++ b/jscomp/core/lam_pointer_info.ml @@ -24,7 +24,7 @@ type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of {name : string } | Pt_module_alias | Pt_na diff --git a/jscomp/core/lam_pointer_info.mli b/jscomp/core/lam_pointer_info.mli index 4e3a013583..b31c2d2bdb 100644 --- a/jscomp/core/lam_pointer_info.mli +++ b/jscomp/core/lam_pointer_info.mli @@ -24,7 +24,7 @@ type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of { name : string} | Pt_module_alias | Pt_na diff --git a/jscomp/test/build.ninja b/jscomp/test/build.ninja index ca62612873..40eef0588e 100644 --- a/jscomp/test/build.ninja +++ b/jscomp/test/build.ninja @@ -526,6 +526,7 @@ build test/simple_derive_use.cmi : cc test/simple_derive_use.mli | $stdlib build test/simple_lexer_test.cmi test/simple_lexer_test.cmj : cc test/simple_lexer_test.ml | test/mt.cmj $stdlib build test/simplify_lambda_632o.cmi test/simplify_lambda_632o.cmj : cc test/simplify_lambda_632o.ml | $stdlib build test/single_module_alias.cmi test/single_module_alias.cmj : cc test/single_module_alias.ml | $stdlib +build test/singular_unit_test.cmi test/singular_unit_test.cmj : cc test/singular_unit_test.ml | $stdlib build test/small_inline_test.cmi test/small_inline_test.cmj : cc test/small_inline_test.ml | $stdlib build test/splice_test.cmi test/splice_test.cmj : cc test/splice_test.ml | test/mt.cmj $stdlib build test/sprintf_reg_test.cmi test/sprintf_reg_test.cmj : cc test/sprintf_reg_test.ml | test/mt.cmj test/mt_global.cmj $stdlib diff --git a/jscomp/test/class3_test.js b/jscomp/test/class3_test.js index 7aa9c111e1..aad8a157d9 100644 --- a/jscomp/test/class3_test.js +++ b/jscomp/test/class3_test.js @@ -349,7 +349,7 @@ function vpoint_init($$class) { var move = ids[0]; var get_x = ids[1]; var x = ids[2]; - var inh = CamlinternalOO.inherits($$class, 0, shared$5, /* array */["get_offset"], abstract_point, 1); + var inh = CamlinternalOO.inherits($$class, 0, shared$5, /* array */["get_offset"], abstract_point, true); var obj_init = inh[0]; CamlinternalOO.set_methods($$class, /* array */[ get_x, @@ -404,7 +404,7 @@ var abstract_point2 = /* class */[ function point2_init($$class) { var x_init = CamlinternalOO.new_variable($$class, ""); var get_offset = CamlinternalOO.get_method_label($$class, "get_offset"); - var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$8, abstract_point2, 1); + var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$8, abstract_point2, true); var obj_init = inh[0]; var x = inh[1]; CamlinternalOO.set_method($$class, get_offset, (function (self$10) { @@ -482,7 +482,7 @@ eq("File \"class3_test.ml\", line 144, characters 12-19", h$2, 1); function point_again_init($$class) { var x = CamlinternalOO.new_variable($$class, ""); CamlinternalOO.get_method_label($$class, "move"); - var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$7, restricted_point, 1); + var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$7, restricted_point, true); var obj_init = inh[0]; return (function (env, self, x$1) { var self$1 = CamlinternalOO.create_object_opt(self, $$class); @@ -508,7 +508,7 @@ eq("File \"class3_test.ml\", line 161, characters 12-19", hh, 8); function point_again2_init($$class) { var x = CamlinternalOO.new_variable($$class, ""); - var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$7, restricted_point, 1); + var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$7, restricted_point, true); var obj_init = inh[0]; return (function (env, self, x$1) { var self$1 = CamlinternalOO.create_object_opt(self, $$class); @@ -535,7 +535,7 @@ eq("File \"class3_test.ml\", line 177, characters 12-19", hhh, 35); function point_again3_init($$class) { var x = CamlinternalOO.new_variable($$class, ""); var move = CamlinternalOO.get_method_label($$class, "move"); - var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$7, restricted_point, 1); + var inh = CamlinternalOO.inherits($$class, shared$3, 0, shared$7, restricted_point, true); var obj_init = inh[0]; var move$1 = inh[4]; CamlinternalOO.set_method($$class, move, Curry.__1(move$1)); diff --git a/jscomp/test/class4_test.js b/jscomp/test/class4_test.js index 313737b5ff..22641d19e7 100644 --- a/jscomp/test/class4_test.js +++ b/jscomp/test/class4_test.js @@ -80,7 +80,7 @@ function restricted_point_init($$class) { var restricted_point = CamlinternalOO.make_class(shared$2, restricted_point_init); function restricted_point$prime_init($$class) { - var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, 1); + var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, true); var obj_init = inh[0]; return (function (env, self, x) { return Curry._2(obj_init, self, x); @@ -90,7 +90,7 @@ function restricted_point$prime_init($$class) { var restricted_point$prime = CamlinternalOO.make_class(shared$2, restricted_point$prime_init); function restricted_point2$prime_init($$class) { - var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, 1); + var inh = CamlinternalOO.inherits($$class, 0, 0, shared$2, restricted_point, true); var obj_init = inh[0]; return (function (env, self, x) { return Curry._2(obj_init, self, x); @@ -135,7 +135,7 @@ function point_init($$class) { var move = ids[0]; var get_x = ids[1]; var x = ids[2]; - var inh = CamlinternalOO.inherits($$class, 0, shared$1, /* array */["get_offset"], abstract_point, 1); + var inh = CamlinternalOO.inherits($$class, 0, shared$1, /* array */["get_offset"], abstract_point, true); var obj_init = inh[0]; CamlinternalOO.set_methods($$class, /* array */[ get_x, @@ -173,7 +173,7 @@ function colored_point_init($$class) { "get_offset", "get_x", "move" - ], point, 1); + ], point, true); var obj_init = inh[0]; CamlinternalOO.set_method($$class, color, (function (self$7) { return self$7[c$1]; diff --git a/jscomp/test/class5_test.js b/jscomp/test/class5_test.js index c0992ad99b..5c22d0b630 100644 --- a/jscomp/test/class5_test.js +++ b/jscomp/test/class5_test.js @@ -102,7 +102,7 @@ function printable_colored_point_init($$class) { "get_x", "move", "print" - ], printable_point, 1); + ], printable_point, true); var obj_init = inh[0]; var print$1 = inh[4]; CamlinternalOO.set_method($$class, print, (function (self$2) { @@ -289,7 +289,7 @@ function distance_point_init($$class) { var inh = CamlinternalOO.inherits($$class, shared$1, 0, /* array */[ "get_x", "move" - ], point, 1); + ], point, true); var obj_init = inh[0]; var x$1 = inh[1]; CamlinternalOO.set_method($$class, distance, (function (self$7, other) { diff --git a/jscomp/test/class6_test.js b/jscomp/test/class6_test.js index 9f586a1860..ec4bdb6e77 100644 --- a/jscomp/test/class6_test.js +++ b/jscomp/test/class6_test.js @@ -79,7 +79,7 @@ function colored_point_init($$class) { var inh = CamlinternalOO.inherits($$class, shared, 0, /* array */[ "get_x", "move" - ], point, 1); + ], point, true); var obj_init = inh[0]; CamlinternalOO.set_method($$class, color, (function (self$2) { return self$2[c$1]; @@ -144,7 +144,7 @@ function d_init($$class) { ]); var n = ids[0]; var as_c = ids[1]; - var inh = CamlinternalOO.inherits($$class, 0, 0, shared$1, c, 1); + var inh = CamlinternalOO.inherits($$class, 0, 0, shared$1, c, true); var obj_init = inh[0]; CamlinternalOO.set_methods($$class, /* array */[ n, diff --git a/jscomp/test/class7_test.js b/jscomp/test/class7_test.js index 4ff34f6087..9e146fe258 100644 --- a/jscomp/test/class7_test.js +++ b/jscomp/test/class7_test.js @@ -162,12 +162,12 @@ var backup = CamlinternalOO.make_class(shared$5, backup_init); function backup_ref_init($$class) { var x = CamlinternalOO.new_variable($$class, ""); - var inh = CamlinternalOO.inherits($$class, shared$2, 0, shared$6, ref, 1); + var inh = CamlinternalOO.inherits($$class, shared$2, 0, shared$6, ref, true); var obj_init = inh[0]; var inh$1 = CamlinternalOO.inherits($$class, shared$3, 0, /* array */[ "restore", "save" - ], backup, 1); + ], backup, true); var obj_init$1 = inh$1[0]; return (function (env, self, x$1) { var self$1 = CamlinternalOO.create_object_opt(self, $$class); @@ -269,13 +269,13 @@ var backup2 = CamlinternalOO.make_class(/* array */[ function backup_ref2_init($$class) { var x = CamlinternalOO.new_variable($$class, ""); - var inh = CamlinternalOO.inherits($$class, shared$2, 0, shared$6, ref, 1); + var inh = CamlinternalOO.inherits($$class, shared$2, 0, shared$6, ref, true); var obj_init = inh[0]; var inh$1 = CamlinternalOO.inherits($$class, shared$3, 0, /* array */[ "clear", "restore", "save" - ], backup2, 1); + ], backup2, true); var obj_init$1 = inh$1[0]; return (function (env, self, x$1) { var self$1 = CamlinternalOO.create_object_opt(self, $$class); diff --git a/jscomp/test/class8_test.js b/jscomp/test/class8_test.js index 673c7cba04..7365eb77d6 100644 --- a/jscomp/test/class8_test.js +++ b/jscomp/test/class8_test.js @@ -49,7 +49,7 @@ function money_init($$class) { var value = ids[0]; var leq = ids[1]; var repr = ids[2]; - var inh = CamlinternalOO.inherits($$class, 0, /* array */["leq"], 0, comparable, 1); + var inh = CamlinternalOO.inherits($$class, 0, /* array */["leq"], 0, comparable, true); var obj_init = inh[0]; CamlinternalOO.set_methods($$class, /* array */[ value, @@ -75,7 +75,7 @@ var money = CamlinternalOO.make_class(shared, money_init); function money2_init($$class) { var x = CamlinternalOO.new_variable($$class, ""); var times = CamlinternalOO.get_method_label($$class, "times"); - var inh = CamlinternalOO.inherits($$class, shared$1, 0, shared, money, 1); + var inh = CamlinternalOO.inherits($$class, shared$1, 0, shared, money, true); var obj_init = inh[0]; var repr = inh[1]; CamlinternalOO.set_method($$class, times, (function (self$3, k) { diff --git a/jscomp/test/class_fib_open_recursion_test.js b/jscomp/test/class_fib_open_recursion_test.js index 874f3c8864..954d21b946 100644 --- a/jscomp/test/class_fib_open_recursion_test.js +++ b/jscomp/test/class_fib_open_recursion_test.js @@ -55,7 +55,7 @@ function memo_fib_init($$class) { var ids = CamlinternalOO.new_methods_variables($$class, shared, /* array */["cache"]); var calc = ids[0]; var cache = ids[1]; - var inh = CamlinternalOO.inherits($$class, 0, 0, shared, fib, 1); + var inh = CamlinternalOO.inherits($$class, 0, 0, shared, fib, true); var obj_init = inh[0]; var calc$1 = inh[1]; CamlinternalOO.set_method($$class, calc, (function (self$2, x) { diff --git a/jscomp/test/flow_parser_reg_test.js b/jscomp/test/flow_parser_reg_test.js index c023ba6ca7..351b20e3f0 100644 --- a/jscomp/test/flow_parser_reg_test.js +++ b/jscomp/test/flow_parser_reg_test.js @@ -6155,95 +6155,95 @@ var Parse = Caml_module.init_mod(/* tuple */[ 6 ], /* Module */Block.__(0, [/* array */[ /* tuple */[ - 0, + /* Function */0, "program" ], /* tuple */[ - 0, + /* Function */0, "statement" ], /* tuple */[ - 0, + /* Function */0, "statement_list_item" ], /* tuple */[ - 0, + /* Function */0, "statement_list" ], /* tuple */[ - 0, + /* Function */0, "statement_list_with_directives" ], /* tuple */[ - 0, + /* Function */0, "module_body" ], /* tuple */[ - 0, + /* Function */0, "expression" ], /* tuple */[ - 0, + /* Function */0, "assignment" ], /* tuple */[ - 0, + /* Function */0, "object_initializer" ], /* tuple */[ - 0, + /* Function */0, "array_initializer" ], /* tuple */[ - 0, + /* Function */0, "identifier" ], /* tuple */[ - 0, + /* Function */0, "identifier_or_reserved_keyword" ], /* tuple */[ - 0, + /* Function */0, "identifier_with_type" ], /* tuple */[ - 0, + /* Function */0, "block_body" ], /* tuple */[ - 0, + /* Function */0, "function_block_body" ], /* tuple */[ - 0, + /* Function */0, "jsx_element" ], /* tuple */[ - 0, + /* Function */0, "pattern" ], /* tuple */[ - 0, + /* Function */0, "pattern_from_expr" ], /* tuple */[ - 0, + /* Function */0, "object_key" ], /* tuple */[ - 0, + /* Function */0, "class_declaration" ], /* tuple */[ - 0, + /* Function */0, "class_expression" ], /* tuple */[ - 0, + /* Function */0, "is_assignable_lhs" ], /* tuple */[ - 0, + /* Function */0, "predicate" ] ]])); @@ -13914,95 +13914,95 @@ function predicate(env) { Caml_module.update_mod(/* Module */Block.__(0, [/* array */[ /* tuple */[ - 0, + /* Function */0, "program" ], /* tuple */[ - 0, + /* Function */0, "statement" ], /* tuple */[ - 0, + /* Function */0, "statement_list_item" ], /* tuple */[ - 0, + /* Function */0, "statement_list" ], /* tuple */[ - 0, + /* Function */0, "statement_list_with_directives" ], /* tuple */[ - 0, + /* Function */0, "module_body" ], /* tuple */[ - 0, + /* Function */0, "expression" ], /* tuple */[ - 0, + /* Function */0, "assignment" ], /* tuple */[ - 0, + /* Function */0, "object_initializer" ], /* tuple */[ - 0, + /* Function */0, "array_initializer" ], /* tuple */[ - 0, + /* Function */0, "identifier" ], /* tuple */[ - 0, + /* Function */0, "identifier_or_reserved_keyword" ], /* tuple */[ - 0, + /* Function */0, "identifier_with_type" ], /* tuple */[ - 0, + /* Function */0, "block_body" ], /* tuple */[ - 0, + /* Function */0, "function_block_body" ], /* tuple */[ - 0, + /* Function */0, "jsx_element" ], /* tuple */[ - 0, + /* Function */0, "pattern" ], /* tuple */[ - 0, + /* Function */0, "pattern_from_expr" ], /* tuple */[ - 0, + /* Function */0, "object_key" ], /* tuple */[ - 0, + /* Function */0, "class_declaration" ], /* tuple */[ - 0, + /* Function */0, "class_expression" ], /* tuple */[ - 0, + /* Function */0, "is_assignable_lhs" ], /* tuple */[ - 0, + /* Function */0, "predicate" ] ]]), Parse, { diff --git a/jscomp/test/gpr_1539_test.js b/jscomp/test/gpr_1539_test.js index 64e4373f7f..8c037f3522 100644 --- a/jscomp/test/gpr_1539_test.js +++ b/jscomp/test/gpr_1539_test.js @@ -8,12 +8,12 @@ var Point = Caml_module.init_mod(/* tuple */[ 10, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "add" ]]])); Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "add" ]]]), Point, { add: (function (prim, prim$1) { diff --git a/jscomp/test/gpr_3931_test.js b/jscomp/test/gpr_3931_test.js index d7b2875cdf..7b66389134 100644 --- a/jscomp/test/gpr_3931_test.js +++ b/jscomp/test/gpr_3931_test.js @@ -10,7 +10,7 @@ var PA = Caml_module.init_mod(/* tuple */[ 3, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "print" ]]])); @@ -19,7 +19,7 @@ var P = Caml_module.init_mod(/* tuple */[ 11, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "print" ]]])); @@ -28,7 +28,7 @@ function print(a) { } Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "print" ]]]), PA, { print: print @@ -40,7 +40,7 @@ function print$1(i) { } Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "print" ]]]), P, { print: print$1 diff --git a/jscomp/test/rec_module_test.js b/jscomp/test/rec_module_test.js index bca440cf7a..4fd47b564c 100644 --- a/jscomp/test/rec_module_test.js +++ b/jscomp/test/rec_module_test.js @@ -14,7 +14,7 @@ var A = Caml_module.init_mod(/* tuple */[ 3, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "even" ]]])); @@ -23,7 +23,7 @@ var B = Caml_module.init_mod(/* tuple */[ 11, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "odd" ]]])); @@ -38,7 +38,7 @@ function even(n) { } Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "even" ]]]), A, { even: even @@ -55,7 +55,7 @@ function odd(n) { } Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "odd" ]]]), B, { odd: odd @@ -67,11 +67,11 @@ var AA = Caml_module.init_mod(/* tuple */[ 6 ], /* Module */Block.__(0, [/* array */[ /* tuple */[ - 0, + /* Function */0, "even" ], /* tuple */[ - 0, + /* Function */0, "x" ] ]])); @@ -82,11 +82,11 @@ var BB = Caml_module.init_mod(/* tuple */[ 6 ], /* Module */Block.__(0, [/* array */[ /* tuple */[ - 0, + /* Function */0, "odd" ], /* tuple */[ - 0, + /* Function */0, "y" ] ]])); @@ -107,11 +107,11 @@ function x(param) { Caml_module.update_mod(/* Module */Block.__(0, [/* array */[ /* tuple */[ - 0, + /* Function */0, "even" ], /* tuple */[ - 0, + /* Function */0, "x" ] ]]), AA, { @@ -135,11 +135,11 @@ function y(param) { Caml_module.update_mod(/* Module */Block.__(0, [/* array */[ /* tuple */[ - 0, + /* Function */0, "odd" ], /* tuple */[ - 0, + /* Function */0, "y" ] ]]), BB, { @@ -152,7 +152,7 @@ var AAA = Caml_module.init_mod(/* tuple */[ 55, 2 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "compare" ]]])); @@ -1201,7 +1201,7 @@ function compare$1(t1, t2) { } Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "compare" ]]]), AAA, { compare: compare$1 diff --git a/jscomp/test/record_name_test.js b/jscomp/test/record_name_test.js index 14d548b524..f5ab4decba 100644 --- a/jscomp/test/record_name_test.js +++ b/jscomp/test/record_name_test.js @@ -30,9 +30,14 @@ function f3(x) { }; } +function f4(param) { + return (((param.EXACT_MAPPING_TO_JS_LABEL + param.EXACT_2 | 0) + param.z.hello | 0) << 1); +} + exports.f = f; exports.set = set; exports.f1 = f1; exports.f2 = f2; exports.f3 = f3; +exports.f4 = f4; /* No side effect */ diff --git a/jscomp/test/record_name_test.ml b/jscomp/test/record_name_test.ml index c106bedf91..c86204d22a 100644 --- a/jscomp/test/record_name_test.ml +++ b/jscomp/test/record_name_test.ml @@ -51,3 +51,17 @@ type t3 = { let f3 (x : t3) = x.x' <- x.x' + 3; {x' = x.x' + 3} + +type entry = { + x : int ; [@bs.as "EXACT_MAPPING_TO_JS_LABEL"] + y : int ; [@bs.as "EXACT_2"] + z : obj +} +and obj = { + hi : int ; [@bs.as "hello"] +} + + +let f4 ({ x; y; z = {hi }}: entry) = + (x + y + hi) * 2 + \ No newline at end of file diff --git a/jscomp/test/recursive_module.js b/jscomp/test/recursive_module.js index 6e5a53af8e..d3a1985ae0 100644 --- a/jscomp/test/recursive_module.js +++ b/jscomp/test/recursive_module.js @@ -34,12 +34,12 @@ var Int3 = Caml_module.init_mod(/* tuple */[ 27, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "u" ]]])); Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "u" ]]]), Int3, Int3); @@ -48,7 +48,7 @@ var Inta = Caml_module.init_mod(/* tuple */[ 31, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]])); @@ -57,7 +57,7 @@ var Intb = Caml_module.init_mod(/* tuple */[ 36, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]])); @@ -66,7 +66,7 @@ var a = Caml_obj.caml_lazy_make((function (param) { })); Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]]), Inta, { a: a @@ -77,7 +77,7 @@ var a$1 = Caml_obj.caml_lazy_make((function (param) { })); Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]]), Intb, { a: a$1 @@ -103,7 +103,7 @@ var Inta$1 = Caml_module.init_mod(/* tuple */[ 48, 8 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]])); @@ -112,7 +112,7 @@ var Intb$1 = Caml_module.init_mod(/* tuple */[ 53, 8 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]])); @@ -121,14 +121,14 @@ var a$2 = Caml_obj.caml_lazy_make((function (param) { })); Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]]), Inta$1, { a: a$2 }); Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 1, + /* Lazy */1, "a" ]]]), Intb$1, { a: 2 diff --git a/jscomp/test/recursive_module_test.js b/jscomp/test/recursive_module_test.js index ca1f9eb4da..4dafe2c41f 100644 --- a/jscomp/test/recursive_module_test.js +++ b/jscomp/test/recursive_module_test.js @@ -44,12 +44,12 @@ var Int3 = Caml_module.init_mod(/* tuple */[ 13, 6 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "u" ]]])); Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "u" ]]]), Int3, Int3); @@ -58,7 +58,7 @@ var M = Caml_module.init_mod(/* tuple */[ 20, 20 ], /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "fact" ]]])); @@ -71,7 +71,7 @@ function fact(n) { } Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "fact" ]]]), M, { fact: fact diff --git a/jscomp/test/recursive_unbound_module_test.js b/jscomp/test/recursive_unbound_module_test.js index 3970c6ed28..1ba204a35c 100644 --- a/jscomp/test/recursive_unbound_module_test.js +++ b/jscomp/test/recursive_unbound_module_test.js @@ -21,7 +21,7 @@ var B = Caml_module.init_mod(/* tuple */[ 0 ], /* Module */Block.__(0, [/* array */[/* tuple */[ /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "f" ]]]), "M" @@ -37,7 +37,7 @@ var M = { Caml_module.update_mod(/* Module */Block.__(0, [/* array */[/* tuple */[ /* Module */Block.__(0, [/* array */[/* tuple */[ - 0, + /* Function */0, "f" ]]]), "M" diff --git a/jscomp/test/singular_unit_test.js b/jscomp/test/singular_unit_test.js new file mode 100644 index 0000000000..658aeb4f0f --- /dev/null +++ b/jscomp/test/singular_unit_test.js @@ -0,0 +1,26 @@ +'use strict'; + + +function f0(x) { + return x; +} + +function f1(x) { + return 2; +} + +function f3(x) { + if (x !== undefined) { + return x; + } else { + return /* A */0; + } +} + +var v0 = /* () */0; + +exports.f0 = f0; +exports.f1 = f1; +exports.f3 = f3; +exports.v0 = v0; +/* No side effect */ diff --git a/jscomp/test/singular_unit_test.ml b/jscomp/test/singular_unit_test.ml index 42afb0697f..7e7f6c2664 100644 --- a/jscomp/test/singular_unit_test.ml +++ b/jscomp/test/singular_unit_test.ml @@ -11,4 +11,7 @@ let f1 (x : t) = let f3 x = match x with | Some (A as y) -> y - | None -> A \ No newline at end of file + | None -> A + + +let v0 = () \ No newline at end of file diff --git a/lib/4.06.1/bsdep.ml b/lib/4.06.1/bsdep.ml index 86d333e1c4..5aa27202a9 100644 --- a/lib/4.06.1/bsdep.ml +++ b/lib/4.06.1/bsdep.ml @@ -40087,8 +40087,8 @@ module Lam_pointer_info : sig type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of { name : string} | Pt_module_alias | Pt_na @@ -40120,8 +40120,8 @@ end = struct type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of {name : string } | Pt_module_alias | Pt_na diff --git a/lib/4.06.1/bsppx.ml b/lib/4.06.1/bsppx.ml index e77016a61e..1708b11996 100644 --- a/lib/4.06.1/bsppx.ml +++ b/lib/4.06.1/bsppx.ml @@ -19041,8 +19041,8 @@ module Lam_pointer_info : sig type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of { name : string} | Pt_module_alias | Pt_na @@ -19074,8 +19074,8 @@ end = struct type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of {name : string } | Pt_module_alias | Pt_na diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml index 0e0d76dfd9..5224f306b7 100644 --- a/lib/4.06.1/unstable/js_compiler.ml +++ b/lib/4.06.1/unstable/js_compiler.ml @@ -18948,8 +18948,8 @@ module Lam_pointer_info : sig type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of { name : string} | Pt_module_alias | Pt_na @@ -18981,8 +18981,8 @@ end = struct type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of {name : string } | Pt_module_alias | Pt_na @@ -35670,14 +35670,14 @@ type is_safe = | Unsafe type pointer_info = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string; cstrs : int * int} + | Pt_variant of {name : string} | Pt_module_alias | Pt_builtin_boolean | Pt_shape_none | Pt_na -val default_pointer_info : pointer_info + type primitive = | Pidentity @@ -36261,14 +36261,13 @@ and raise_kind = | Raise_notrace type pointer_info = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string; cstrs : int * int } + | Pt_variant of {name : string} | Pt_module_alias | Pt_builtin_boolean | Pt_shape_none | Pt_na -let default_pointer_info = Pt_na type structured_constant = Const_base of constant @@ -36372,9 +36371,13 @@ type program = required_globals : Ident.Set.t; code : lambda } -let const_unit = Const_pointer(0, default_pointer_info) +(* This is actually a dummy value + not necessary "()", it can be used as a place holder for module + alias etc. +*) +let const_unit = Const_pointer(0, Pt_na) -let lambda_assert_false = Lconst (Const_pointer(0, Pt_constructor "assert false")) +let lambda_assert_false = Lconst (Const_pointer(0, Pt_constructor {name = "assert false"; cstrs = (1,0)})) let lambda_unit = Lconst const_unit @@ -87345,7 +87348,7 @@ let false_ : t = Lconst (Const_js_false) let unit : t = - Lconst (Const_pointer( 0, Pt_constructor "()")) + Lconst (Const_pointer( 0, Pt_constructor {name = "()"; cstrs = 1,0})) @@ -94532,8 +94535,8 @@ let comment_of_tag_info (x : Lam_tag_info.t) = | Blk_na s -> if s = "" then None else Some s let comment_of_pointer_info (x : Lam_pointer_info.t)= match x with - | Pt_constructor x -> Some x - | Pt_variant x -> Some x + | Pt_constructor {name} + | Pt_variant {name} -> Some name | Pt_module_alias -> None (* FIXME *) | Pt_na -> None @@ -106836,7 +106839,7 @@ and transl_exp0 e = | Longident.Lident "None" when Datarepr.constructor_has_optional_shape cstr -> Pt_shape_none - | _ -> (Lambda.Pt_constructor cstr.cstr_name) + | _ -> (Lambda.Pt_constructor {name = cstr.cstr_name; cstrs = cstr.cstr_consts,cstr.cstr_nonconsts}) )) | Cstr_unboxed -> (match ll with [v] -> v | _ -> assert false) @@ -106870,7 +106873,7 @@ and transl_exp0 e = | Texp_variant(l, arg) -> let tag = Btype.hash_variant l in begin match arg with - None -> Lconst(Const_pointer (tag, Lambda.Pt_variant l)) + None -> Lconst(Const_pointer (tag, Pt_variant {name = l})) | Some arg -> let lam = transl_exp arg in let tag_info = Lambda.Blk_variant l in @@ -107853,7 +107856,7 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl = (inh_init, Llet (Strict, Pgenval, inh, mkappl(oo_prim "inherits", narrow_args @ - [lpath; Lconst(Const_pointer((if top then 1 else 0),Lambda.Pt_na))]), + [lpath; Lconst(Const_pointer((if top then 1 else 0),Pt_builtin_boolean))]), Llet(StrictOpt, Pgenval, obj_init, lfield inh 0, cl_init))) | _ -> let core cl_init = @@ -108683,7 +108686,7 @@ let undefined_location loc = [Const_base(Const_string (fname, None)); Const_base(Const_int line); Const_base(Const_int char)])) - +let cstrs = (3,2) let init_shape modl = let add_name x id = if !Clflags.bs_only then @@ -108696,7 +108699,7 @@ let init_shape modl = Mty_ident _ -> raise Not_found | Mty_alias _ -> - Const_block (1, value_tag_info, [Const_pointer (0, Lambda.Pt_module_alias)]) + Const_block (1, value_tag_info, [Const_pointer (0, Pt_module_alias)]) | Mty_signature sg -> Const_block(0, module_tag_info, [Const_block(0, Blk_array, init_shape_struct env sg)]) | Mty_functor _ -> @@ -108708,9 +108711,9 @@ let init_shape modl = let init_v = match Ctype.expand_head env ty with {desc = Tarrow(_,_,_,_)} -> - Const_pointer (0, Lambda.default_pointer_info) (* camlinternalMod.Function *) + Const_pointer (0, Pt_constructor{name = "Function"; cstrs}) | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t -> - Const_pointer (1, Lambda.default_pointer_info) (* camlinternalMod.Lazy *) + Const_pointer (1, Pt_constructor{name = "Lazy"; cstrs}) | _ -> raise Not_found in (add_name init_v id) :: init_shape_struct env rem | Sig_value(_, {val_kind=Val_prim _}) :: rem -> @@ -108728,7 +108731,7 @@ let init_shape modl = | Sig_modtype(id, minfo) :: rem -> init_shape_struct (Env.add_modtype id minfo env) rem | Sig_class (id,_,_) :: rem -> - (add_name (Const_pointer (2, Lambda.default_pointer_info)) id) (* camlinternalMod.Class *) + (add_name (Const_pointer (2, Pt_constructor{name = "Class";cstrs})) id) :: init_shape_struct env rem | Sig_class_type _ :: rem -> init_shape_struct env rem @@ -125617,8 +125620,8 @@ let rec convert_constant ( const : Lambda.structured_constant) : Lam_constant.t | Const_base (Const_nativeint i) -> (Const_nativeint i) | Const_pointer(i,p) -> begin match p with - | Pt_constructor p -> Const_pointer(i, Pt_constructor p) - | Pt_variant p -> Const_pointer(i,Pt_variant p) + | Pt_constructor {name;cstrs} -> Const_pointer(i, Pt_constructor {name; cstrs}) + | Pt_variant {name} -> Const_pointer(i,Pt_variant {name}) | Pt_module_alias -> Const_pointer(i, Pt_module_alias) | Pt_builtin_boolean -> if i = 0 then Const_js_false else Const_js_true | Pt_shape_none -> diff --git a/lib/4.06.1/unstable/native_ppx.ml b/lib/4.06.1/unstable/native_ppx.ml index aeb0958e1d..d505c5226b 100644 --- a/lib/4.06.1/unstable/native_ppx.ml +++ b/lib/4.06.1/unstable/native_ppx.ml @@ -18106,8 +18106,8 @@ module Lam_pointer_info : sig type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of { name : string} | Pt_module_alias | Pt_na @@ -18139,8 +18139,8 @@ end = struct type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of {name : string } | Pt_module_alias | Pt_na diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml index b5701a3ed7..f954d0562d 100644 --- a/lib/4.06.1/whole_compiler.ml +++ b/lib/4.06.1/whole_compiler.ml @@ -20351,14 +20351,14 @@ type is_safe = | Unsafe type pointer_info = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string; cstrs : int * int} + | Pt_variant of {name : string} | Pt_module_alias | Pt_builtin_boolean | Pt_shape_none | Pt_na -val default_pointer_info : pointer_info + type primitive = | Pidentity @@ -20942,14 +20942,13 @@ and raise_kind = | Raise_notrace type pointer_info = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string; cstrs : int * int } + | Pt_variant of {name : string} | Pt_module_alias | Pt_builtin_boolean | Pt_shape_none | Pt_na -let default_pointer_info = Pt_na type structured_constant = Const_base of constant @@ -21053,9 +21052,13 @@ type program = required_globals : Ident.Set.t; code : lambda } -let const_unit = Const_pointer(0, default_pointer_info) +(* This is actually a dummy value + not necessary "()", it can be used as a place holder for module + alias etc. +*) +let const_unit = Const_pointer(0, Pt_na) -let lambda_assert_false = Lconst (Const_pointer(0, Pt_constructor "assert false")) +let lambda_assert_false = Lconst (Const_pointer(0, Pt_constructor {name = "assert false"; cstrs = (1,0)})) let lambda_unit = Lconst const_unit @@ -77079,8 +77082,8 @@ module Lam_pointer_info : sig type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of { name : string} | Pt_module_alias | Pt_na @@ -77112,8 +77115,8 @@ end = struct type t = - | Pt_constructor of string - | Pt_variant of string + | Pt_constructor of {name : string ; cstrs : int * int} + | Pt_variant of {name : string } | Pt_module_alias | Pt_na @@ -79651,7 +79654,7 @@ let false_ : t = Lconst (Const_js_false) let unit : t = - Lconst (Const_pointer( 0, Pt_constructor "()")) + Lconst (Const_pointer( 0, Pt_constructor {name = "()"; cstrs = 1,0})) @@ -85455,8 +85458,8 @@ let comment_of_tag_info (x : Lam_tag_info.t) = | Blk_na s -> if s = "" then None else Some s let comment_of_pointer_info (x : Lam_pointer_info.t)= match x with - | Pt_constructor x -> Some x - | Pt_variant x -> Some x + | Pt_constructor {name} + | Pt_variant {name} -> Some name | Pt_module_alias -> None (* FIXME *) | Pt_na -> None @@ -94979,7 +94982,7 @@ and transl_exp0 e = | Longident.Lident "None" when Datarepr.constructor_has_optional_shape cstr -> Pt_shape_none - | _ -> (Lambda.Pt_constructor cstr.cstr_name) + | _ -> (Lambda.Pt_constructor {name = cstr.cstr_name; cstrs = cstr.cstr_consts,cstr.cstr_nonconsts}) )) | Cstr_unboxed -> (match ll with [v] -> v | _ -> assert false) @@ -95013,7 +95016,7 @@ and transl_exp0 e = | Texp_variant(l, arg) -> let tag = Btype.hash_variant l in begin match arg with - None -> Lconst(Const_pointer (tag, Lambda.Pt_variant l)) + None -> Lconst(Const_pointer (tag, Pt_variant {name = l})) | Some arg -> let lam = transl_exp arg in let tag_info = Lambda.Blk_variant l in @@ -95996,7 +95999,7 @@ let rec build_class_init cla cstr super inh_init cl_init msubst top cl = (inh_init, Llet (Strict, Pgenval, inh, mkappl(oo_prim "inherits", narrow_args @ - [lpath; Lconst(Const_pointer((if top then 1 else 0),Lambda.Pt_na))]), + [lpath; Lconst(Const_pointer((if top then 1 else 0),Pt_builtin_boolean))]), Llet(StrictOpt, Pgenval, obj_init, lfield inh 0, cl_init))) | _ -> let core cl_init = @@ -96826,7 +96829,7 @@ let undefined_location loc = [Const_base(Const_string (fname, None)); Const_base(Const_int line); Const_base(Const_int char)])) - +let cstrs = (3,2) let init_shape modl = let add_name x id = if !Clflags.bs_only then @@ -96839,7 +96842,7 @@ let init_shape modl = Mty_ident _ -> raise Not_found | Mty_alias _ -> - Const_block (1, value_tag_info, [Const_pointer (0, Lambda.Pt_module_alias)]) + Const_block (1, value_tag_info, [Const_pointer (0, Pt_module_alias)]) | Mty_signature sg -> Const_block(0, module_tag_info, [Const_block(0, Blk_array, init_shape_struct env sg)]) | Mty_functor _ -> @@ -96851,9 +96854,9 @@ let init_shape modl = let init_v = match Ctype.expand_head env ty with {desc = Tarrow(_,_,_,_)} -> - Const_pointer (0, Lambda.default_pointer_info) (* camlinternalMod.Function *) + Const_pointer (0, Pt_constructor{name = "Function"; cstrs}) | {desc = Tconstr(p, _, _)} when Path.same p Predef.path_lazy_t -> - Const_pointer (1, Lambda.default_pointer_info) (* camlinternalMod.Lazy *) + Const_pointer (1, Pt_constructor{name = "Lazy"; cstrs}) | _ -> raise Not_found in (add_name init_v id) :: init_shape_struct env rem | Sig_value(_, {val_kind=Val_prim _}) :: rem -> @@ -96871,7 +96874,7 @@ let init_shape modl = | Sig_modtype(id, minfo) :: rem -> init_shape_struct (Env.add_modtype id minfo env) rem | Sig_class (id,_,_) :: rem -> - (add_name (Const_pointer (2, Lambda.default_pointer_info)) id) (* camlinternalMod.Class *) + (add_name (Const_pointer (2, Pt_constructor{name = "Class";cstrs})) id) :: init_shape_struct env rem | Sig_class_type _ :: rem -> init_shape_struct env rem @@ -123454,8 +123457,8 @@ let rec convert_constant ( const : Lambda.structured_constant) : Lam_constant.t | Const_base (Const_nativeint i) -> (Const_nativeint i) | Const_pointer(i,p) -> begin match p with - | Pt_constructor p -> Const_pointer(i, Pt_constructor p) - | Pt_variant p -> Const_pointer(i,Pt_variant p) + | Pt_constructor {name;cstrs} -> Const_pointer(i, Pt_constructor {name; cstrs}) + | Pt_variant {name} -> Const_pointer(i,Pt_variant {name}) | Pt_module_alias -> Const_pointer(i, Pt_module_alias) | Pt_builtin_boolean -> if i = 0 then Const_js_false else Const_js_true | Pt_shape_none -> diff --git a/ocaml b/ocaml index a6a8c754b8..e18633036e 160000 --- a/ocaml +++ b/ocaml @@ -1 +1 @@ -Subproject commit a6a8c754b8810f48546393e7c7df57851a0559c5 +Subproject commit e18633036ee4a69b1b71b5118899ec13b2f6396c