Skip to content

Commit 26d0c75

Browse files
ncik-robertsliam923
ncik-roberts
authored and
liam923
committed
Inlined record fields for mixed blocks (#2698)
* Finish implementation * Autogenerate tests * Add more tests * make fmt * Feedback from @ccasin review * @mshinwell comments from review
1 parent ad4212f commit 26d0c75

38 files changed

+4122
-3124
lines changed

‎middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1049,21 +1049,29 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
10491049
}
10501050
| Record_float | Record_ufloat ->
10511051
Naked_floats { length = Targetint_31_63.of_int num_fields }
1052-
| Record_mixed _ -> Mixed
1053-
| Record_inlined (Ordinary { runtime_tag; _ }, Variant_boxed _) ->
1052+
| Record_inlined (_, Constructor_mixed _, _) | Record_mixed _ -> Mixed
1053+
| Record_inlined
1054+
( Ordinary { runtime_tag; _ },
1055+
Constructor_uniform_value,
1056+
Variant_boxed _ ) ->
10541057
Values
10551058
{ tag = Tag.Scannable.create_exn runtime_tag;
10561059
length = Targetint_31_63.of_int num_fields
10571060
}
1058-
| Record_inlined (Extension _, Variant_extensible) ->
1059-
Values
1060-
{ tag = Tag.Scannable.zero;
1061-
(* The "+1" is because there is an extra field containing the hashed
1062-
constructor. *)
1063-
length = Targetint_31_63.of_int (num_fields + 1)
1064-
}
1065-
| Record_inlined (Extension _, _)
1066-
| Record_inlined (Ordinary _, (Variant_unboxed | Variant_extensible))
1061+
| Record_inlined (Extension _, shape, Variant_extensible) -> (
1062+
match shape with
1063+
| Constructor_uniform_value ->
1064+
Values
1065+
{ tag = Tag.Scannable.zero;
1066+
(* The "+1" is because there is an extra field containing the
1067+
hashed constructor. *)
1068+
length = Targetint_31_63.of_int (num_fields + 1)
1069+
}
1070+
| Constructor_mixed _ ->
1071+
(* CR layouts v5.9: support this *)
1072+
Misc.fatal_error "Mixed blocks extensible variants are not supported")
1073+
| Record_inlined (Extension _, _, _)
1074+
| Record_inlined (Ordinary _, _, (Variant_unboxed | Variant_extensible))
10671075
| Record_unboxed ->
10681076
Misc.fatal_errorf "Cannot handle record kind for Pduprecord: %a"
10691077
Printlambda.primitive prim

‎ocaml/lambda/matching.ml

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2163,11 +2163,11 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
21632163
let access, sort, layout =
21642164
match lbl.lbl_repres with
21652165
| Record_boxed _
2166-
| Record_inlined (_, Variant_boxed _) ->
2166+
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
21672167
Lprim (Pfield (lbl.lbl_pos, ptr, sem), [ arg ], loc),
21682168
lbl_sort, lbl_layout
21692169
| Record_unboxed
2170-
| Record_inlined (_, Variant_unboxed) -> arg, sort, layout
2170+
| Record_inlined (_, _, Variant_unboxed) -> arg, sort, layout
21712171
| Record_float ->
21722172
(* TODO: could optimise to Alloc_local sometimes *)
21732173
Lprim (Pfloatfield (lbl.lbl_pos, sem, alloc_heap), [ arg ], loc),
@@ -2177,10 +2177,18 @@ let get_expr_args_record ~scopes head (arg, _mut, sort, layout) rem =
21772177
Lprim (Pufloatfield (lbl.lbl_pos, sem), [ arg ], loc),
21782178
(* Here we are projecting an unboxed float from a float record. *)
21792179
lbl_sort, lbl_layout
2180-
| Record_inlined (_, Variant_extensible) ->
2180+
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
21812181
Lprim (Pfield (lbl.lbl_pos + 1, ptr, sem), [ arg ], loc),
21822182
lbl_sort, lbl_layout
2183-
| Record_mixed { value_prefix_len; flat_suffix } ->
2183+
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
2184+
(* CR layouts v5.9: support this *)
2185+
fatal_error
2186+
"Mixed inlined records not supported for extensible variants"
2187+
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
2188+
| Record_mixed shape ->
2189+
let ({ value_prefix_len; flat_suffix } : mixed_product_shape) =
2190+
shape
2191+
in
21842192
let read =
21852193
if pos < value_prefix_len then Mread_value_prefix ptr
21862194
else

‎ocaml/lambda/translcore.ml

Lines changed: 74 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -625,10 +625,11 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
625625
let lbl_sort = Jkind.sort_of_jkind lbl.lbl_jkind in
626626
check_record_field_sort id.loc lbl_sort;
627627
begin match lbl.lbl_repres with
628-
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
628+
Record_boxed _
629+
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
629630
Lprim (Pfield (lbl.lbl_pos, maybe_pointer e, sem), [targ],
630631
of_location ~scopes e.exp_loc)
631-
| Record_unboxed | Record_inlined (_, Variant_unboxed) -> targ
632+
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) -> targ
632633
| Record_float ->
633634
let alloc_mode =
634635
match float with
@@ -641,10 +642,18 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
641642
| Record_ufloat ->
642643
Lprim (Pufloatfield (lbl.lbl_pos, sem), [targ],
643644
of_location ~scopes e.exp_loc)
644-
| Record_inlined (_, Variant_extensible) ->
645+
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
645646
Lprim (Pfield (lbl.lbl_pos + 1, maybe_pointer e, sem), [targ],
646647
of_location ~scopes e.exp_loc)
647-
| Record_mixed { value_prefix_len; flat_suffix } ->
648+
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
649+
(* CR layouts v5.9: support this *)
650+
fatal_error
651+
"Mixed inlined records not supported for extensible variants"
652+
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
653+
| Record_mixed shape ->
654+
let ({ value_prefix_len; flat_suffix } : mixed_product_shape) =
655+
shape
656+
in
648657
let read =
649658
if lbl.lbl_num < value_prefix_len then
650659
Mread_value_prefix (maybe_pointer e)
@@ -682,15 +691,23 @@ and transl_exp0 ~in_new_scope ~scopes sort e =
682691
let access =
683692
match lbl.lbl_repres with
684693
Record_boxed _
685-
| Record_inlined (_, Variant_boxed _) ->
694+
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
686695
Psetfield(lbl.lbl_pos, maybe_pointer newval, mode)
687-
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
696+
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
688697
assert false
689698
| Record_float -> Psetfloatfield (lbl.lbl_pos, mode)
690699
| Record_ufloat -> Psetufloatfield (lbl.lbl_pos, mode)
691-
| Record_inlined (_, Variant_extensible) ->
700+
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
692701
Psetfield (lbl.lbl_pos + 1, maybe_pointer newval, mode)
693-
| Record_mixed { value_prefix_len; flat_suffix } -> begin
702+
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
703+
(* CR layouts v5.9: support this *)
704+
fatal_error
705+
"Mixed inlined records not supported for extensible variants"
706+
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
707+
| Record_mixed shape -> begin
708+
let ({ value_prefix_len; flat_suffix } : mixed_product_shape) =
709+
shape
710+
in
694711
let write =
695712
if lbl.lbl_num < value_prefix_len then
696713
Mwrite_value_prefix (maybe_pointer newval)
@@ -1782,18 +1799,27 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
17821799
in
17831800
let access =
17841801
match repres with
1785-
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
1802+
Record_boxed _
1803+
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
17861804
Pfield (i, maybe_pointer_type env typ, sem)
1787-
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
1805+
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
17881806
assert false
1789-
| Record_inlined (_, Variant_extensible) ->
1807+
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
17901808
Pfield (i + 1, maybe_pointer_type env typ, sem)
1809+
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
1810+
(* CR layouts v5.9: support this *)
1811+
fatal_error
1812+
"Mixed inlined records not supported for extensible variants"
17911813
| Record_float ->
17921814
(* This allocation is always deleted,
17931815
so it's simpler to leave it Alloc_heap *)
17941816
Pfloatfield (i, sem, alloc_heap)
17951817
| Record_ufloat -> Pufloatfield (i, sem)
1796-
| Record_mixed { value_prefix_len; flat_suffix } ->
1818+
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
1819+
| Record_mixed shape ->
1820+
let { value_prefix_len; flat_suffix } : mixed_product_shape =
1821+
shape
1822+
in
17971823
let read =
17981824
if lbl.lbl_num < value_prefix_len then
17991825
Mread_value_prefix (maybe_pointer_type env typ)
@@ -1833,47 +1859,61 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
18331859
let cl = List.map extract_constant ll in
18341860
match repres with
18351861
| Record_boxed _ -> Lconst(Const_block(0, cl))
1836-
| Record_inlined (Ordinary {runtime_tag}, Variant_boxed _) ->
1862+
| Record_inlined (Ordinary {runtime_tag},
1863+
Constructor_uniform_value, Variant_boxed _) ->
18371864
Lconst(Const_block(runtime_tag, cl))
1838-
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
1865+
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
18391866
Lconst(match cl with [v] -> v | _ -> assert false)
18401867
| Record_float ->
18411868
Lconst(Const_float_block(List.map extract_float cl))
1869+
| Record_inlined (_, Constructor_mixed _, Variant_boxed _)
18421870
| Record_ufloat | Record_mixed _ ->
18431871
(* CR layouts v5.1: We should support structured constants for
18441872
blocks containing unboxed float literals.
18451873
*)
18461874
raise Not_constant
1847-
| Record_inlined (_, Variant_extensible)
1848-
| Record_inlined (Extension _, _) ->
1875+
| Record_inlined (_, _, Variant_extensible)
1876+
| Record_inlined (Extension _, _, _) ->
18491877
raise Not_constant
18501878
with Not_constant ->
18511879
let loc = of_location ~scopes loc in
18521880
match repres with
18531881
Record_boxed _ ->
18541882
let shape = List.map must_be_value shape in
18551883
Lprim(Pmakeblock(0, mut, Some shape, Option.get mode), ll, loc)
1856-
| Record_inlined (Ordinary {runtime_tag}, Variant_boxed _) ->
1884+
| Record_inlined (Ordinary {runtime_tag},
1885+
Constructor_uniform_value, Variant_boxed _) ->
18571886
let shape = List.map must_be_value shape in
18581887
Lprim(Pmakeblock(runtime_tag, mut, Some shape, Option.get mode),
18591888
ll, loc)
1860-
| Record_unboxed | Record_inlined (Ordinary _, Variant_unboxed) ->
1889+
| Record_unboxed | Record_inlined (Ordinary _, _, Variant_unboxed) ->
18611890
(match ll with [v] -> v | _ -> assert false)
18621891
| Record_float ->
18631892
Lprim(Pmakefloatblock (mut, Option.get mode), ll, loc)
18641893
| Record_ufloat ->
18651894
Lprim(Pmakeufloatblock (mut, Option.get mode), ll, loc)
1866-
| Record_inlined (Extension (path, _), Variant_extensible) ->
1895+
| Record_inlined (Extension _,
1896+
Constructor_mixed _, Variant_extensible) ->
1897+
(* CR layouts v5.9: support this *)
1898+
fatal_error
1899+
"Mixed inlined records not supported for extensible variants"
1900+
| Record_inlined (Extension (path, _),
1901+
Constructor_uniform_value, Variant_extensible) ->
18671902
let shape = List.map must_be_value shape in
18681903
let slot = transl_extension_path loc env path in
18691904
Lprim(Pmakeblock(0, mut, Some (Pgenval :: shape), Option.get mode),
18701905
slot :: ll, loc)
1871-
| Record_inlined (Extension _, (Variant_unboxed | Variant_boxed _))
1872-
| Record_inlined (Ordinary _, Variant_extensible) ->
1906+
| Record_inlined (Extension _, _, (Variant_unboxed | Variant_boxed _))
1907+
| Record_inlined (Ordinary _, _, Variant_extensible) ->
18731908
assert false
18741909
| Record_mixed shape ->
18751910
let shape = transl_mixed_product_shape shape in
18761911
Lprim (Pmakemixedblock (0, mut, shape, Option.get mode), ll, loc)
1912+
| Record_inlined (Ordinary { runtime_tag },
1913+
Constructor_mixed shape, Variant_boxed _) ->
1914+
let shape = transl_mixed_product_shape shape in
1915+
Lprim (Pmakemixedblock (runtime_tag, mut, shape, Option.get mode),
1916+
ll, loc)
18771917
in
18781918
begin match opt_init_expr with
18791919
None -> lam
@@ -1893,20 +1933,29 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
18931933
| Overridden (_lid, expr) ->
18941934
let upd =
18951935
match repres with
1896-
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
1936+
Record_boxed _
1937+
| Record_inlined (_, Constructor_uniform_value, Variant_boxed _) ->
18971938
let ptr = maybe_pointer expr in
18981939
Psetfield(lbl.lbl_pos, ptr, Assignment modify_heap)
1899-
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
1940+
| Record_unboxed | Record_inlined (_, _, Variant_unboxed) ->
19001941
assert false
19011942
| Record_float ->
19021943
Psetfloatfield (lbl.lbl_pos, Assignment modify_heap)
19031944
| Record_ufloat ->
19041945
Psetufloatfield (lbl.lbl_pos, Assignment modify_heap)
1905-
| Record_inlined (_, Variant_extensible) ->
1946+
| Record_inlined (_, Constructor_uniform_value, Variant_extensible) ->
19061947
let pos = lbl.lbl_pos + 1 in
19071948
let ptr = maybe_pointer expr in
19081949
Psetfield(pos, ptr, Assignment modify_heap)
1909-
| Record_mixed { value_prefix_len; flat_suffix } -> begin
1950+
| Record_inlined (_, Constructor_mixed _, Variant_extensible) ->
1951+
(* CR layouts v5.9: support this *)
1952+
fatal_error
1953+
"Mixed inlined records not supported for extensible variants"
1954+
| Record_inlined (_, Constructor_mixed shape, Variant_boxed _)
1955+
| Record_mixed shape -> begin
1956+
let { value_prefix_len; flat_suffix } : mixed_product_shape =
1957+
shape
1958+
in
19101959
let write =
19111960
if lbl.lbl_num < value_prefix_len then
19121961
let ptr = maybe_pointer expr in

‎ocaml/lambda/value_rec_compiler.ml

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -227,13 +227,16 @@ let compute_static_size lam =
227227
| Pduprecord (repres, size) ->
228228
begin match repres with
229229
| Record_boxed _
230-
| Record_inlined (_, (Variant_boxed _ | Variant_extensible)) ->
230+
| Record_inlined (_, Constructor_uniform_value,
231+
(Variant_boxed _ | Variant_extensible)) ->
231232
Block (Regular_block size)
232233
| Record_float ->
233234
Block (Float_record size)
235+
| Record_inlined (_, Constructor_mixed shape,
236+
(Variant_boxed _ | Variant_extensible))
234237
| Record_mixed shape ->
235238
Block (Mixed_record (size, Lambda.transl_mixed_product_shape shape))
236-
| Record_unboxed | Record_ufloat | Record_inlined (_, Variant_unboxed) ->
239+
| Record_unboxed | Record_ufloat | Record_inlined (_, _, Variant_unboxed) ->
237240
Misc.fatal_error "size_of_primitive"
238241
end
239242
| Pmakeblock _ ->

0 commit comments

Comments
 (0)