Skip to content

Commit 4464897

Browse files
goldfireregoldfirere
authored
Move layout from Type_abstract to type_declaration (#1384)
Move layout from Type_abstract to type_declaration
1 parent 460f4e2 commit 4464897

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

42 files changed

+452
-380
lines changed

‎backend/cmmgen.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -197,8 +197,8 @@ let rec expr_size env = function
197197
| Uprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
198198
sz), _, _) ->
199199
RHS_block (Lambda.alloc_heap, sz)
200-
| Uprim (Pduprecord ((Record_unboxed _
201-
| Record_inlined (_, Variant_unboxed _)),
200+
| Uprim (Pduprecord ((Record_unboxed
201+
| Record_inlined (_, Variant_unboxed)),
202202
_), _, _) ->
203203
assert false
204204
| Uprim (Pduprecord (Record_inlined (_, Variant_extensible), sz), _, _) ->

‎middle_end/flambda2/from_lambda/dissect_letrec.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -287,8 +287,8 @@ let rec prepare_letrec (recursive_set : Ident.Set.t)
287287
build_block cl (size + 1) (Normal 0) arg letrec
288288
| Record_float -> build_block cl size Boxed_float arg letrec
289289
| Record_inlined (Extension _, _)
290-
| Record_inlined (Ordinary _, (Variant_unboxed _ | Variant_extensible))
291-
| Record_unboxed _ ->
290+
| Record_inlined (Ordinary _, (Variant_unboxed | Variant_extensible))
291+
| Record_unboxed ->
292292
Misc.fatal_errorf "Unexpected record kind:@ %a" Printlambda.lambda lam)
293293
| None -> dead_code lam letrec)
294294
| Lconst const -> (

‎middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -655,8 +655,8 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list)
655655
length = Targetint_31_63.of_int (num_fields + 1)
656656
}
657657
| Record_inlined (Extension _, _)
658-
| Record_inlined (Ordinary _, (Variant_unboxed _ | Variant_extensible))
659-
| Record_unboxed _ ->
658+
| Record_inlined (Ordinary _, (Variant_unboxed | Variant_extensible))
659+
| Record_unboxed ->
660660
Misc.fatal_errorf "Cannot handle record kind for Pduprecord: %a"
661661
Printlambda.primitive prim
662662
in

‎ocaml/asmcomp/cmmgen.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -171,8 +171,8 @@ let rec expr_size env = function
171171
| Uprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
172172
sz), _, _) ->
173173
RHS_block (Lambda.alloc_heap, sz)
174-
| Uprim (Pduprecord ((Record_unboxed _
175-
| Record_inlined (_, Variant_unboxed _)),
174+
| Uprim (Pduprecord ((Record_unboxed
175+
| Record_inlined (_, Variant_unboxed)),
176176
_), _, _) ->
177177
assert false
178178
| Uprim (Pduprecord (Record_inlined (_, Variant_extensible), sz), _, _) ->

‎ocaml/boot/ocamlc

1001 Bytes
Binary file not shown.

‎ocaml/boot/ocamllex

28 Bytes
Binary file not shown.

‎ocaml/bytecomp/bytegen.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -189,7 +189,7 @@ let rec size_of_lambda env = function
189189
when check_recordwith_updates id body ->
190190
begin match kind with
191191
| Record_boxed _ | Record_inlined (_, Variant_boxed _) -> RHS_block size
192-
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) -> assert false
192+
| Record_unboxed | Record_inlined (_, Variant_unboxed) -> assert false
193193
| Record_float -> RHS_floatblock size
194194
| Record_inlined (_, Variant_extensible) -> RHS_block (size + 1)
195195
end
@@ -226,8 +226,8 @@ let rec size_of_lambda env = function
226226
| Lprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
227227
size), _, _) ->
228228
RHS_block size
229-
| Lprim (Pduprecord ((Record_unboxed _
230-
| Record_inlined (_, Variant_unboxed _)),
229+
| Lprim (Pduprecord ((Record_unboxed
230+
| Record_inlined (_, Variant_unboxed)),
231231
_), _, _) ->
232232
assert false
233233
| Lprim (Pduprecord (Record_inlined (_, Variant_extensible), size), _, _) ->

‎ocaml/lambda/matching.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1801,7 +1801,7 @@ let get_expr_args_constr ~scopes head (arg, _mut, layout) rem =
18011801
match cstr.cstr_repr with
18021802
| Variant_boxed _ ->
18031803
make_field_accesses Alias 0 (cstr.cstr_arity - 1) rem
1804-
| Variant_unboxed _ -> (arg, Alias, layout) :: rem
1804+
| Variant_unboxed -> (arg, Alias, layout) :: rem
18051805
| Variant_extensible -> make_field_accesses Alias 1 cstr.cstr_arity rem
18061806

18071807
let divide_constructor ~scopes ctx pm =
@@ -2118,8 +2118,8 @@ let get_expr_args_record ~scopes head (arg, _mut, layout) rem =
21182118
| Record_boxed _
21192119
| Record_inlined (_, Variant_boxed _) ->
21202120
Lprim (Pfield (lbl.lbl_pos, sem), [ arg ], loc), layout_field
2121-
| Record_unboxed _
2122-
| Record_inlined (_, Variant_unboxed _) -> arg, layout
2121+
| Record_unboxed
2122+
| Record_inlined (_, Variant_unboxed) -> arg, layout
21232123
| Record_float ->
21242124
(* TODO: could optimise to Alloc_local sometimes *)
21252125
Lprim (Pfloatfield (lbl.lbl_pos, sem, alloc_heap), [ arg ], loc),
@@ -2831,7 +2831,7 @@ let split_cases tag_lambda_list =
28312831
| ({cstr_tag; cstr_repr; cstr_constant}, act) :: rem -> (
28322832
let consts, nonconsts = split_rec rem in
28332833
match cstr_tag, cstr_repr with
2834-
| Ordinary _, Variant_unboxed _ -> (consts, (0, act) :: nonconsts)
2834+
| Ordinary _, Variant_unboxed -> (consts, (0, act) :: nonconsts)
28352835
| Ordinary {runtime_tag}, Variant_boxed _ when cstr_constant ->
28362836
((runtime_tag, act) :: consts, nonconsts)
28372837
| Ordinary {runtime_tag}, Variant_boxed _ ->

‎ocaml/lambda/printlambda.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -179,7 +179,7 @@ let print_bigarray name unsafe kind ppf layout =
179179
| Pbigarray_fortran_layout -> "Fortran")
180180

181181
let record_rep ppf r = match r with
182-
| Record_unboxed _ -> fprintf ppf "unboxed"
182+
| Record_unboxed -> fprintf ppf "unboxed"
183183
| Record_boxed _ -> fprintf ppf "boxed"
184184
| Record_inlined _ -> fprintf ppf "inlined"
185185
| Record_float -> fprintf ppf "float"

‎ocaml/lambda/translcore.ml

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -468,7 +468,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
468468
(* CR layouts v5: This could have void args, but for now we've ruled
469469
that out with the layout check in transl_list_with_shape *)
470470
Lconst(const_int runtime_tag)
471-
| Ordinary _, Variant_unboxed _ ->
471+
| Ordinary _, Variant_unboxed ->
472472
(match ll with [v] -> v | _ -> assert false)
473473
| Ordinary {runtime_tag}, Variant_boxed _ ->
474474
begin try
@@ -491,7 +491,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
491491
Lprim(Pmakeblock(0, Immutable, Some (Pgenval :: shape),
492492
transl_alloc_mode (Option.get alloc_mode)),
493493
lam :: ll, of_location ~scopes e.exp_loc)
494-
| Extension _, (Variant_boxed _ | Variant_unboxed _)
494+
| Extension _, (Variant_boxed _ | Variant_unboxed)
495495
| Ordinary _, Variant_extensible -> assert false
496496
end
497497
| Texp_extension_constructor (_, path) ->
@@ -526,7 +526,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
526526
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
527527
Lprim (Pfield (lbl.lbl_pos, sem), [targ],
528528
of_location ~scopes e.exp_loc)
529-
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) -> targ
529+
| Record_unboxed | Record_inlined (_, Variant_unboxed) -> targ
530530
| Record_float ->
531531
let mode = transl_alloc_mode (Option.get alloc_mode) in
532532
Lprim (Pfloatfield (lbl.lbl_pos, sem, mode), [targ],
@@ -545,7 +545,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
545545
Record_boxed _
546546
| Record_inlined (_, Variant_boxed _) ->
547547
Psetfield(lbl.lbl_pos, maybe_pointer newval, mode)
548-
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) ->
548+
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
549549
assert false
550550
| Record_float -> Psetfloatfield (lbl.lbl_pos, mode)
551551
| Record_inlined (_, Variant_extensible) ->
@@ -1412,7 +1412,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
14121412
match repres with
14131413
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
14141414
Pfield (i, sem)
1415-
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) ->
1415+
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
14161416
assert false
14171417
| Record_inlined (_, Variant_extensible) -> Pfield (i + 1, sem)
14181418
| Record_float ->
@@ -1440,7 +1440,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
14401440
| Record_boxed _ -> Lconst(Const_block(0, cl))
14411441
| Record_inlined (Ordinary {runtime_tag}, Variant_boxed _) ->
14421442
Lconst(Const_block(runtime_tag, cl))
1443-
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) ->
1443+
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
14441444
Lconst(match cl with [v] -> v | _ -> assert false)
14451445
| Record_float ->
14461446
Lconst(Const_float_block(List.map extract_float cl))
@@ -1455,15 +1455,15 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
14551455
| Record_inlined (Ordinary {runtime_tag}, Variant_boxed _) ->
14561456
Lprim(Pmakeblock(runtime_tag, mut, Some shape, Option.get mode),
14571457
ll, loc)
1458-
| Record_unboxed _ | Record_inlined (Ordinary _, Variant_unboxed _) ->
1458+
| Record_unboxed | Record_inlined (Ordinary _, Variant_unboxed) ->
14591459
(match ll with [v] -> v | _ -> assert false)
14601460
| Record_float ->
14611461
Lprim(Pmakefloatblock (mut, Option.get mode), ll, loc)
14621462
| Record_inlined (Extension (path, _), Variant_extensible) ->
14631463
let slot = transl_extension_path loc env path in
14641464
Lprim(Pmakeblock(0, mut, Some (Pgenval :: shape), Option.get mode),
14651465
slot :: ll, loc)
1466-
| Record_inlined (Extension _, (Variant_unboxed _ | Variant_boxed _))
1466+
| Record_inlined (Extension _, (Variant_unboxed | Variant_boxed _))
14671467
| Record_inlined (Ordinary _, Variant_extensible) ->
14681468
assert false
14691469
in
@@ -1489,7 +1489,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
14891489
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
14901490
let ptr = maybe_pointer expr in
14911491
Psetfield(lbl.lbl_pos, ptr, Assignment modify_heap)
1492-
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) ->
1492+
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
14931493
assert false
14941494
| Record_float ->
14951495
Psetfloatfield (lbl.lbl_pos, Assignment modify_heap)

‎ocaml/ocamldoc/odoc_sig.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -372,7 +372,7 @@ module Analyser =
372372

373373
let get_type_kind env name_comment_list type_kind =
374374
match type_kind with
375-
Types.Type_abstract _ ->
375+
Types.Type_abstract ->
376376
Odoc_type.Type_abstract
377377
| Types.Type_variant (l,_) ->
378378
let f {Types.cd_id=constructor_name;cd_args;cd_res=ret_type} =

‎ocaml/testsuite/tests/typing-immediate/immediate.ml

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,7 @@ end;;
143143
Line 2, characters 2-31:
144144
2 | type t = string [@@immediate]
145145
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
146-
Error: This type has layout value, which is not a sublayout of immediate.
146+
Error: Type string has layout value, which is not a sublayout of immediate.
147147
|}];;
148148

149149
(* Cannot directly declare a non-immediate type as immediate (variant) *)
@@ -154,8 +154,7 @@ end;;
154154
Line 2, characters 2-41:
155155
2 | type t = Foo of int | Bar [@@immediate]
156156
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
157-
Error:
158-
t has layout value, which is not a sublayout of immediate.
157+
Error: Type t has layout value, which is not a sublayout of immediate.
159158
|}];;
160159

161160
(* Cannot directly declare a non-immediate type as immediate (record) *)
@@ -166,8 +165,7 @@ end;;
166165
Line 2, characters 2-38:
167166
2 | type t = { foo : int } [@@immediate]
168167
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
169-
Error:
170-
t has layout value, which is not a sublayout of immediate.
168+
Error: Type t has layout value, which is not a sublayout of immediate.
171169
|}];;
172170

173171
(* Not guaranteed that t is immediate, so this is an invalid declaration *)
@@ -179,7 +177,7 @@ end;;
179177
Line 3, characters 2-26:
180178
3 | type s = t [@@immediate]
181179
^^^^^^^^^^^^^^^^^^^^^^^^
182-
Error: This type has layout value, which is not a sublayout of immediate.
180+
Error: Type t has layout value, which is not a sublayout of immediate.
183181
|}];;
184182

185183
(* Can't ascribe to an immediate type signature with a non-immediate type *)
@@ -228,7 +226,7 @@ end;;
228226
Line 2, characters 2-26:
229227
2 | type t = s [@@immediate]
230228
^^^^^^^^^^^^^^^^^^^^^^^^
231-
Error: This type has layout value, which is not a sublayout of immediate.
229+
Error: Type s has layout value, which is not a sublayout of immediate.
232230
|}];;
233231

234232

‎ocaml/testsuite/tests/typing-layouts/datatypes_alpha.ml

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -284,3 +284,20 @@ Error: This expression has type float but an expression was expected of type
284284
('a : immediate)
285285
float has layout value, which is not a sublayout of immediate.
286286
|}];;
287+
288+
(*****************************************************)
289+
(* Test 7: Recursive propagation of immediacy checks *)
290+
291+
(* See Note [Default layouts in transl_declaration] in Typedecl. *)
292+
type t7 = A | B | C | D of t7_void
293+
and t7_2 = { x : t7 } [@@unboxed]
294+
and t7_void [@@void]
295+
296+
type t7_3 = t7_2 [@@immediate]
297+
298+
[%%expect{|
299+
type t7 = A | B | C | D of t7_void
300+
and t7_2 = { x : t7; } [@@unboxed]
301+
and t7_void [@@void]
302+
type t7_3 = t7_2 [@@immediate]
303+
|}]

‎ocaml/testsuite/tests/typing-layouts/modules.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -128,7 +128,7 @@ end;;
128128
Line 2, characters 2-31:
129129
2 | type t = Bar3.t [@@immediate]
130130
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
131-
Error: This type has layout value, which is not a sublayout of immediate.
131+
Error: Type Bar3.t has layout value, which is not a sublayout of immediate.
132132
|}];;
133133

134134
module rec Foo3 : sig
@@ -174,7 +174,7 @@ module type S3_2 = sig type t [@@immediate] end
174174
Line 5, characters 30-46:
175175
5 | module type S3_2' = S3_2 with type t := string;;
176176
^^^^^^^^^^^^^^^^
177-
Error: This type has layout value, which is not a sublayout of immediate.
177+
Error: Type string has layout value, which is not a sublayout of immediate.
178178
|}]
179179

180180
(*****************************************)

‎ocaml/testsuite/tests/typing-layouts/modules_alpha.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ module type S1'' = S1 with type s = t_void;;
4646
Line 1, characters 27-42:
4747
1 | module type S1'' = S1 with type s = t_void;;
4848
^^^^^^^^^^^^^^^
49-
Error: This type has layout void, which is not a sublayout of value.
49+
Error: Type t_void has layout void, which is not a sublayout of value.
5050
|}]
5151

5252
module type S1_2 = sig
@@ -181,7 +181,7 @@ end;;
181181
Line 2, characters 2-31:
182182
2 | type t = Bar3.t [@@immediate]
183183
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
184-
Error: This type has layout value, which is not a sublayout of immediate.
184+
Error: Type Bar3/2.t has layout value, which is not a sublayout of immediate.
185185
|}];;
186186

187187
module rec Foo3 : sig
@@ -363,7 +363,7 @@ module type S3_2 = sig type t [@@immediate] end
363363
Line 5, characters 30-46:
364364
5 | module type S3_2' = S3_2 with type t := string;;
365365
^^^^^^^^^^^^^^^^
366-
Error: This type has layout value, which is not a sublayout of immediate.
366+
Error: Type string has layout value, which is not a sublayout of immediate.
367367
|}]
368368

369369
(*****************************************)

‎ocaml/testsuite/tests/typing-layouts/modules_beta.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -199,7 +199,7 @@ end;;
199199
Line 2, characters 2-31:
200200
2 | type t = Bar3.t [@@immediate]
201201
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
202-
Error: This type has layout value, which is not a sublayout of immediate.
202+
Error: Type Bar3.t has layout value, which is not a sublayout of immediate.
203203
|}];;
204204

205205
module rec Foo3 : sig
@@ -322,7 +322,7 @@ module type S3_2 = sig type t [@@immediate] end
322322
Line 5, characters 30-46:
323323
5 | module type S3_2' = S3_2 with type t := string;;
324324
^^^^^^^^^^^^^^^^
325-
Error: This type has layout value, which is not a sublayout of immediate.
325+
Error: Type string has layout value, which is not a sublayout of immediate.
326326
|}]
327327

328328
(*****************************************)

‎ocaml/toplevel/genprintval.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -368,9 +368,9 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
368368
try
369369
let decl = Env.find_type path env in
370370
match decl with
371-
| {type_kind = Type_abstract _; type_manifest = None} ->
371+
| {type_kind = Type_abstract; type_manifest = None} ->
372372
Oval_stuff "<abstr>"
373-
| {type_kind = Type_abstract _; type_manifest = Some body} ->
373+
| {type_kind = Type_abstract; type_manifest = Some body} ->
374374
tree_of_val depth obj
375375
(instantiate_type env decl.type_params ty_list body)
376376
| {type_kind = Type_variant (constr_list,rep)} ->
@@ -415,7 +415,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
415415
in
416416
let unbx =
417417
match rep with
418-
| Variant_unboxed _ -> true
418+
| Variant_unboxed -> true
419419
| Variant_boxed _ | Variant_extensible -> false
420420
in
421421
begin
@@ -453,7 +453,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
453453
| _ -> 0
454454
in
455455
let unbx =
456-
match rep with Record_unboxed _ -> true | _ -> false
456+
match rep with Record_unboxed -> true | _ -> false
457457
in
458458
tree_of_record_fields depth
459459
env path decl.type_params ty_list

‎ocaml/typing/btype.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -325,7 +325,7 @@ let map_type_expr_cstr_args f = function
325325
Cstr_record (List.map (fun d -> {d with ld_type=f d.ld_type}) lbls)
326326

327327
let iter_type_expr_kind f = function
328-
| Type_abstract _ -> ()
328+
| Type_abstract -> ()
329329
| Type_variant (cstrs, _) ->
330330
List.iter
331331
(fun cd ->

0 commit comments

Comments
 (0)