From 9d48e820666d8e81d4aaafcb4746f36b96dca680 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Tsnobiladz=C3=A9?= Date: Sat, 6 Jan 2024 19:30:25 +0100 Subject: [PATCH 1/4] add remaining part of melange-re/melange#732 --- jscomp/core/bs_conditional_initial.ml | 5 +++++ jscomp/core/record_attributes_check.ml | 25 +++++++++++++++++++++++++ jscomp/ml/lambda.ml | 12 ++++++++++++ jscomp/ml/lambda.mli | 16 ++++++++++++++++ jscomp/test/as_inline_record_test.js | 10 ++++++++++ jscomp/test/as_inline_record_test.res | 10 ++++++++++ 6 files changed, 78 insertions(+) diff --git a/jscomp/core/bs_conditional_initial.ml b/jscomp/core/bs_conditional_initial.ml index 70e5a10e4a..a434632b02 100644 --- a/jscomp/core/bs_conditional_initial.ml +++ b/jscomp/core/bs_conditional_initial.ml @@ -46,8 +46,13 @@ let setup_env () = Record_attributes_check.check_duplicated_labels; Lambda.fld_record := Record_attributes_check.fld_record; Lambda.fld_record_set := Record_attributes_check.fld_record_set; + Lambda.fld_record_inline := Record_attributes_check.fld_record_inline; + Lambda.fld_record_inline_set := Record_attributes_check.fld_record_inline_set; + Lambda.fld_record_extension := Record_attributes_check.fld_record_extension; + Lambda.fld_record_extension_set := Record_attributes_check.fld_record_extension_set; Lambda.blk_record := Record_attributes_check.blk_record; Lambda.blk_record_inlined := Record_attributes_check.blk_record_inlined; + Lambda.blk_record_ext := Record_attributes_check.blk_record_ext; Matching.names_from_construct_pattern := Matching_polyfill.names_from_construct_pattern; diff --git a/jscomp/core/record_attributes_check.ml b/jscomp/core/record_attributes_check.ml index 60865b275b..59ffb105d1 100644 --- a/jscomp/core/record_attributes_check.ml +++ b/jscomp/core/record_attributes_check.ml @@ -51,6 +51,22 @@ let fld_record_set (lbl : label) = Lambda.Fld_record_set (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) +let fld_record_inline (lbl : label) = + Lambda.Fld_record_inline + { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name } + +let fld_record_inline_set (lbl : label) = + Lambda.Fld_record_inline_set + (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) + +let fld_record_extension (lbl : label) = + Lambda.Fld_record_extension + { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name } + +let fld_record_extension_set (lbl : label) = + Lambda.Fld_record_extension_set + (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) + let blk_record (fields : (label * _) array) mut record_repr = let all_labels_info = Ext_array.map fields (fun (lbl, _) -> @@ -59,6 +75,15 @@ let blk_record (fields : (label * _) array) mut record_repr = Lambda.Blk_record { fields = all_labels_info; mutable_flag = mut; record_repr } +let blk_record_ext fields mutable_flag = + let all_labels_info = + Array.map + (fun ((lbl : label), _) -> + Ext_list.find_def lbl.Types.lbl_attributes find_name lbl.lbl_name) + fields + in + Lambda.Blk_record_ext {fields = all_labels_info; mutable_flag } + let blk_record_inlined fields name num_nonconst optional_labels ~tag ~attrs mutable_flag = let fields = Array.map diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 037502950e..712a5a7c79 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -121,6 +121,12 @@ type field_dbg_info = let fld_record = ref (fun (lbl : Types.label_description) -> Fld_record {name = lbl.lbl_name; mutable_flag = Mutable}) +let fld_record_inline = ref (fun (lbl : Types.label_description) -> + Fld_record_inline {name = lbl.lbl_name}) + +let fld_record_extension = ref (fun (lbl : Types.label_description) -> + Fld_record_extension {name = lbl.lbl_name}) + let ref_field_info : field_dbg_info = Fld_record { name = "contents"; mutable_flag = Mutable} @@ -134,6 +140,12 @@ let ref_field_set_info : set_field_dbg_info = Fld_record_set "contents" let fld_record_set = ref ( fun (lbl : Types.label_description) -> Fld_record_set lbl.lbl_name ) +let fld_record_inline_set = ref ( fun (lbl : Types.label_description) -> + Fld_record_inline_set lbl.lbl_name ) + +let fld_record_extension_set = ref ( fun (lbl : Types.label_description) -> + Fld_record_extension_set lbl.lbl_name ) + type immediate_or_pointer = | Immediate | Pointer diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index af7b81e807..2402995b1a 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -113,6 +113,14 @@ val fld_record : (Types.label_description -> field_dbg_info) ref +val fld_record_inline : + (Types.label_description -> + field_dbg_info) ref + +val fld_record_extension : + (Types.label_description -> + field_dbg_info) ref + val ref_field_info : field_dbg_info @@ -128,6 +136,14 @@ val fld_record_set : (Types.label_description -> set_field_dbg_info) ref +val fld_record_inline_set : + (Types.label_description -> + set_field_dbg_info) ref + +val fld_record_extension_set : + (Types.label_description -> + set_field_dbg_info) ref + type immediate_or_pointer = | Immediate | Pointer diff --git a/jscomp/test/as_inline_record_test.js b/jscomp/test/as_inline_record_test.js index c0de1fbe9d..88d461a3a3 100644 --- a/jscomp/test/as_inline_record_test.js +++ b/jscomp/test/as_inline_record_test.js @@ -6,10 +6,18 @@ function getName(t) { return t.renamed; } +function getName$p(t) { + return t.name; +} + function getAge(t) { return t.age; } +function getAge$p(t) { + return t.age; +} + var user = { TAG: "User", renamed: "Corentin", @@ -18,5 +26,7 @@ var user = { exports.user = user; exports.getName = getName; +exports.getName$p = getName$p; exports.getAge = getAge; +exports.getAge$p = getAge$p; /* No side effect */ diff --git a/jscomp/test/as_inline_record_test.res b/jscomp/test/as_inline_record_test.res index 1e9e751f2c..c5cb51648a 100644 --- a/jscomp/test/as_inline_record_test.res +++ b/jscomp/test/as_inline_record_test.res @@ -12,7 +12,17 @@ let getName = t => | User({name}) => name } +let getName' = t => + switch t { + | User(u) => u.name + } + let getAge = t => switch t { | User({age}) => age } + +let getAge' = t => + switch t { + | User(u) => u.age + } \ No newline at end of file From 518c35c7635982f66bc52027d0ad0ca45fceac88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Tsnobiladz=C3=A9?= Date: Mon, 15 Jan 2024 10:34:42 +0100 Subject: [PATCH 2/4] call the right fld_record_ functions --- jscomp/ml/matching.ml | 5 ++--- jscomp/ml/translcore.ml | 16 ++++++++-------- jscomp/test/as_inline_record_test.js | 2 +- 3 files changed, 11 insertions(+), 12 deletions(-) diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index d79b00f0c4..84413019e1 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -1614,10 +1614,9 @@ let make_record_matching loc all_labels def = function | Record_regular | Record_optional_labels _ -> Lprim (Pfield (lbl.lbl_pos, !Lambda.fld_record lbl), [arg], loc) | Record_inlined _ -> - let name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name in - Lprim (Pfield (lbl.lbl_pos, Fld_record_inline {name}), [arg], loc) + Lprim (Pfield (lbl.lbl_pos, !Lambda.fld_record_inline lbl), [arg], loc) | Record_unboxed _ -> arg - | Record_extension -> Lprim (Pfield (lbl.lbl_pos + 1, Fld_record_extension {name = lbl.lbl_name}), [arg], loc) + | Record_extension -> Lprim (Pfield (lbl.lbl_pos + 1, !Lambda.fld_record_extension lbl), [arg], loc) in let str = match lbl.lbl_mut with diff --git a/jscomp/ml/translcore.ml b/jscomp/ml/translcore.ml index b4e4d1d92c..a90fe35cf2 100644 --- a/jscomp/ml/translcore.ml +++ b/jscomp/ml/translcore.ml @@ -889,14 +889,14 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = (Pfield (lbl.lbl_pos, !Lambda.fld_record lbl), [ targ ], e.exp_loc) | Record_inlined _ -> Lprim - ( Pfield (lbl.lbl_pos, Fld_record_inline { name = lbl.lbl_name }), + ( Pfield (lbl.lbl_pos, !Lambda.fld_record_inline lbl), [ targ ], e.exp_loc ) | Record_unboxed _ -> targ | Record_extension -> Lprim ( Pfield - (lbl.lbl_pos + 1, Fld_record_extension { name = lbl.lbl_name }), + (lbl.lbl_pos + 1, !Lambda.fld_record_extension lbl), [ targ ], e.exp_loc )) | Texp_setfield (arg, _, lbl, newval) -> @@ -906,10 +906,10 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = | Record_regular | Record_optional_labels _ -> Psetfield (lbl.lbl_pos, !Lambda.fld_record_set lbl) | Record_inlined _ -> - Psetfield (lbl.lbl_pos, Fld_record_inline_set lbl.lbl_name) + Psetfield (lbl.lbl_pos, !Lambda.fld_record_inline_set lbl) | Record_unboxed _ -> assert false | Record_extension -> - Psetfield (lbl.lbl_pos + 1, Fld_record_extension_set lbl.lbl_name) + Psetfield (lbl.lbl_pos + 1, !Lambda.fld_record_extension_set lbl) in Lprim (access, [ transl_exp arg; transl_exp newval ], e.exp_loc) | Texp_array expr_list -> @@ -1169,11 +1169,11 @@ and transl_record loc env fields repres opt_init_expr = | Record_regular | Record_optional_labels _ -> Pfield (i, !Lambda.fld_record lbl) | Record_inlined _ -> - Pfield (i, Fld_record_inline { name = lbl.lbl_name }) + Pfield (i, !Lambda.fld_record_inline lbl) | Record_unboxed _ -> assert false | Record_extension -> Pfield - (i + 1, Fld_record_extension { name = lbl.lbl_name }) + (i + 1, !Lambda.fld_record_extension lbl) in Lprim (access, [ Lvar init_id ], loc) | Overridden (_lid, expr) -> transl_exp expr) @@ -1259,11 +1259,11 @@ and transl_record loc env fields repres opt_init_expr = | Record_regular | Record_optional_labels _ -> Psetfield (lbl.lbl_pos, !Lambda.fld_record_set lbl) | Record_inlined _ -> - Psetfield (lbl.lbl_pos, Fld_record_inline_set lbl.lbl_name) + Psetfield (lbl.lbl_pos, !Lambda.fld_record_inline_set lbl) | Record_unboxed _ -> assert false | Record_extension -> Psetfield - (lbl.lbl_pos + 1, Fld_record_extension_set lbl.lbl_name) + (lbl.lbl_pos + 1, !Lambda.fld_record_extension_set lbl) in Lsequence (Lprim (upd, [ Lvar copy_id; transl_exp expr ], loc), cont) diff --git a/jscomp/test/as_inline_record_test.js b/jscomp/test/as_inline_record_test.js index 88d461a3a3..9518636755 100644 --- a/jscomp/test/as_inline_record_test.js +++ b/jscomp/test/as_inline_record_test.js @@ -7,7 +7,7 @@ function getName(t) { } function getName$p(t) { - return t.name; + return t.renamed; } function getAge(t) { From 15bf8c8a1bd93a8a669063b2add4eb23aa778989 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Tsnobiladz=C3=A9?= Date: Mon, 15 Jan 2024 10:59:56 +0100 Subject: [PATCH 3/4] update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b49a845ba3..35a9e57525 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ #### :bug: Bug Fix +- Renamed inline record fields : fix renamed field access in inline records https://github.com/rescript-lang/rescript-compiler/pull/6551 - Fixed issue with coercions sometimes raising a `Not_found` instead of giving a proper error message. https://github.com/rescript-lang/rescript-compiler/pull/6574 - Fix issue with recursive modules and uncurried. https://github.com/rescript-lang/rescript-compiler/pull/6575 From 6112b5bc376a381aeb160bad5df15c5d22a370c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Tsnobiladz=C3=A9?= Date: Wed, 17 Jan 2024 21:56:21 +0100 Subject: [PATCH 4/4] use direct bindings instead of refs --- jscomp/core/bs_conditional_initial.ml | 9 --- jscomp/core/record_attributes_check.ml | 55 +---------------- jscomp/ml/lambda.ml | 85 ++++++++++++++++++-------- jscomp/ml/lambda.mli | 68 ++++++++++----------- jscomp/ml/matching.ml | 19 +----- jscomp/ml/matching.mli | 3 - jscomp/ml/translcore.ml | 38 ++++++------ 7 files changed, 117 insertions(+), 160 deletions(-) diff --git a/jscomp/core/bs_conditional_initial.ml b/jscomp/core/bs_conditional_initial.ml index a434632b02..52010a4bb4 100644 --- a/jscomp/core/bs_conditional_initial.ml +++ b/jscomp/core/bs_conditional_initial.ml @@ -44,15 +44,6 @@ let setup_env () = Builtin_attributes.check_bs_attributes_inclusion := Record_attributes_check.check_bs_attributes_inclusion; Builtin_attributes.check_duplicated_labels := Record_attributes_check.check_duplicated_labels; - Lambda.fld_record := Record_attributes_check.fld_record; - Lambda.fld_record_set := Record_attributes_check.fld_record_set; - Lambda.fld_record_inline := Record_attributes_check.fld_record_inline; - Lambda.fld_record_inline_set := Record_attributes_check.fld_record_inline_set; - Lambda.fld_record_extension := Record_attributes_check.fld_record_extension; - Lambda.fld_record_extension_set := Record_attributes_check.fld_record_extension_set; - Lambda.blk_record := Record_attributes_check.blk_record; - Lambda.blk_record_inlined := Record_attributes_check.blk_record_inlined; - Lambda.blk_record_ext := Record_attributes_check.blk_record_ext; Matching.names_from_construct_pattern := Matching_polyfill.names_from_construct_pattern; diff --git a/jscomp/core/record_attributes_check.ml b/jscomp/core/record_attributes_check.ml index 59ffb105d1..c4bf854c00 100644 --- a/jscomp/core/record_attributes_check.ml +++ b/jscomp/core/record_attributes_check.ml @@ -24,7 +24,7 @@ type label = Types.label_description -let find_name = Matching.find_name +let find_name = Lambda.find_name let find_name_with_loc (attr : Parsetree.attribute) : string Asttypes.loc option = @@ -40,59 +40,6 @@ let find_name_with_loc (attr : Parsetree.attribute) : string Asttypes.loc option Some { txt = s; loc } | _ -> None -let fld_record (lbl : label) = - Lambda.Fld_record - { - name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name; - mutable_flag = lbl.lbl_mut; - } - -let fld_record_set (lbl : label) = - Lambda.Fld_record_set - (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) - -let fld_record_inline (lbl : label) = - Lambda.Fld_record_inline - { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name } - -let fld_record_inline_set (lbl : label) = - Lambda.Fld_record_inline_set - (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) - -let fld_record_extension (lbl : label) = - Lambda.Fld_record_extension - { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name } - -let fld_record_extension_set (lbl : label) = - Lambda.Fld_record_extension_set - (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) - -let blk_record (fields : (label * _) array) mut record_repr = - let all_labels_info = - Ext_array.map fields (fun (lbl, _) -> - Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) - in - Lambda.Blk_record - { fields = all_labels_info; mutable_flag = mut; record_repr } - -let blk_record_ext fields mutable_flag = - let all_labels_info = - Array.map - (fun ((lbl : label), _) -> - Ext_list.find_def lbl.Types.lbl_attributes find_name lbl.lbl_name) - fields - in - Lambda.Blk_record_ext {fields = all_labels_info; mutable_flag } - -let blk_record_inlined fields name num_nonconst optional_labels ~tag ~attrs mutable_flag = - let fields = - Array.map - (fun ((lbl : label), _) -> - Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) - fields - in - Lambda.Blk_record_inlined {fields; name; num_nonconst; tag; mutable_flag; optional_labels; attrs } - let check_bs_attributes_inclusion (attrs1 : Parsetree.attributes) (attrs2 : Parsetree.attributes) lbl_name = let a = Ext_list.find_def attrs1 find_name lbl_name in diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index 712a5a7c79..337dd10e9e 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -86,21 +86,47 @@ let mutable_flag_of_tag_info (tag : tag_info) = | Blk_some -> Immutable +type label = Types.label_description + +let find_name (attr : Parsetree.attribute) = + match attr with + | ( { txt = "bs.as" | "as" }, + PStr + [ + { + pstr_desc = + Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (s, _)) }, _); + }; + ] ) -> + Some s + | _ -> None + +let blk_record (fields : (label * _) array) mut record_repr = + let all_labels_info = + Ext_array.map fields (fun (lbl, _) -> + Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) + in + Blk_record + { fields = all_labels_info; mutable_flag = mut; record_repr } -let blk_record = ref (fun _ _ _ -> - assert false - ) - - -let blk_record_ext = ref (fun fields mutable_flag -> - let all_labels_info = fields |> Array.map (fun (x,_) -> x.Types.lbl_name) in - Blk_record_ext {fields = all_labels_info; mutable_flag } - ) -let blk_record_inlined = ref (fun fields name num_nonconst optional_labels ~tag ~attrs mutable_flag -> - let fields = fields |> Array.map (fun (x,_) -> x.Types.lbl_name) in +let blk_record_ext fields mutable_flag = + let all_labels_info = + Array.map + (fun ((lbl : label), _) -> + Ext_list.find_def lbl.Types.lbl_attributes find_name lbl.lbl_name) + fields + in + Blk_record_ext {fields = all_labels_info; mutable_flag } + +let blk_record_inlined fields name num_nonconst optional_labels ~tag ~attrs mutable_flag = + let fields = + Array.map + (fun ((lbl : label), _) -> + Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) + fields + in Blk_record_inlined {fields; name; num_nonconst; tag; mutable_flag; optional_labels; attrs } -) let ref_tag_info : tag_info = Blk_record {fields = [| "contents" |]; mutable_flag = Mutable; record_repr = Record_regular} @@ -117,15 +143,17 @@ type field_dbg_info = | Fld_variant | Fld_cons | Fld_array - -let fld_record = ref (fun (lbl : Types.label_description) -> - Fld_record {name = lbl.lbl_name; mutable_flag = Mutable}) -let fld_record_inline = ref (fun (lbl : Types.label_description) -> - Fld_record_inline {name = lbl.lbl_name}) +let fld_record (lbl : label) = + Fld_record + { + name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name; + mutable_flag = lbl.lbl_mut; + } -let fld_record_extension = ref (fun (lbl : Types.label_description) -> - Fld_record_extension {name = lbl.lbl_name}) +let fld_record_extension (lbl : label) = + Fld_record_extension + { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name } let ref_field_info : field_dbg_info = Fld_record { name = "contents"; mutable_flag = Mutable} @@ -137,14 +165,21 @@ type set_field_dbg_info = | Fld_record_extension_set of string let ref_field_set_info : set_field_dbg_info = Fld_record_set "contents" -let fld_record_set = ref ( fun (lbl : Types.label_description) -> - Fld_record_set lbl.lbl_name ) +let fld_record_set (lbl : label) = + Fld_record_set + (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) + +let fld_record_inline (lbl : label) = + Fld_record_inline + { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name } -let fld_record_inline_set = ref ( fun (lbl : Types.label_description) -> - Fld_record_inline_set lbl.lbl_name ) +let fld_record_inline_set (lbl : label) = + Fld_record_inline_set + (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) -let fld_record_extension_set = ref ( fun (lbl : Types.label_description) -> - Fld_record_extension_set lbl.lbl_name ) +let fld_record_extension_set (lbl : label) = + Fld_record_extension_set + (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name) type immediate_or_pointer = | Immediate diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 2402995b1a..3a9b847c9c 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -63,34 +63,34 @@ type tag_info = | Blk_record_ext of {fields : string array; mutable_flag : mutable_flag} | Blk_lazy_general +val find_name : + Parsetree.attribute -> Asttypes.label option + val tag_of_tag_info : tag_info -> int val mutable_flag_of_tag_info : tag_info -> mutable_flag -val blk_record : - ( - (Types.label_description* Typedtree.record_label_definition) array -> - mutable_flag -> - record_repr -> - tag_info - ) ref +val blk_record : + (Types.label_description* Typedtree.record_label_definition) array -> + mutable_flag -> + record_repr -> + tag_info + val blk_record_ext : - ( - (Types.label_description* Typedtree.record_label_definition) array -> - mutable_flag -> - tag_info - ) ref + (Types.label_description* Typedtree.record_label_definition) array -> + mutable_flag -> + tag_info + val blk_record_inlined : - ( - (Types.label_description* Typedtree.record_label_definition) array -> - string -> - int -> - string list -> - tag:int -> - attrs:Parsetree.attributes -> - mutable_flag -> - tag_info - ) ref + (Types.label_description* Typedtree.record_label_definition) array -> + string -> + int -> + string list -> + tag:int -> + attrs:Parsetree.attributes -> + mutable_flag -> + tag_info + @@ -110,16 +110,16 @@ type field_dbg_info = | Fld_array val fld_record : - (Types.label_description -> - field_dbg_info) ref + Types.label_description -> + field_dbg_info val fld_record_inline : - (Types.label_description -> - field_dbg_info) ref + Types.label_description -> + field_dbg_info val fld_record_extension : - (Types.label_description -> - field_dbg_info) ref + Types.label_description -> + field_dbg_info val ref_field_info : field_dbg_info @@ -133,16 +133,16 @@ type set_field_dbg_info = val ref_field_set_info : set_field_dbg_info val fld_record_set : - (Types.label_description -> - set_field_dbg_info) ref + Types.label_description -> + set_field_dbg_info val fld_record_inline_set : - (Types.label_description -> - set_field_dbg_info) ref + Types.label_description -> + set_field_dbg_info val fld_record_extension_set : - (Types.label_description -> - set_field_dbg_info) ref + Types.label_description -> + set_field_dbg_info type immediate_or_pointer = | Immediate diff --git a/jscomp/ml/matching.ml b/jscomp/ml/matching.ml index 84413019e1..30fa8efb72 100644 --- a/jscomp/ml/matching.ml +++ b/jscomp/ml/matching.ml @@ -26,19 +26,6 @@ open Printf let dbg = false -let find_name (attr : Parsetree.attribute) = - match attr with - | ( { txt = "bs.as" | "as" }, - PStr - [ - { - pstr_desc = - Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (s, _)) }, _); - }; - ] ) -> - Some s - | _ -> None - (* See Peyton-Jones, ``The Implementation of functional programming languages'', chapter 5. *) (* @@ -1612,11 +1599,11 @@ let make_record_matching loc all_labels def = function match lbl.lbl_repres with | Record_float_unused -> assert false | Record_regular | Record_optional_labels _ -> - Lprim (Pfield (lbl.lbl_pos, !Lambda.fld_record lbl), [arg], loc) + Lprim (Pfield (lbl.lbl_pos, Lambda.fld_record lbl), [arg], loc) | Record_inlined _ -> - Lprim (Pfield (lbl.lbl_pos, !Lambda.fld_record_inline lbl), [arg], loc) + Lprim (Pfield (lbl.lbl_pos, Lambda.fld_record_inline lbl), [arg], loc) | Record_unboxed _ -> arg - | Record_extension -> Lprim (Pfield (lbl.lbl_pos + 1, !Lambda.fld_record_extension lbl), [arg], loc) + | Record_extension -> Lprim (Pfield (lbl.lbl_pos + 1, Lambda.fld_record_extension lbl), [arg], loc) in let str = match lbl.lbl_mut with diff --git a/jscomp/ml/matching.mli b/jscomp/ml/matching.mli index c26f3b7838..16fda89bf5 100644 --- a/jscomp/ml/matching.mli +++ b/jscomp/ml/matching.mli @@ -18,9 +18,6 @@ open Typedtree open Lambda -val find_name : - Parsetree.attribute -> Asttypes.label option - val call_switcher_variant_constant : (Location.t -> Lambda.lambda option -> diff --git a/jscomp/ml/translcore.ml b/jscomp/ml/translcore.ml index a90fe35cf2..7033cd5405 100644 --- a/jscomp/ml/translcore.ml +++ b/jscomp/ml/translcore.ml @@ -886,17 +886,17 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = | Record_float_unused -> assert false | Record_regular | Record_optional_labels _ -> Lprim - (Pfield (lbl.lbl_pos, !Lambda.fld_record lbl), [ targ ], e.exp_loc) + (Pfield (lbl.lbl_pos, Lambda.fld_record lbl), [ targ ], e.exp_loc) | Record_inlined _ -> Lprim - ( Pfield (lbl.lbl_pos, !Lambda.fld_record_inline lbl), + ( Pfield (lbl.lbl_pos, Lambda.fld_record_inline lbl), [ targ ], e.exp_loc ) | Record_unboxed _ -> targ | Record_extension -> Lprim ( Pfield - (lbl.lbl_pos + 1, !Lambda.fld_record_extension lbl), + (lbl.lbl_pos + 1, Lambda.fld_record_extension lbl), [ targ ], e.exp_loc )) | Texp_setfield (arg, _, lbl, newval) -> @@ -904,12 +904,12 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda = match lbl.lbl_repres with | Record_float_unused -> assert false | Record_regular | Record_optional_labels _ -> - Psetfield (lbl.lbl_pos, !Lambda.fld_record_set lbl) + Psetfield (lbl.lbl_pos, Lambda.fld_record_set lbl) | Record_inlined _ -> - Psetfield (lbl.lbl_pos, !Lambda.fld_record_inline_set lbl) + Psetfield (lbl.lbl_pos, Lambda.fld_record_inline_set lbl) | Record_unboxed _ -> assert false | Record_extension -> - Psetfield (lbl.lbl_pos + 1, !Lambda.fld_record_extension_set lbl) + Psetfield (lbl.lbl_pos + 1, Lambda.fld_record_extension_set lbl) in Lprim (access, [ transl_exp arg; transl_exp newval ], e.exp_loc) | Texp_array expr_list -> @@ -1167,13 +1167,13 @@ and transl_record loc env fields repres opt_init_expr = match repres with | Record_float_unused -> assert false | Record_regular | Record_optional_labels _ -> - Pfield (i, !Lambda.fld_record lbl) + Pfield (i, Lambda.fld_record lbl) | Record_inlined _ -> - Pfield (i, !Lambda.fld_record_inline lbl) + Pfield (i, Lambda.fld_record_inline lbl) | Record_unboxed _ -> assert false | Record_extension -> Pfield - (i + 1, !Lambda.fld_record_extension lbl) + (i + 1, Lambda.fld_record_extension lbl) in Lprim (access, [ Lvar init_id ], loc) | Overridden (_lid, expr) -> transl_exp expr) @@ -1193,14 +1193,14 @@ and transl_record loc env fields repres opt_init_expr = | Record_float_unused -> assert false | Record_regular -> Lconst - (Const_block (!Lambda.blk_record fields mut Record_regular, cl)) + (Const_block (Lambda.blk_record fields mut Record_regular, cl)) | Record_optional_labels _ -> Lconst - (Const_block (!Lambda.blk_record fields mut Record_optional, cl)) + (Const_block (Lambda.blk_record fields mut Record_optional, cl)) | Record_inlined { tag; name; num_nonconsts; optional_labels; attrs } -> Lconst (Const_block - ( !Lambda.blk_record_inlined fields name num_nonconsts optional_labels ~tag ~attrs + ( Lambda.blk_record_inlined fields name num_nonconsts optional_labels ~tag ~attrs mut, cl )) | Record_unboxed _ -> @@ -1210,19 +1210,19 @@ and transl_record loc env fields repres opt_init_expr = match repres with | Record_regular -> Lprim - ( Pmakeblock (!Lambda.blk_record fields mut Record_regular), + ( Pmakeblock (Lambda.blk_record fields mut Record_regular), ll, loc ) | Record_optional_labels _ -> Lprim - ( Pmakeblock (!Lambda.blk_record fields mut Record_optional), + ( Pmakeblock (Lambda.blk_record fields mut Record_optional), ll, loc ) | Record_float_unused -> assert false | Record_inlined { tag; name; num_nonconsts; optional_labels; attrs } -> Lprim ( Pmakeblock - (!Lambda.blk_record_inlined fields name num_nonconsts optional_labels ~tag ~attrs + (Lambda.blk_record_inlined fields name num_nonconsts optional_labels ~tag ~attrs mut), ll, loc ) @@ -1237,7 +1237,7 @@ and transl_record loc env fields repres opt_init_expr = in let slot = transl_extension_path env path in Lprim - ( Pmakeblock (!Lambda.blk_record_ext fields mut), + ( Pmakeblock (Lambda.blk_record_ext fields mut), slot :: ll, loc )) in @@ -1257,13 +1257,13 @@ and transl_record loc env fields repres opt_init_expr = match repres with | Record_float_unused -> assert false | Record_regular | Record_optional_labels _ -> - Psetfield (lbl.lbl_pos, !Lambda.fld_record_set lbl) + Psetfield (lbl.lbl_pos, Lambda.fld_record_set lbl) | Record_inlined _ -> - Psetfield (lbl.lbl_pos, !Lambda.fld_record_inline_set lbl) + Psetfield (lbl.lbl_pos, Lambda.fld_record_inline_set lbl) | Record_unboxed _ -> assert false | Record_extension -> Psetfield - (lbl.lbl_pos + 1, !Lambda.fld_record_extension_set lbl) + (lbl.lbl_pos + 1, Lambda.fld_record_extension_set lbl) in Lsequence (Lprim (upd, [ Lvar copy_id; transl_exp expr ], loc), cont)