Skip to content

Inlined record fields for mixed blocks #2698

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 8 commits into from
Jul 9, 2024
Merged

Inlined record fields for mixed blocks #2698

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
b7554dc
Finish implementation
ncik-roberts May 31, 2024
868da03
Autogenerate tests
ncik-roberts Jun 17, 2024
65e1d1a
Add more tests
ncik-roberts Jun 17, 2024
b50f1d3
make fmt
ncik-roberts Jun 17, 2024
10e288b
Feedback from @ccasin review
ncik-roberts Jun 20, 2024
9b0b94f
@mshinwell comments from review
ncik-roberts Jun 20, 2024
0ad99fd
Merge remote-tracking branch 'origin/main' into nroberts-inline-recor…
ncik-roberts Jul 5, 2024
bf0d38c
Merge remote-tracking branch 'origin/main' into nroberts-inline-recor…
ncik-roberts Jul 9, 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
30 changes: 19 additions & 11 deletions middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1049,21 +1049,29 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
}
| Record_float | Record_ufloat ->
Naked_floats { length = Targetint_31_63.of_int num_fields }
| Record_mixed _ -> Mixed
| Record_inlined (Ordinary { runtime_tag; _ }, Variant_boxed _) ->
| Record_inlined (_, Constructor_mixed _, _) | Record_mixed _ -> Mixed
| Record_inlined
( Ordinary { runtime_tag; _ },
Constructor_uniform_value,
Variant_boxed _ ) ->
Values
{ tag = Tag.Scannable.create_exn runtime_tag;
length = Targetint_31_63.of_int num_fields
}
| Record_inlined (Extension _, Variant_extensible) ->
Values
{ tag = Tag.Scannable.zero;
(* The "+1" is because there is an extra field containing the hashed
constructor. *)
length = Targetint_31_63.of_int (num_fields + 1)
}
| Record_inlined (Extension _, _)
| Record_inlined (Ordinary _, (Variant_unboxed | Variant_extensible))
| Record_inlined (Extension _, shape, Variant_extensible) -> (
match shape with
| Constructor_uniform_value ->
Values
{ tag = Tag.Scannable.zero;
(* The "+1" is because there is an extra field containing the
hashed constructor. *)
length = Targetint_31_63.of_int (num_fields + 1)
}
| Constructor_mixed _ ->
(* CR layouts v5.9: support this *)
Misc.fatal_error "Mixed blocks extensible variants are not supported")
| Record_inlined (Extension _, _, _)
| Record_inlined (Ordinary _, _, (Variant_unboxed | Variant_extensible))
| Record_unboxed ->
Misc.fatal_errorf "Cannot handle record kind for Pduprecord: %a"
Printlambda.primitive prim
Expand Down
16 changes: 12 additions & 4 deletions ocaml/lambda/matching.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2163,11 +2163,11 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
let access, sort, layout =
match lbl.lbl_repres with
| Record_boxed _
| Record_inlined (_, Variant_boxed _) ->
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
Lprim (Pfield (lbl.lbl_pos, ptr, sem), [ arg ], loc),
lbl_sort, lbl_layout
| Record_unboxed
| Record_inlined (_, Variant_unboxed) -> arg, sort, layout
| Record_inlined (_, _, Variant_unboxed) -> arg, sort, layout
| Record_float ->
(* TODO: could optimise to Alloc_local sometimes *)
Lprim (Pfloatfield (lbl.lbl_pos, sem, alloc_heap), [ arg ], loc),
Expand All @@ -2177,10 +2177,18 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
Lprim (Pufloatfield (lbl.lbl_pos, sem), [ arg ], loc),
(* Here we are projecting an unboxed float from a float record. *)
lbl_sort, lbl_layout
| Record_inlined (_, Variant_extensible) ->
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
Lprim (Pfield (lbl.lbl_pos + 1, ptr, sem), [ arg ], loc),
lbl_sort, lbl_layout
| Record_mixed { value_prefix_len; flat_suffix } ->
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
(* CR layouts v5.9: support this *)
fatal_error
"Mixed inlined records not supported for extensible variants"
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
| Record_mixed shape ->
let ({ value_prefix_len; flat_suffix } : mixed_product_shape) =
shape
in
let read =
if pos < value_prefix_len then Mread_value_prefix ptr
else
Expand Down
99 changes: 74 additions & 25 deletions ocaml/lambda/translcore.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -625,10 +625,11 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
let lbl_sort = Jkind.sort_of_jkind lbl.lbl_jkind in
check_record_field_sort id.loc lbl_sort;
begin match lbl.lbl_repres with
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
Record_boxed _
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
Lprim (Pfield (lbl.lbl_pos, maybe_pointer e, sem), [targ],
of_location ~scopes e.exp_loc)
| Record_unboxed | Record_inlined (_, Variant_unboxed) -> targ
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) -> targ
| Record_float ->
let alloc_mode =
match float with
Expand All @@ -641,10 +642,18 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
| Record_ufloat ->
Lprim (Pufloatfield (lbl.lbl_pos, sem), [targ],
of_location ~scopes e.exp_loc)
| Record_inlined (_, Variant_extensible) ->
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
Lprim (Pfield (lbl.lbl_pos + 1, maybe_pointer e, sem), [targ],
of_location ~scopes e.exp_loc)
| Record_mixed { value_prefix_len; flat_suffix } ->
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
(* CR layouts v5.9: support this *)
fatal_error
"Mixed inlined records not supported for extensible variants"
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
| Record_mixed shape ->
let ({ value_prefix_len; flat_suffix } : mixed_product_shape) =
shape
in
let read =
if lbl.lbl_num < value_prefix_len then
Mread_value_prefix (maybe_pointer e)
Expand Down Expand Up @@ -682,15 +691,23 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
let access =
match lbl.lbl_repres with
Record_boxed _
| Record_inlined (_, Variant_boxed _) ->
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
Psetfield(lbl.lbl_pos, maybe_pointer newval, mode)
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
assert false
| Record_float -> Psetfloatfield (lbl.lbl_pos, mode)
| Record_ufloat -> Psetufloatfield (lbl.lbl_pos, mode)
| Record_inlined (_, Variant_extensible) ->
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
Psetfield (lbl.lbl_pos + 1, maybe_pointer newval, mode)
| Record_mixed { value_prefix_len; flat_suffix } -> begin
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
(* CR layouts v5.9: support this *)
fatal_error
"Mixed inlined records not supported for extensible variants"
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
| Record_mixed shape -> begin
let ({ value_prefix_len; flat_suffix } : mixed_product_shape) =
shape
in
let write =
if lbl.lbl_num < value_prefix_len then
Mwrite_value_prefix (maybe_pointer newval)
Expand Down Expand Up @@ -1782,18 +1799,27 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
in
let access =
match repres with
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
Record_boxed _
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
Pfield (i, maybe_pointer_type env typ, sem)
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
assert false
| Record_inlined (_, Variant_extensible) ->
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
Pfield (i + 1, maybe_pointer_type env typ, sem)
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
(* CR layouts v5.9: support this *)
fatal_error
"Mixed inlined records not supported for extensible variants"
| Record_float ->
(* This allocation is always deleted,
so it's simpler to leave it Alloc_heap *)
Pfloatfield (i, sem, alloc_heap)
| Record_ufloat -> Pufloatfield (i, sem)
| Record_mixed { value_prefix_len; flat_suffix } ->
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
| Record_mixed shape ->
let { value_prefix_len; flat_suffix } : mixed_product_shape =
shape
in
let read =
if lbl.lbl_num < value_prefix_len then
Mread_value_prefix (maybe_pointer_type env typ)
Expand Down Expand Up @@ -1833,47 +1859,61 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
let cl = List.map extract_constant ll in
match repres with
| Record_boxed _ -> Lconst(Const_block(0, cl))
| Record_inlined (Ordinary {runtime_tag}, Variant_boxed _) ->
| Record_inlined (Ordinary {runtime_tag},
Constructor_uniform_value, Variant_boxed _) ->
Lconst(Const_block(runtime_tag, cl))
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
Lconst(match cl with [v] -> v | _ -> assert false)
| Record_float ->
Lconst(Const_float_block(List.map extract_float cl))
| Record_inlined (_, Constructor_mixed _, Variant_boxed _)
| Record_ufloat | Record_mixed _ ->
(* CR layouts v5.1: We should support structured constants for
blocks containing unboxed float literals.
*)
raise Not_constant
| Record_inlined (_, Variant_extensible)
| Record_inlined (Extension _, _) ->
| Record_inlined (_, _, Variant_extensible)
| Record_inlined (Extension _, _, _) ->
raise Not_constant
with Not_constant ->
let loc = of_location ~scopes loc in
match repres with
Record_boxed _ ->
let shape = List.map must_be_value shape in
Lprim(Pmakeblock(0, mut, Some shape, Option.get mode), ll, loc)
| Record_inlined (Ordinary {runtime_tag}, Variant_boxed _) ->
| Record_inlined (Ordinary {runtime_tag},
Constructor_uniform_value, Variant_boxed _) ->
let shape = List.map must_be_value shape in
Lprim(Pmakeblock(runtime_tag, mut, Some shape, Option.get mode),
ll, loc)
| Record_unboxed | Record_inlined (Ordinary _, Variant_unboxed) ->
| Record_unboxed | Record_inlined (Ordinary _, _, Variant_unboxed) ->
(match ll with [v] -> v | _ -> assert false)
| Record_float ->
Lprim(Pmakefloatblock (mut, Option.get mode), ll, loc)
| Record_ufloat ->
Lprim(Pmakeufloatblock (mut, Option.get mode), ll, loc)
| Record_inlined (Extension (path, _), Variant_extensible) ->
| Record_inlined (Extension _,
Constructor_mixed _, Variant_extensible) ->
(* CR layouts v5.9: support this *)
fatal_error
"Mixed inlined records not supported for extensible variants"
| Record_inlined (Extension (path, _),
Constructor_uniform_value, Variant_extensible) ->
let shape = List.map must_be_value shape in
let slot = transl_extension_path loc env path in
Lprim(Pmakeblock(0, mut, Some (Pgenval :: shape), Option.get mode),
slot :: ll, loc)
| Record_inlined (Extension _, (Variant_unboxed | Variant_boxed _))
| Record_inlined (Ordinary _, Variant_extensible) ->
| Record_inlined (Extension _, _, (Variant_unboxed | Variant_boxed _))
| Record_inlined (Ordinary _, _, Variant_extensible) ->
assert false
| Record_mixed shape ->
let shape = transl_mixed_product_shape shape in
Lprim (Pmakemixedblock (0, mut, shape, Option.get mode), ll, loc)
| Record_inlined (Ordinary { runtime_tag },
Constructor_mixed shape, Variant_boxed _) ->
let shape = transl_mixed_product_shape shape in
Lprim (Pmakemixedblock (runtime_tag, mut, shape, Option.get mode),
ll, loc)
in
begin match opt_init_expr with
None -> lam
Expand All @@ -1893,20 +1933,29 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
| Overridden (_lid, expr) ->
let upd =
match repres with
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
Record_boxed _
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
let ptr = maybe_pointer expr in
Psetfield(lbl.lbl_pos, ptr, Assignment modify_heap)
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
assert false
| Record_float ->
Psetfloatfield (lbl.lbl_pos, Assignment modify_heap)
| Record_ufloat ->
Psetufloatfield (lbl.lbl_pos, Assignment modify_heap)
| Record_inlined (_, Variant_extensible) ->
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
let pos = lbl.lbl_pos + 1 in
let ptr = maybe_pointer expr in
Psetfield(pos, ptr, Assignment modify_heap)
| Record_mixed { value_prefix_len; flat_suffix } -> begin
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
(* CR layouts v5.9: support this *)
fatal_error
"Mixed inlined records not supported for extensible variants"
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
| Record_mixed shape -> begin
let { value_prefix_len; flat_suffix } : mixed_product_shape =
shape
in
let write =
if lbl.lbl_num < value_prefix_len then
let ptr = maybe_pointer expr in
Expand Down
7 changes: 5 additions & 2 deletions ocaml/lambda/value_rec_compiler.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -227,13 +227,16 @@ let compute_static_size lam =
| Pduprecord (repres, size) ->
begin match repres with
| Record_boxed _
| Record_inlined (_, (Variant_boxed _ | Variant_extensible)) ->
| Record_inlined (_, Constructor_uniform_value,
(Variant_boxed _ | Variant_extensible)) ->
Block (Regular_block size)
| Record_float ->
Block (Float_record size)
| Record_inlined (_, Constructor_mixed shape,
(Variant_boxed _ | Variant_extensible))
| Record_mixed shape ->
Block (Mixed_record (size, Lambda.transl_mixed_product_shape shape))
| Record_unboxed | Record_ufloat | Record_inlined (_, Variant_unboxed) ->
| Record_unboxed | Record_ufloat | Record_inlined (_, _, Variant_unboxed) ->
Misc.fatal_error "size_of_primitive"
end
| Pmakeblock _ ->
Expand Down
Loading
Loading