Clean up Record_inlined.

There's now no global set of optional fields stored anywhere, but optional is attached to each field.

Author: cristianoc

compiler/core/js_dump.ml

@@ -794,28 +794,23 @@ and expression_desc cxt ~(level : int) f x : cxt =
     let untagged = Ast_untagged_variants.process_untagged p.attrs in
     let objs =
       let tails =
-        Ext_list.combine_array_append p.fields el
-          (if !Js_config.debug then [(name_symbol, E.str p.name)] else [])
-          (fun i -> Js_op.Lit i)
-      in
-      let is_optional (pname : Js_op.property_name) =
-        match pname with
-        | Lit n -> Ext_list.mem_string p.optional_labels n
-        | Symbol_name -> false
+        Ext_list.combine_array p.fields el (fun (i, opt) -> (Js_op.Lit i, opt))
       in
+      (* let is_optional (pname : Js_op.property_name) =
+           match pname with
+           | Lit n -> Ext_list.mem_string p.optional_labels n
+           | Symbol_name -> false
+         in *)
       let tag_name =
         match Ast_untagged_variants.process_tag_name p.attrs with
         | None -> L.tag
         | Some s -> s
       in
       let tails =
-        match p.optional_labels with
-        | [] -> tails
-        | _ ->
-          Ext_list.filter_map tails (fun (f, x) ->
-              match x.expression_desc with
-              | Undefined _ when is_optional f -> None
-              | _ -> Some (f, x))
+        Ext_list.filter_map tails (fun ((f, optional), x) ->
+            match x.expression_desc with
+            | Undefined _ when optional -> None
+            | _ -> Some (f, x))
       in
       if untagged then tails
       else

compiler/core/lam_compile.ml

@@ -427,7 +427,7 @@ let compile output_prefix =
                       (match tag_info with
                       | Blk_record {fields = xs} -> Fld_record_set xs.(i)
                       | Blk_record_inlined xs ->
-                        Fld_record_inline_set xs.fields.(i)
+                        Fld_record_inline_set (fst xs.fields.(i))
                       | Blk_constructor p -> (
                         let is_cons = p.name = Literals.cons in
                         match (is_cons, i) with

compiler/ml/datarepr.ml

@@ -128,13 +128,6 @@ let constructor_descrs ty_path decl cstrs =
             describe_constructors idx_const (idx_nonconst + 1) rem )
       in
       let cstr_name = Ident.name cd_id in
-      let optional_labels =
-        match cd_args with
-        | Cstr_tuple _ -> []
-        | Cstr_record lbls ->
-          Ext_list.filter_map lbls (fun {ld_id; ld_optional} ->
-              if ld_optional then Some ld_id.name else None)
-      in
       let existentials, cstr_args, cstr_inlined =
         let representation =
           if decl.type_unboxed.unboxed then Record_unboxed true
@@ -144,7 +137,6 @@ let constructor_descrs ty_path decl cstrs =
                 tag = idx_nonconst;
                 name = cstr_name;
                 num_nonconsts = !num_nonconsts;
-                optional_labels;
                 attrs = cd_attributes;
               }
         in

compiler/ml/lambda.ml

@@ -28,8 +28,7 @@ type tag_info =
       name: string;
       num_nonconst: int;
       tag: int;
-      optional_labels: string list;
-      fields: string array;
+      fields: (string * bool (* optional *)) array;
       mutable_flag: Asttypes.mutable_flag;
       attrs: Parsetree.attributes;
     }
@@ -104,16 +103,15 @@ let blk_record_ext fields mutable_flag =
   in
   Blk_record_ext {fields = all_labels_info; mutable_flag}
 
-let blk_record_inlined fields name num_nonconst optional_labels ~tag ~attrs
-    mutable_flag =
+let blk_record_inlined fields name num_nonconst ~tag ~attrs mutable_flag =
   let fields =
     Array.map
       (fun ((lbl : label), _) ->
-        Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
+        ( Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name,
+          lbl.lbl_optional ))
       fields
   in
-  Blk_record_inlined
-    {fields; name; num_nonconst; tag; mutable_flag; optional_labels; attrs}
+  Blk_record_inlined {fields; name; num_nonconst; tag; mutable_flag; attrs}
 
 let ref_tag_info : tag_info =
   Blk_record

compiler/ml/lambda.mli

@@ -32,8 +32,7 @@ type tag_info =
       name: string;
       num_nonconst: int;
       tag: int;
-      optional_labels: string list;
-      fields: string array;
+      fields: (string * bool (* optional *)) array;
       mutable_flag: mutable_flag;
       attrs: Parsetree.attributes;
     }
@@ -81,7 +80,6 @@ val blk_record_inlined :
   (Types.label_description * Typedtree.record_label_definition) array ->
   string ->
   int ->
-  string list ->
   tag:int ->
   attrs:Parsetree.attributes ->
   mutable_flag ->

compiler/ml/printlambda.ml

@@ -104,7 +104,7 @@ let print_taginfo ppf = function
   | Blk_lazy_general -> fprintf ppf "lazy_general"
   | Blk_module_export _ -> fprintf ppf "module/exports"
   | Blk_record_inlined {fields = ss} ->
-    fprintf ppf "[%s]" (String.concat ";" (Array.to_list ss))
+    fprintf ppf "[%s]" (String.concat ";" (List.map fst (Array.to_list ss)))
 
 let primitive ppf = function
   | Pidentity -> fprintf ppf "id"

compiler/ml/translcore.ml

@@ -1217,11 +1217,11 @@ and transl_record loc env fields repres opt_init_expr =
           | Record_optional_labels ->
             Lconst
               (Const_block (Lambda.blk_record fields mut Record_optional, cl))
-          | Record_inlined {tag; name; num_nonconsts; optional_labels; attrs} ->
+          | Record_inlined {tag; name; num_nonconsts; attrs} ->
             Lconst
               (Const_block
-                 ( Lambda.blk_record_inlined fields name num_nonconsts
-                     optional_labels ~tag ~attrs mut,
+                 ( Lambda.blk_record_inlined fields name num_nonconsts ~tag
+                     ~attrs mut,
                    cl ))
           | Record_unboxed _ ->
             Lconst
@@ -1240,11 +1240,11 @@ and transl_record loc env fields repres opt_init_expr =
                 ll,
                 loc )
           | Record_float_unused -> assert false
-          | Record_inlined {tag; name; num_nonconsts; optional_labels; attrs} ->
+          | Record_inlined {tag; name; num_nonconsts; attrs} ->
             Lprim
               ( Pmakeblock
-                  (Lambda.blk_record_inlined fields name num_nonconsts
-                     optional_labels ~tag ~attrs mut),
+                  (Lambda.blk_record_inlined fields name num_nonconsts ~tag
+                     ~attrs mut),
                 ll,
                 loc )
           | Record_unboxed _ -> (

compiler/ml/types.ml

@@ -153,7 +153,6 @@ and record_representation =
       tag: int;
       name: string;
       num_nonconsts: int;
-      optional_labels: string list;
       attrs: Parsetree.attributes;
     }
   | Record_extension (* Inlined record under extension *)
@@ -315,12 +314,10 @@ let same_record_representation x y =
     match y with
     | Record_optional_labels -> true
     | _ -> false)
-  | Record_inlined {tag; name; num_nonconsts; optional_labels} -> (
+  | Record_inlined {tag; name; num_nonconsts} -> (
     match y with
     | Record_inlined y ->
-      tag = y.tag && name = y.name
-      && num_nonconsts = y.num_nonconsts
-      && optional_labels = y.optional_labels
+      tag = y.tag && name = y.name && num_nonconsts = y.num_nonconsts
     | _ -> false)
   | Record_extension -> y = Record_extension
   | Record_unboxed x -> (

compiler/ml/types.mli

@@ -281,7 +281,6 @@ and record_representation =
       tag: int;
       name: string;
       num_nonconsts: int;
-      optional_labels: string list;
       attrs: Parsetree.attributes;
     }
   | Record_extension (* Inlined record under extension *)