Skip to content

Fix renamed field access in inline records #6551

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 4 commits into from
Jan 18, 2024
Merged

Fix renamed field access in inline records #6551

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
9d48e82
add remaining part of melange-re/melange#732
tsnobip Jan 6, 2024
518c35c
call the right fld_record_ functions
tsnobip Jan 15, 2024
15bf8c8
update changelog
tsnobip Jan 15, 2024
6112b5b
use direct bindings instead of refs
tsnobip Jan 17, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
4 changes: 0 additions & 4 deletions jscomp/core/bs_conditional_initial.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,10 +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.blk_record := Record_attributes_check.blk_record;
Lambda.blk_record_inlined := Record_attributes_check.blk_record_inlined;
Matching.names_from_construct_pattern :=
Matching_polyfill.names_from_construct_pattern;

Expand Down
30 changes: 1 addition & 29 deletions jscomp/core/record_attributes_check.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
=
Expand All @@ -40,34 +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 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_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
Expand Down
81 changes: 64 additions & 17 deletions jscomp/ml/lambda.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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}
Expand All @@ -117,9 +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 (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 (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}
Expand All @@ -131,8 +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 (lbl : label) =
Fld_record_inline_set
(Ext_list.find_def lbl.lbl_attributes find_name 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
Expand Down
68 changes: 42 additions & 26 deletions jscomp/ml/lambda.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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




Expand All @@ -110,8 +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

val fld_record_extension :
Types.label_description ->
field_dbg_info

val ref_field_info : field_dbg_info

Expand All @@ -125,8 +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

val fld_record_extension_set :
Types.label_description ->
set_field_dbg_info

type immediate_or_pointer =
| Immediate
Expand Down
20 changes: 3 additions & 17 deletions jscomp/ml/matching.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)
(*
Expand Down Expand Up @@ -1612,12 +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 _ ->
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
Expand Down
3 changes: 0 additions & 3 deletions jscomp/ml/matching.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down
Loading