Move layout from Type_abstract to type_declaration

backend/cmmgen.ml

@@ -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), _, _) ->

middle_end/flambda2/from_lambda/dissect_letrec.ml

@@ -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 -> (

middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

@@ -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

ocaml/asmcomp/cmmgen.ml

@@ -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), _, _) ->

ocaml/bytecomp/bytegen.ml

@@ -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
@@ -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), _, _) ->

ocaml/lambda/matching.ml

@@ -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 =
@@ -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),
@@ -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 _ ->

ocaml/lambda/printlambda.ml

@@ -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"

ocaml/lambda/translcore.ml

@@ -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
@@ -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) ->
@@ -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],
@@ -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) ->
@@ -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 ->
@@ -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))
@@ -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
@@ -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)

ocaml/ocamldoc/odoc_sig.ml

@@ -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} =

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

@@ -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) *)
@@ -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) *)
@@ -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 *)
@@ -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 *)
@@ -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.
 |}];;
 
 

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

@@ -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]
+|}]

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

@@ -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
@@ -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.
 |}]
 
 (*****************************************)

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

@@ -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
@@ -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
@@ -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.
 |}]
 
 (*****************************************)

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

@@ -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
@@ -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.
 |}]
 
 (*****************************************)

ocaml/toplevel/genprintval.ml

@@ -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)} ->
@@ -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
@@ -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

ocaml/typing/btype.ml

@@ -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 ->