Add support for annotating types with layouts.

asmcomp/cmmgen.ml

@@ -152,11 +152,14 @@ let rec expr_size env = function
      (* Pgenarray is excluded from recursive bindings by the
         check in Translcore.check_recursive_lambda *)
      RHS_nonrec
-  | Uprim (Pduprecord ((Record_regular | Record_inlined _), sz), _, _) ->
+  | Uprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
+                       sz), _, _) ->
       RHS_block sz
-  | Uprim (Pduprecord (Record_unboxed _, _), _, _) ->
+  | Uprim (Pduprecord ((Record_unboxed _
+                       | Record_inlined (_, Variant_unboxed _)),
+                       _), _, _) ->
       assert false
-  | Uprim (Pduprecord (Record_extension _, sz), _, _) ->
+  | Uprim (Pduprecord (Record_inlined (_, Variant_extensible), sz), _, _) ->
       RHS_block (sz + 1)
   | Uprim (Pduprecord (Record_float, sz), _, _) ->
       RHS_floatblock sz

bytecomp/bytegen.ml

@@ -185,10 +185,10 @@ let rec size_of_lambda env = function
   | Llet (Strict, _k, id, Lprim (Pduprecord (kind, size), _, _), body)
     when check_recordwith_updates id body ->
       begin match kind with
-      | Record_regular | Record_inlined _ -> RHS_block size
-      | Record_unboxed _ -> assert false
+      | Record_boxed _ | Record_inlined (_, Variant_boxed _) -> RHS_block size
+      | Record_unboxed _ | Record_inlined (_, Variant_unboxed _) -> assert false
       | Record_float -> RHS_floatblock size
-      | Record_extension _ -> RHS_block (size + 1)
+      | Record_inlined (_, Variant_extensible) -> RHS_block (size + 1)
       end
   | Llet(_str, _k, id, arg, body) ->
       size_of_lambda (Ident.add id (size_of_lambda env arg) env) body
@@ -220,11 +220,14 @@ let rec size_of_lambda env = function
      (* Pgenarray is excluded from recursive bindings by the
         check in Translcore.check_recursive_lambda *)
       RHS_nonrec
-  | Lprim (Pduprecord ((Record_regular | Record_inlined _), size), _, _) ->
+  | Lprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
+                       size), _, _) ->
       RHS_block size
-  | Lprim (Pduprecord (Record_unboxed _, _), _, _) ->
+  | Lprim (Pduprecord ((Record_unboxed _
+                       | Record_inlined (_, Variant_unboxed _)),
+           _), _, _) ->
       assert false
-  | Lprim (Pduprecord (Record_extension _, size), _, _) ->
+  | Lprim (Pduprecord (Record_inlined (_, Variant_extensible), size), _, _) ->
       RHS_block (size + 1)
   | Lprim (Pduprecord (Record_float, size), _, _) -> RHS_floatblock size
   | Levent (lam, _) -> size_of_lambda env lam

compilerlibs/Makefile.compilerlibs

@@ -79,9 +79,9 @@ PARSING_CMI = \
 TYPING = \
   typing/path.cmo \
   typing/primitive.cmo \
-  typing/type_immediacy.cmo \
   typing/shape.cmo \
   typing/types.cmo \
+  typing/type_layout.cmo \
   typing/btype.cmo \
   typing/oprint.cmo \
   typing/subst.cmo \
@@ -114,8 +114,6 @@ TYPING = \
   typing/parmatch.cmo \
   typing/typedecl_properties.cmo \
   typing/typedecl_variance.cmo \
-  typing/typedecl_unboxed.cmo \
-  typing/typedecl_immediacy.cmo \
   typing/typedecl_separability.cmo \
   lambda/debuginfo.cmo lambda/lambda.cmo \
   typing/typedecl.cmo \

debugger/loadprinter.ml

@@ -104,15 +104,15 @@ let match_printer_type desc typename =
   let printer_type =
     match
       Env.find_type_by_name
-        (Ldot(Lident "Topdirs", typename)) Env.empty
+        (Ldot(Lident "Topdirs", typename)) Env.initial_safe_string
     with
     | path, _ -> path
     | exception Not_found ->
         raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename))))
   in
   Ctype.begin_def();
-  let ty_arg = Ctype.newvar() in
-  Ctype.unify Env.empty
+  let ty_arg = Ctype.newvar Type_layout.any in
+  Ctype.unify Env.initial_safe_string
     (Ctype.newconstr printer_type [ty_arg])
     (Ctype.instance desc.val_type);
   Ctype.end_def();

debugger/pattern_matching.ml

@@ -225,7 +225,7 @@ and match_concrete_type pattern obj cstr ty ty_list =
                filter (ty_res, ty)
              with Unify ->
                fatal_error "pattern_matching: types should match");
-            pattern_matching patt (Debugcom.get_field obj lbl.info.lbl_pos)
+            pattern_matching patt (Debugcom.get_field obj lbl.info.lbl_num)
                              ty_arg
       in
         (match pattern with

dune

@@ -74,14 +74,14 @@
 
    ;; TYPING
    ident path primitive shape types btype oprint subst predef datarepr
-   cmi_format persistent_env env type_immediacy errortrace
+   cmi_format persistent_env env type_layout errortrace
    typedtree printtyped ctype printtyp includeclass mtype envaux includecore
    tast_iterator tast_mapper signature_group cmt_format untypeast
    includemod includemod_errorprinter
    typetexp patterns printpat parmatch stypes typedecl typeopt rec_check
    typecore
-   typeclass typemod typedecl_variance typedecl_properties typedecl_immediacy
-   typedecl_unboxed typedecl_separability cmt2annot
+   typeclass typemod typedecl_variance typedecl_properties
+   typedecl_separability cmt2annot
    ; manual update: mli only files
    annot outcometree
 
@@ -278,7 +278,7 @@
     (cmi_format.mli as compiler-libs/cmi_format.mli)
     (persistent_env.mli as compiler-libs/persistent_env.mli)
     (env.mli as compiler-libs/env.mli)
-    (type_immediacy.mli as compiler-libs/type_immediacy.mli)
+    (type_layout.mli as compiler-libs/type_layout.mli)
     (typedtree.mli as compiler-libs/typedtree.mli)
     (printtyped.mli as compiler-libs/printtyped.mli)
     (ctype.mli as compiler-libs/ctype.mli)
@@ -304,8 +304,6 @@
     (typemod.mli as compiler-libs/typemod.mli)
     (typedecl_variance.mli as compiler-libs/typedecl_variance.mli)
     (typedecl_properties.mli as compiler-libs/typedecl_properties.mli)
-    (typedecl_immediacy.mli as compiler-libs/typedecl_immediacy.mli)
-    (typedecl_unboxed.mli as compiler-libs/typedecl_unboxed.mli)
     (typedecl_separability.mli as compiler-libs/typedecl_separability.mli)
     (annot.mli as compiler-libs/annot.mli)
     (outcometree.mli as compiler-libs/outcometree.mli)

lambda/lambda.ml

@@ -1115,11 +1115,10 @@ let map f =
   g
 
 (* To let-bind expressions to variables *)
-
-let bind_with_value_kind str (var, kind) exp body =
+let bind_with_value_kind let_kind (var, kind) exp body =
   match exp with
     Lvar var' when Ident.same var var' -> body
-  | _ -> Llet(str, kind, var, exp, body)
+  | _ -> Llet(let_kind, kind, var, exp, body)
 
 let bind str var exp body =
   bind_with_value_kind str (var, Pgenval) exp body

lambda/lambda.mli

@@ -192,6 +192,9 @@ and float_comparison =
 and array_kind =
     Pgenarray | Paddrarray | Pintarray | Pfloatarray
 
+(* We sometimes use [Pintval] for voids in lambda terms, but only in places the
+   control flow will never actually reach - see the comment on
+   [value_kind_if_not_void] in translcore. *)
 and value_kind =
     Pgenval | Pfloatval | Pboxedintval of boxed_integer | Pintval
   | Pvariant of {