Remove Record_optional_labels entirely.

Author: cristianoc

compiler/ml/ctype.ml

@@ -3721,8 +3721,7 @@ let rec subtype_rec env trace t1 t2 cstrs =
             (_, _, {type_kind = Type_record (fields2, repr2)}) ) ->
           let same_repr =
             match (repr1, repr2) with
-            | ( (Record_regular | Record_optional_labels),
-                (Record_regular | Record_optional_labels) ) ->
+            | Record_regular, Record_regular ->
               true (* handled in the fields checks *)
             | Record_unboxed b1, Record_unboxed b2 -> b1 = b2
             | Record_inlined _, Record_inlined _ -> repr1 = repr2

compiler/ml/matching.ml

@@ -1530,7 +1530,7 @@ let make_record_matching loc all_labels def = function
         let access =
           match lbl.lbl_repres with
           | Record_float_unused -> assert false
-          | Record_regular | Record_optional_labels ->
+          | Record_regular ->
             Lprim (Pfield (lbl.lbl_pos, Lambda.fld_record lbl), [arg], loc)
           | Record_inlined _ ->
             Lprim

compiler/ml/predef.ml

@@ -316,7 +316,7 @@ let common_initial_env add_type add_extension empty_env =
                 ld_type = newgenty (Tconstr (path_option, [tvar], ref Mnil));
               };
             ],
-            Record_optional_labels );
+            Record_regular );
     }
   and decl_uncurried =
     let tvar1, tvar2 = (newgenvar (), newgenvar ()) in

compiler/ml/printtyped.ml

@@ -130,7 +130,6 @@ let record_representation i ppf =
   function
   | Record_regular -> line i ppf "Record_regular\n"
   | Record_float_unused -> assert false
-  | Record_optional_labels -> line i ppf "Record_optional_labels\n"
   | Record_unboxed b -> line i ppf "Record_unboxed %b\n" b
   | Record_inlined {tag = i} -> line i ppf "Record_inlined %d\n" i
   | Record_extension -> line i ppf "Record_extension\n"

compiler/ml/rec_check.ml

@@ -261,9 +261,7 @@ let rec expression : Env.env -> Typedtree.expression -> Use.t =
       match rep with
       | Record_unboxed _ -> fun x -> x
       | Record_float_unused -> assert false
-      | Record_optional_labels | Record_regular | Record_inlined _
-      | Record_extension ->
-        Use.guard
+      | Record_regular | Record_inlined _ | Record_extension -> Use.guard
     in
     let field env = function
       | _, Kept _ -> Use.empty

compiler/ml/translcore.ml

@@ -923,7 +923,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
     let targ = transl_exp arg in
     match lbl.lbl_repres with
     | Record_float_unused -> assert false
-    | Record_regular | Record_optional_labels ->
+    | Record_regular ->
       Lprim (Pfield (lbl.lbl_pos, Lambda.fld_record lbl), [targ], e.exp_loc)
     | Record_inlined _ ->
       Lprim
@@ -938,8 +938,7 @@ and transl_exp0 (e : Typedtree.expression) : Lambda.lambda =
     let access =
       match lbl.lbl_repres with
       | Record_float_unused -> assert false
-      | Record_regular | Record_optional_labels ->
-        Psetfield (lbl.lbl_pos, Lambda.fld_record_set lbl)
+      | Record_regular -> Psetfield (lbl.lbl_pos, Lambda.fld_record_set lbl)
       | Record_inlined _ ->
         Psetfield (lbl.lbl_pos, Lambda.fld_record_inline_set lbl)
       | Record_unboxed _ -> assert false
@@ -1159,6 +1158,7 @@ and transl_record loc env fields repres opt_init_expr =
     else lambda
   | _ -> (
     let size = Array.length fields in
+    let optional = Ext_array.exists fields (fun (ld, _) -> ld.lbl_optional) in
     (* Determine if there are "enough" fields (only relevant if this is a
        functional-style record update *)
     let no_init =
@@ -1167,12 +1167,7 @@ and transl_record loc env fields repres opt_init_expr =
       | _ -> false
     in
     if
-      no_init
-      || size < 20
-         &&
-         match repres with
-         | Record_optional_labels -> false
-         | _ -> true
+      no_init || (size < 20 && not optional)
       (* TODO: More strategies
          3 + 2 * List.length lbl_expr_list >= size (density)
       *)
@@ -1188,8 +1183,7 @@ and transl_record loc env fields repres opt_init_expr =
               let access =
                 match repres with
                 | Record_float_unused -> assert false
-                | Record_regular | Record_optional_labels ->
-                  Pfield (i, Lambda.fld_record lbl)
+                | Record_regular -> Pfield (i, Lambda.fld_record lbl)
                 | Record_inlined _ -> Pfield (i, Lambda.fld_record_inline lbl)
                 | Record_unboxed _ -> assert false
                 | Record_extension ->
@@ -1213,10 +1207,10 @@ and transl_record loc env fields repres opt_init_expr =
           | Record_float_unused -> assert false
           | Record_regular ->
             Lconst
-              (Const_block (Lambda.blk_record fields mut Record_regular, cl))
-          | Record_optional_labels ->
-            Lconst
-              (Const_block (Lambda.blk_record fields mut Record_optional, cl))
+              (Const_block
+                 ( Lambda.blk_record fields mut
+                     (if optional then Record_optional else Record_regular),
+                   cl ))
           | Record_inlined {tag; name; num_nonconsts; attrs} ->
             Lconst
               (Const_block
@@ -1233,10 +1227,9 @@ and transl_record loc env fields repres opt_init_expr =
           match repres with
           | Record_regular ->
             Lprim
-              (Pmakeblock (Lambda.blk_record fields mut Record_regular), ll, loc)
-          | Record_optional_labels ->
-            Lprim
-              ( Pmakeblock (Lambda.blk_record fields mut Record_optional),
+              ( Pmakeblock
+                  (Lambda.blk_record fields mut
+                     (if optional then Record_optional else Record_regular)),
                 ll,
                 loc )
           | Record_float_unused -> assert false
@@ -1277,7 +1270,7 @@ and transl_record loc env fields repres opt_init_expr =
           let upd =
             match repres with
             | Record_float_unused -> assert false
-            | Record_regular | Record_optional_labels ->
+            | Record_regular ->
               Psetfield (lbl.lbl_pos, Lambda.fld_record_set lbl)
             | Record_inlined _ ->
               Psetfield (lbl.lbl_pos, Lambda.fld_record_inline_set lbl)

compiler/ml/typecore.ml

@@ -949,7 +949,7 @@ module Label = NameChoice (struct
         lbl with
         lbl_name = name;
         lbl_pos = Array.length lbl.lbl_all;
-        lbl_repres = Record_optional_labels;
+        lbl_repres = Record_regular;
       }
     in
     let lbl_all_list = Array.to_list lbl.lbl_all @ [l] in
@@ -2651,7 +2651,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp
                    } ));
         ([||], representation)
       | [], _ ->
-        if fields = [] && repr_opt <> None then ([||], Record_optional_labels)
+        if fields = [] && repr_opt <> None then ([||], Record_regular)
         else raise (Error (loc, env, Empty_record_literal))
     in
     let labels_missing = ref [] in

compiler/ml/typedecl.ml

@@ -635,7 +635,7 @@ let transl_declaration ~type_record_as_object env sdecl id =
           Type_record
             ( lbls',
               if unbox then Record_unboxed false
-              else if optional then Record_optional_labels
+              else if optional then Record_regular
               else Record_regular ),
           sdecl )
       | None ->

compiler/ml/types.ml

@@ -156,7 +156,6 @@ and record_representation =
       attrs: Parsetree.attributes;
     }
   | Record_extension (* Inlined record under extension *)
-  | Record_optional_labels
 
 and label_declaration = {
   ld_id: Ident.t;
@@ -310,10 +309,6 @@ let same_record_representation x y =
   match x with
   | Record_regular -> y = Record_regular
   | Record_float_unused -> y = Record_float_unused
-  | Record_optional_labels -> (
-    match y with
-    | Record_optional_labels -> true
-    | _ -> false)
   | Record_inlined {tag; name; num_nonconsts} -> (
     match y with
     | Record_inlined y ->

compiler/ml/types.mli

@@ -284,7 +284,6 @@ and record_representation =
       attrs: Parsetree.attributes;
     }
   | Record_extension (* Inlined record under extension *)
-  | Record_optional_labels
 
 and label_declaration = {
   ld_id: Ident.t;