Skip to content

Move layout from Type_abstract to type_declaration #1384

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.

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 7 commits into from
May 19, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
4 changes: 2 additions & 2 deletions backend/cmmgen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -197,8 +197,8 @@ let rec expr_size env = function
| Uprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
sz), _, _) ->
RHS_block (Lambda.alloc_heap, sz)
| Uprim (Pduprecord ((Record_unboxed _
| Record_inlined (_, Variant_unboxed _)),
| Uprim (Pduprecord ((Record_unboxed
| Record_inlined (_, Variant_unboxed)),
_), _, _) ->
assert false
| Uprim (Pduprecord (Record_inlined (_, Variant_extensible), sz), _, _) ->
Expand Down
4 changes: 2 additions & 2 deletions middle_end/flambda2/from_lambda/dissect_letrec.ml
Original file line number Diff line number Diff line change
Expand Up @@ -287,8 +287,8 @@ let rec prepare_letrec (recursive_set : Ident.Set.t)
build_block cl (size + 1) (Normal 0) arg letrec
| Record_float -> build_block cl size Boxed_float arg letrec
| Record_inlined (Extension _, _)
| Record_inlined (Ordinary _, (Variant_unboxed _ | Variant_extensible))
| Record_unboxed _ ->
| Record_inlined (Ordinary _, (Variant_unboxed | Variant_extensible))
| Record_unboxed ->
Misc.fatal_errorf "Unexpected record kind:@ %a" Printlambda.lambda lam)
| None -> dead_code lam letrec)
| Lconst const -> (
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -655,8 +655,8 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list)
length = Targetint_31_63.of_int (num_fields + 1)
}
| Record_inlined (Extension _, _)
| Record_inlined (Ordinary _, (Variant_unboxed _ | Variant_extensible))
| Record_unboxed _ ->
| Record_inlined (Ordinary _, (Variant_unboxed | Variant_extensible))
| Record_unboxed ->
Misc.fatal_errorf "Cannot handle record kind for Pduprecord: %a"
Printlambda.primitive prim
in
Expand Down
4 changes: 2 additions & 2 deletions ocaml/asmcomp/cmmgen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -171,8 +171,8 @@ let rec expr_size env = function
| Uprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
sz), _, _) ->
RHS_block (Lambda.alloc_heap, sz)
| Uprim (Pduprecord ((Record_unboxed _
| Record_inlined (_, Variant_unboxed _)),
| Uprim (Pduprecord ((Record_unboxed
| Record_inlined (_, Variant_unboxed)),
_), _, _) ->
assert false
| Uprim (Pduprecord (Record_inlined (_, Variant_extensible), sz), _, _) ->
Expand Down
Binary file modified ocaml/boot/ocamlc
Binary file not shown.
Binary file modified ocaml/boot/ocamllex
Binary file not shown.
6 changes: 3 additions & 3 deletions ocaml/bytecomp/bytegen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -189,7 +189,7 @@ let rec size_of_lambda env = function
when check_recordwith_updates id body ->
begin match kind with
| Record_boxed _ | Record_inlined (_, Variant_boxed _) -> RHS_block size
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) -> assert false
| Record_unboxed | Record_inlined (_, Variant_unboxed) -> assert false
| Record_float -> RHS_floatblock size
| Record_inlined (_, Variant_extensible) -> RHS_block (size + 1)
end
Expand Down Expand Up @@ -226,8 +226,8 @@ let rec size_of_lambda env = function
| Lprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
size), _, _) ->
RHS_block size
| Lprim (Pduprecord ((Record_unboxed _
| Record_inlined (_, Variant_unboxed _)),
| Lprim (Pduprecord ((Record_unboxed
| Record_inlined (_, Variant_unboxed)),
_), _, _) ->
assert false
| Lprim (Pduprecord (Record_inlined (_, Variant_extensible), size), _, _) ->
Expand Down
8 changes: 4 additions & 4 deletions ocaml/lambda/matching.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1801,7 +1801,7 @@ let get_expr_args_constr ~scopes head (arg, _mut, layout) rem =
match cstr.cstr_repr with
| Variant_boxed _ ->
make_field_accesses Alias 0 (cstr.cstr_arity - 1) rem
| Variant_unboxed _ -> (arg, Alias, layout) :: rem
| Variant_unboxed -> (arg, Alias, layout) :: rem
| Variant_extensible -> make_field_accesses Alias 1 cstr.cstr_arity rem

let divide_constructor ~scopes ctx pm =
Expand Down Expand Up @@ -2118,8 +2118,8 @@ let get_expr_args_record ~scopes head (arg, _mut, layout) rem =
| Record_boxed _
| Record_inlined (_, Variant_boxed _) ->
Lprim (Pfield (lbl.lbl_pos, sem), [ arg ], loc), layout_field
| Record_unboxed _
| Record_inlined (_, Variant_unboxed _) -> arg, layout
| Record_unboxed
| Record_inlined (_, Variant_unboxed) -> arg, layout
| Record_float ->
(* TODO: could optimise to Alloc_local sometimes *)
Lprim (Pfloatfield (lbl.lbl_pos, sem, alloc_heap), [ arg ], loc),
Expand Down Expand Up @@ -2831,7 +2831,7 @@ let split_cases tag_lambda_list =
| ({cstr_tag; cstr_repr; cstr_constant}, act) :: rem -> (
let consts, nonconsts = split_rec rem in
match cstr_tag, cstr_repr with
| Ordinary _, Variant_unboxed _ -> (consts, (0, act) :: nonconsts)
| Ordinary _, Variant_unboxed -> (consts, (0, act) :: nonconsts)
| Ordinary {runtime_tag}, Variant_boxed _ when cstr_constant ->
((runtime_tag, act) :: consts, nonconsts)
| Ordinary {runtime_tag}, Variant_boxed _ ->
Expand Down
2 changes: 1 addition & 1 deletion ocaml/lambda/printlambda.ml
Original file line number Diff line number Diff line change
Expand Up @@ -179,7 +179,7 @@ let print_bigarray name unsafe kind ppf layout =
| Pbigarray_fortran_layout -> "Fortran")

let record_rep ppf r = match r with
| Record_unboxed _ -> fprintf ppf "unboxed"
| Record_unboxed -> fprintf ppf "unboxed"
| Record_boxed _ -> fprintf ppf "boxed"
| Record_inlined _ -> fprintf ppf "inlined"
| Record_float -> fprintf ppf "float"
Expand Down
18 changes: 9 additions & 9 deletions ocaml/lambda/translcore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -468,7 +468,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
(* CR layouts v5: This could have void args, but for now we've ruled
that out with the layout check in transl_list_with_shape *)
Lconst(const_int runtime_tag)
| Ordinary _, Variant_unboxed _ ->
| Ordinary _, Variant_unboxed ->
(match ll with [v] -> v | _ -> assert false)
| Ordinary {runtime_tag}, Variant_boxed _ ->
begin try
Expand All @@ -491,7 +491,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
Lprim(Pmakeblock(0, Immutable, Some (Pgenval :: shape),
transl_alloc_mode (Option.get alloc_mode)),
lam :: ll, of_location ~scopes e.exp_loc)
| Extension _, (Variant_boxed _ | Variant_unboxed _)
| Extension _, (Variant_boxed _ | Variant_unboxed)
| Ordinary _, Variant_extensible -> assert false
end
| Texp_extension_constructor (_, path) ->
Expand Down Expand Up @@ -526,7 +526,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
Lprim (Pfield (lbl.lbl_pos, 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 mode = transl_alloc_mode (Option.get alloc_mode) in
Lprim (Pfloatfield (lbl.lbl_pos, sem, mode), [targ],
Expand All @@ -545,7 +545,7 @@ and transl_exp0 ~in_new_scope ~scopes e =
Record_boxed _
| Record_inlined (_, 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_inlined (_, Variant_extensible) ->
Expand Down Expand Up @@ -1412,7 +1412,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
match repres with
Record_boxed _ | Record_inlined (_, Variant_boxed _) ->
Pfield (i, sem)
| Record_unboxed _ | Record_inlined (_, Variant_unboxed _) ->
| Record_unboxed | Record_inlined (_, Variant_unboxed) ->
assert false
| Record_inlined (_, Variant_extensible) -> Pfield (i + 1, sem)
| Record_float ->
Expand Down Expand Up @@ -1440,7 +1440,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
| Record_boxed _ -> Lconst(Const_block(0, cl))
| Record_inlined (Ordinary {runtime_tag}, 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))
Expand All @@ -1455,15 +1455,15 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
| Record_inlined (Ordinary {runtime_tag}, Variant_boxed _) ->
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_inlined (Extension (path, _), Variant_extensible) ->
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 (Extension _, (Variant_unboxed | Variant_boxed _))
| Record_inlined (Ordinary _, Variant_extensible) ->
assert false
in
Expand All @@ -1489,7 +1489,7 @@ and transl_record ~scopes loc env mode fields repres opt_init_expr =
Record_boxed _ | Record_inlined (_, 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)
Expand Down
2 changes: 1 addition & 1 deletion ocaml/ocamldoc/odoc_sig.ml
Original file line number Diff line number Diff line change
Expand Up @@ -372,7 +372,7 @@ module Analyser =

let get_type_kind env name_comment_list type_kind =
match type_kind with
Types.Type_abstract _ ->
Types.Type_abstract ->
Odoc_type.Type_abstract
| Types.Type_variant (l,_) ->
let f {Types.cd_id=constructor_name;cd_args;cd_res=ret_type} =
Expand Down
12 changes: 5 additions & 7 deletions ocaml/testsuite/tests/typing-immediate/immediate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,7 @@ end;;
Line 2, characters 2-31:
2 | type t = string [@@immediate]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This type has layout value, which is not a sublayout of immediate.
Error: Type string has layout value, which is not a sublayout of immediate.
|}];;

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

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

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

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


Expand Down
17 changes: 17 additions & 0 deletions ocaml/testsuite/tests/typing-layouts/datatypes_alpha.ml
Original file line number Diff line number Diff line change
Expand Up @@ -284,3 +284,20 @@ Error: This expression has type float but an expression was expected of type
('a : immediate)
float has layout value, which is not a sublayout of immediate.
|}];;

(*****************************************************)
(* Test 7: Recursive propagation of immediacy checks *)

(* See Note [Default layouts in transl_declaration] in Typedecl. *)
type t7 = A | B | C | D of t7_void
and t7_2 = { x : t7 } [@@unboxed]
and t7_void [@@void]

type t7_3 = t7_2 [@@immediate]

[%%expect{|
type t7 = A | B | C | D of t7_void
and t7_2 = { x : t7; } [@@unboxed]
and t7_void [@@void]
type t7_3 = t7_2 [@@immediate]
|}]
4 changes: 2 additions & 2 deletions ocaml/testsuite/tests/typing-layouts/modules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -128,7 +128,7 @@ end;;
Line 2, characters 2-31:
2 | type t = Bar3.t [@@immediate]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This type has layout value, which is not a sublayout of immediate.
Error: Type Bar3.t has layout value, which is not a sublayout of immediate.
|}];;

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

(*****************************************)
Expand Down
6 changes: 3 additions & 3 deletions ocaml/testsuite/tests/typing-layouts/modules_alpha.ml
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ module type S1'' = S1 with type s = t_void;;
Line 1, characters 27-42:
1 | module type S1'' = S1 with type s = t_void;;
^^^^^^^^^^^^^^^
Error: This type has layout void, which is not a sublayout of value.
Error: Type t_void has layout void, which is not a sublayout of value.
|}]

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

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

(*****************************************)
Expand Down
4 changes: 2 additions & 2 deletions ocaml/testsuite/tests/typing-layouts/modules_beta.ml
Original file line number Diff line number Diff line change
Expand Up @@ -199,7 +199,7 @@ end;;
Line 2, characters 2-31:
2 | type t = Bar3.t [@@immediate]
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This type has layout value, which is not a sublayout of immediate.
Error: Type Bar3.t has layout value, which is not a sublayout of immediate.
|}];;

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

(*****************************************)
Expand Down
8 changes: 4 additions & 4 deletions ocaml/toplevel/genprintval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -368,9 +368,9 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
try
let decl = Env.find_type path env in
match decl with
| {type_kind = Type_abstract _; type_manifest = None} ->
| {type_kind = Type_abstract; type_manifest = None} ->
Oval_stuff "<abstr>"
| {type_kind = Type_abstract _; type_manifest = Some body} ->
| {type_kind = Type_abstract; type_manifest = Some body} ->
tree_of_val depth obj
(instantiate_type env decl.type_params ty_list body)
| {type_kind = Type_variant (constr_list,rep)} ->
Expand Down Expand Up @@ -415,7 +415,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
in
let unbx =
match rep with
| Variant_unboxed _ -> true
| Variant_unboxed -> true
| Variant_boxed _ | Variant_extensible -> false
in
begin
Expand Down Expand Up @@ -453,7 +453,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type valu = O.t) = struct
| _ -> 0
in
let unbx =
match rep with Record_unboxed _ -> true | _ -> false
match rep with Record_unboxed -> true | _ -> false
in
tree_of_record_fields depth
env path decl.type_params ty_list
Expand Down
2 changes: 1 addition & 1 deletion ocaml/typing/btype.ml
Original file line number Diff line number Diff line change
Expand Up @@ -325,7 +325,7 @@ let map_type_expr_cstr_args f = function
Cstr_record (List.map (fun d -> {d with ld_type=f d.ld_type}) lbls)

let iter_type_expr_kind f = function
| Type_abstract _ -> ()
| Type_abstract -> ()
| Type_variant (cstrs, _) ->
List.iter
(fun cd ->
Expand Down
Loading