Skip to content

feat: support renaming inline records / extensions with @mel.as #26

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 1 commit into from
Sep 6, 2023
Merged

feat: support renaming inline records / extensions with @mel.as #26

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
10 changes: 10 additions & 0 deletions lambda/lambda.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -79,6 +79,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}

Expand All @@ -93,6 +99,10 @@ type set_field_dbg_info =
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
Expand Down
16 changes: 16 additions & 0 deletions lambda/lambda.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,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

val fld_na : field_dbg_info
Expand All @@ -113,6 +121,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
Expand Down
4 changes: 2 additions & 2 deletions lambda/matching.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2087,10 +2087,10 @@ let get_expr_args_record ~scopes head (arg, _mut) rem =
| Record_regular ->
Lprim (Pfield (lbl.lbl_pos, ptr, lbl.lbl_mut, !Lambda.fld_record lbl), [arg], loc)
| Record_inlined _ ->
Lprim (Pfield (lbl.lbl_pos, ptr, lbl.lbl_mut, Fld_record_inline { name = lbl.lbl_name}), [arg], loc)
Lprim (Pfield (lbl.lbl_pos, ptr, lbl.lbl_mut, !Lambda.fld_record_inline lbl), [arg], loc)
| Record_unboxed _ -> arg
| Record_float -> Lprim (Pfloatfield (lbl.lbl_pos, !Lambda.fld_record lbl), [arg], loc)
| Record_extension _ -> Lprim (Pfield (lbl.lbl_pos + 1, ptr, lbl.lbl_mut, Fld_record_extension { name = lbl.lbl_name }), [ arg ], loc)
| Record_extension _ -> Lprim (Pfield (lbl.lbl_pos + 1, ptr, lbl.lbl_mut, !Lambda.fld_record_extension lbl), [ arg ], loc)
in
let str =
match lbl.lbl_mut with
Expand Down
16 changes: 8 additions & 8 deletions lambda/translcore.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -384,24 +384,24 @@ and transl_exp0 ~in_new_scope ~scopes e =
Record_regular ->
Lprim (Pfield (lbl.lbl_pos, maybe_pointer e, lbl.lbl_mut, !Lambda.fld_record lbl), [targ], of_location ~scopes e.exp_loc)
| Record_inlined _ ->
Lprim (Pfield (lbl.lbl_pos, maybe_pointer e, lbl.lbl_mut, Fld_record_inline { name = lbl.lbl_name }), [targ],
Lprim (Pfield (lbl.lbl_pos, maybe_pointer e, lbl.lbl_mut, !Lambda.fld_record_inline lbl), [targ],
of_location ~scopes e.exp_loc)
| Record_unboxed _ -> targ
| Record_float -> Lprim (Pfloatfield (lbl.lbl_pos, !Lambda.fld_record lbl), [targ], of_location ~scopes e.exp_loc)
| Record_extension _ ->
Lprim (Pfield (lbl.lbl_pos + 1, maybe_pointer e, lbl.lbl_mut, Fld_record_extension { name = lbl.lbl_name }), [targ], of_location ~scopes e.exp_loc)
Lprim (Pfield (lbl.lbl_pos + 1, maybe_pointer e, lbl.lbl_mut, !Lambda.fld_record_extension lbl), [targ], of_location ~scopes e.exp_loc)
end
| Texp_setfield(arg, _, lbl, newval) ->
let access =
match lbl.lbl_repres with
| Record_regular ->
Psetfield(lbl.lbl_pos, maybe_pointer newval, Assignment, !Lambda.fld_record_set lbl)
| Record_inlined _ ->
Psetfield(lbl.lbl_pos, maybe_pointer newval, Assignment, Fld_record_inline_set lbl.lbl_name)
Psetfield(lbl.lbl_pos, maybe_pointer newval, Assignment, !Lambda.fld_record_inline_set lbl)
| Record_unboxed _ -> assert false
| Record_float -> Psetfloatfield (lbl.lbl_pos, Assignment, !Lambda.fld_record_set lbl)
| Record_extension _ ->
Psetfield (lbl.lbl_pos + 1, maybe_pointer newval, Assignment, Fld_record_extension_set lbl.lbl_name)
Psetfield (lbl.lbl_pos + 1, maybe_pointer newval, Assignment, !Lambda.fld_record_extension_set lbl)
in
Lprim(access, [transl_exp ~scopes arg; transl_exp ~scopes newval],
of_location ~scopes e.exp_loc)
Expand Down Expand Up @@ -1002,9 +1002,9 @@ and transl_record ~scopes loc env fields repres opt_init_expr =
let access =
match repres with
Record_regular -> Pfield (i, maybe_pointer_type env typ, mut, !Lambda.fld_record lbl)
| Record_inlined _ -> Pfield (i, maybe_pointer_type env typ, mut, Fld_record_inline { name = lbl.lbl_name })
| Record_inlined _ -> Pfield (i, maybe_pointer_type env typ, mut, !Lambda.fld_record_inline lbl)
| Record_unboxed _ -> assert false
| Record_extension _ -> Pfield (i + 1, maybe_pointer_type env typ, mut, Fld_record_extension { name = lbl.lbl_name })
| Record_extension _ -> Pfield (i + 1, maybe_pointer_type env typ, mut, !Lambda.fld_record_extension lbl)
| Record_float -> Pfloatfield (i, !Lambda.fld_record lbl) in
Lprim(access, [Lvar init_id],
of_location ~scopes loc),
Expand Down Expand Up @@ -1067,11 +1067,11 @@ and transl_record ~scopes loc env fields repres opt_init_expr =
| Record_regular ->
Psetfield(lbl.lbl_pos, maybe_pointer expr, Assignment, !Lambda.fld_record_set lbl)
| Record_inlined _ ->
Psetfield(lbl.lbl_pos, maybe_pointer expr, Assignment, Fld_record_inline_set lbl.lbl_name)
Psetfield(lbl.lbl_pos, maybe_pointer expr, Assignment, !Lambda.fld_record_inline_set lbl)
| Record_unboxed _ -> assert false
| Record_float -> Psetfloatfield (lbl.lbl_pos, Assignment, !Lambda.fld_record_set lbl)
| Record_extension _ ->
Psetfield(lbl.lbl_pos + 1, maybe_pointer expr, Assignment, Fld_record_extension_set lbl.lbl_name)
Psetfield(lbl.lbl_pos + 1, maybe_pointer expr, Assignment, !Lambda.fld_record_extension_set lbl)
in
Lsequence(Lprim(upd, [Lvar copy_id; transl_exp ~scopes expr],
of_location ~scopes loc),
Expand Down