Skip to content
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

Unboxed records #3229

Merged
merged 19 commits into from
Dec 5, 2024
Merged

Unboxed records #3229

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
19 commits
Select commit Hold shift + click to select a range
c1241b3
Basic unboxed records (rebased)
rtjoa Oct 24, 2024
bbff92b
Respond to ccasin's 2024-11-27 PR comments
rtjoa Nov 27, 2024
4e451d5
Unique tests for anfelor's 2024-11-27 review
rtjoa Dec 1, 2024
b0169c4
Add failing uniqueness test with CR
rtjoa Dec 2, 2024
7b98a69
Revert changes to flambda_parser.new-messages
rtjoa Dec 2, 2024
488153b
Easy changes needed for ccasin's 2024-12-02 review
rtjoa Dec 3, 2024
d96cded
Always evaluate initial expression for functional update
rtjoa Dec 3, 2024
98bfb55
Fix reachable assert in pats_of_type
rtjoa Dec 3, 2024
a75d1fe
Resolve rebase conflicts (old base aded4b5150, old tip 47d58d8158)
rtjoa Dec 3, 2024
6519e06
Track record sort in Texp_unboxed_field
rtjoa Dec 3, 2024
1351e55
Track initial record sort in Texp_unboxed_record
rtjoa Dec 3, 2024
ba2f5bf
Add comment about dummy unboxed record jkinds
rtjoa Dec 3, 2024
b6540b8
Fix shape_map for unboxed labels
rtjoa Dec 3, 2024
544f838
Give unboxed records Algebraic separability
rtjoa Dec 3, 2024
fa009c1
Added unboxed records shapes tests
rtjoa Dec 4, 2024
35c1fcc
Minor changes for ccasin's 2024-12-04 review
rtjoa Dec 5, 2024
7ed17a0
Compute record proj/construction sorts from expression
rtjoa Dec 5, 2024
aa57c71
Reformat unboxed records changes to fit in 80char
rtjoa Dec 5, 2024
c0382c6
Compute correct sort for a functional update's initial record
rtjoa Dec 5, 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
6 changes: 6 additions & 0 deletions chamelon/minimizer/flatteningmodules.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -102,6 +102,12 @@ let rec replace_in_pat : type k. _ -> k general_pattern -> k general_pattern =
(fun (e1, e2, pat) -> (e1, e2, replace_in_pat mod_name pat))
r,
a1 )
| O (Tpat_record_unboxed_product (r, a1)) ->
Tpat_record_unboxed_product
( List.map
(fun (e1, e2, pat) -> (e1, e2, replace_in_pat mod_name pat))
r,
a1 )
| O (Tpat_or (p1, p2, a1)) ->
Tpat_or (replace_in_pat mod_name p1, replace_in_pat mod_name p2, a1)
| O (Tpat_lazy pat) -> Tpat_lazy (replace_in_pat mod_name pat)
Expand Down
13 changes: 13 additions & 0 deletions chamelon/minimizer/removedeadcode.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,8 @@ let rec var_from_pat pat_desc acc =
(List.map (fun (_, pat, _) -> pat) fields)
| O (Tpat_record (r, _)) ->
List.fold_left (fun l (_, _, pat) -> var_from_pat pat.pat_desc l) acc r
| O (Tpat_record_unboxed_product (r, _)) ->
List.fold_left (fun l (_, _, pat) -> var_from_pat pat.pat_desc l) acc r
| O (Tpat_or (p1, p2, _)) ->
var_from_pat p1.pat_desc (var_from_pat p2.pat_desc acc)
| O (Tpat_lazy pat) -> var_from_pat pat.pat_desc acc
Expand Down Expand Up @@ -150,6 +152,17 @@ let rec rem_in_pat str pat should_remove =
r,
a1 );
}
| O (Tpat_record_unboxed_product (r, a1)) ->
{
pat with
pat_desc =
Tpat_record_unboxed_product
( List.map
(fun (e1, e2, pat) ->
(e1, e2, rem_in_pat str pat should_remove))
r,
a1 );
}
| O (Tpat_or (p1, p2, a1)) ->
let p1 = rem_in_pat str p1 should_remove in
let p2 = rem_in_pat str p2 should_remove in
Expand Down
43 changes: 43 additions & 0 deletions chamelon/minimizer/simplifytypes.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,27 @@ let remove_cons_mapper (cons_to_rem, cons_typ) =
};
}
:: l
| Tpat_record_unboxed_product (lab_list, flag)
->
let nlab_list =
List.filter
(fun (_, ld, _) ->
ld.lbl_name = cons_to_rem)
lab_list
in
if nlab_list = [] then l
else
{
val_case with
c_lhs =
{
val_case.c_lhs with
pat_desc =
Tpat_record_unboxed_product
(nlab_list, flag);
};
}
:: l
| _ ->
Tast_mapper.default.case mapper val_case
:: l)
Expand Down Expand Up @@ -127,6 +148,28 @@ let remove_cons_mapper (cons_to_rem, cons_typ) =
};
}
:: l
| Tpat_record_unboxed_product (lab_list, flag)
->
let nlab_list =
List.filter
(fun (_, ld, _) ->
ld.lbl_name = cons_to_rem)
lab_list
in
if nlab_list = [] then l
else
{
comp_case with
c_lhs =
as_computation_pattern
{
comp_case.c_lhs with
pat_desc =
Tpat_record_unboxed_product
(nlab_list, flag);
};
}
:: l
| _ ->
Tast_mapper.default.case mapper comp_case
:: l)
Expand Down
70 changes: 40 additions & 30 deletions file_formats/cmt_format.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -167,9 +167,38 @@ let iter_on_occurrences
let path = path_in_type cstr_res cstr_name in
Option.iter (fun path -> f ~namespace:Constructor env path lid) path
in
let add_label env lid { Types.lbl_name; lbl_res; _ } =
let add_label ~namespace env lid { Types.lbl_name; lbl_res; _ } =
let path = path_in_type lbl_res lbl_name in
Option.iter (fun path -> f ~namespace:Label env path lid) path
Option.iter (fun path -> f ~namespace env path lid) path
in
let iter_field_exps ~namespace exp_env fields =
Array.iter (fun (label_descr, record_label_definition) ->
match record_label_definition with
| Overridden ({ Location.txt; loc}, {exp_loc; _})
when not exp_loc.loc_ghost
&& loc.loc_start = exp_loc.loc_start
&& loc.loc_end = exp_loc.loc_end ->
(* In the presence of punning we want to index the label
even if it is ghosted *)
let lid = { Location.txt; loc = {loc with loc_ghost = false} } in
add_label ~namespace exp_env lid label_descr
| Overridden (lid, _) -> add_label ~namespace exp_env lid label_descr
| Kept _ -> ()) fields
in
let iter_field_pats ~namespace pat_env fields =
List.iter (fun (lid, label_descr, pat) ->
let lid =
let open Location in
(* In the presence of punning we want to index the label
even if it is ghosted *)
if (not pat.pat_loc.loc_ghost
&& lid.loc.loc_start = pat.pat_loc.loc_start
&& lid.loc.loc_end = pat.pat_loc.loc_end)
then {lid with loc = {lid.loc with loc_ghost = false}}
else lid
in
add_label ~namespace pat_env lid label_descr)
fields
in
let with_constraint ~env (_path, _lid, with_constraint) =
match with_constraint with
Expand All @@ -187,24 +216,15 @@ let iter_on_occurrences
add_constructor_description exp_env lid constr_desc
| Texp_field (_, lid, label_desc, _, _)
| Texp_setfield (_, _, lid, label_desc, _) ->
add_label exp_env lid label_desc
add_label ~namespace:Label exp_env lid label_desc
| Texp_unboxed_field (_, _, lid, label_desc, _) ->
add_label ~namespace:Unboxed_label exp_env lid label_desc
| Texp_new (path, lid, _, _) ->
f ~namespace:Class exp_env path lid
| Texp_record { fields; _ } ->
Array.iter (fun (label_descr, record_label_definition) ->
match record_label_definition with
| Overridden (
{ Location.txt; loc},
{exp_loc; _})
when not exp_loc.loc_ghost
&& loc.loc_start = exp_loc.loc_start
&& loc.loc_end = exp_loc.loc_end ->
(* In the presence of punning we want to index the label
even if it is ghosted *)
let lid = { Location.txt; loc = {loc with loc_ghost = false} } in
add_label exp_env lid label_descr
| Overridden (lid, _) -> add_label exp_env lid label_descr
| Kept _ -> ()) fields
iter_field_exps ~namespace:Label exp_env fields
| Texp_record_unboxed_product { fields ; _ } ->
iter_field_exps ~namespace:Unboxed_label exp_env fields
| Texp_instvar (_self_path, path, name) ->
let lid = { name with txt = Longident.Lident name.txt } in
f ~namespace:Value exp_env path lid
Expand Down Expand Up @@ -257,19 +277,9 @@ let iter_on_occurrences
| Tpat_construct (lid, constr_desc, _, _) ->
add_constructor_description pat_env lid constr_desc
| Tpat_record (fields, _) ->
List.iter (fun (lid, label_descr, pat) ->
let lid =
let open Location in
(* In the presence of punning we want to index the label
even if it is ghosted *)
if (not pat.pat_loc.loc_ghost
&& lid.loc.loc_start = pat.pat_loc.loc_start
&& lid.loc.loc_end = pat.pat_loc.loc_end)
then {lid with loc = {lid.loc with loc_ghost = false}}
else lid
in
add_label pat_env lid label_descr)
fields
iter_field_pats ~namespace:Label pat_env fields
| Tpat_record_unboxed_product (fields, _) ->
iter_field_pats ~namespace:Unboxed_label pat_env fields
| Tpat_any | Tpat_var _ | Tpat_alias _ | Tpat_constant _ | Tpat_tuple _
| Tpat_unboxed_tuple _
| Tpat_variant _ | Tpat_array _ | Tpat_lazy _ | Tpat_value _
Expand Down
Loading
Loading