Improve obj dup using spread syntax (#7043)

cometkim · web-flow · commit 7a722a12755a · 2024-09-21T02:43:05.000+09:00
* obj_dup by spread syntax

* add changelog
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -26,6 +26,7 @@
 - Improve bigint literal comparison. https://github.com/rescript-lang/rescript-compiler/pull/7029
 - Improve output of `@variadic` bindings. https://github.com/rescript-lang/rescript-compiler/pull/7030
 - Improve error messages around JSX components. https://github.com/rescript-lang/rescript-compiler/pull/7038
+- Improve output of record copying. https://github.com/rescript-lang/rescript-compiler/pull/7043
 
 # 12.0.0-alpha.3
 
diff --git a/jscomp/core/j.ml b/jscomp/core/j.ml
@@ -159,7 +159,7 @@ and expression_desc =
      last step since "|0" can potentially be optimized
   *)
   | Number of number
-  | Object of property_map
+  | Object of expression option * property_map
   | Undefined of {is_unit: bool}
   | Null
   | Await of expression
diff --git a/jscomp/core/js_analyzer.ml b/jscomp/core/js_analyzer.ml
@@ -99,7 +99,7 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
       *)
       Ext_list.for_all xs no_side_effect
   | Optional_block (x, _) -> no_side_effect x
-  | Object kvs -> Ext_list.for_all_snd kvs no_side_effect
+  | Object (_, kvs) -> Ext_list.for_all_snd kvs no_side_effect
   | String_append (a, b) | Seq (a, b) -> no_side_effect a && no_side_effect b
   | Length (e, _) | Caml_block_tag (e, _) | Typeof e -> no_side_effect e
   | Bin (op, a, b) -> op <> Eq && no_side_effect a && no_side_effect b
diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml
@@ -109,7 +109,7 @@ let exn_block_as_obj ~(stack : bool) (el : J.expression list) (ext : J.tag_info)
     | _ -> assert false
   in
   Object
-    (if stack then
+    (None, if stack then
      Ext_list.mapi_append el
        (fun i e -> (Js_op.Lit (field_name i), e))
        [ (Js_op.Lit "Error", E.new_ (E.js_global "Error") []) ]
@@ -725,9 +725,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
         else E.runtime_call Js_runtime_modules.option "some" [ e ])
   | Caml_block (el, _, _, Blk_module fields) ->
       expression_desc cxt ~level f
-        (Object
+        (Object (None,
            (Ext_list.map_combine fields el (fun x ->
-                Js_op.Lit (Ext_ident.convert x))))
+                Js_op.Lit (Ext_ident.convert x)))))
   (*name convention of Record is slight different from modules*)
   | Caml_block (el, mutable_flag, _, Blk_record { fields; record_repr }) -> (
       if
@@ -738,24 +738,24 @@ and expression_desc cxt ~(level : int) f x : cxt =
         match record_repr with
         | Record_regular ->
             expression_desc cxt ~level f
-              (Object (Ext_list.combine_array fields el (fun i -> Js_op.Lit i)))
+              (Object (None, Ext_list.combine_array fields el (fun i -> Js_op.Lit i)))
         | Record_optional ->
             let fields =
               Ext_list.array_list_filter_map fields el (fun f x ->
                   match x.expression_desc with
                   | Undefined _ -> None
                   | _ -> Some (Js_op.Lit f, x))
             in
-            expression_desc cxt ~level f (Object fields))
+            expression_desc cxt ~level f (Object (None, fields)))
   | Caml_block (el, _, _, Blk_poly_var _) -> (
       match el with
       | [ tag; value ] ->
           expression_desc cxt ~level f
-            (Object
+            (Object (None,
                [
                  (Js_op.Lit Literals.polyvar_hash, tag);
                  (Lit Literals.polyvar_value, value);
-               ])
+               ]))
       | _ -> assert false)
   | Caml_block (el, _, _, ((Blk_extension | Blk_record_ext _) as ext)) ->
       expression_desc cxt ~level f (exn_block_as_obj ~stack:false el ext)
@@ -793,7 +793,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
             | Some t -> E.tag_type t )
           :: tails
       in
-      expression_desc cxt ~level f (Object objs)
+      expression_desc cxt ~level f (Object (None, objs))
   | Caml_block (el, _, tag, Blk_constructor p) ->
       let not_is_cons = p.name <> Literals.cons in
       let tag_type = Ast_untagged_variants.process_tag_type p.attrs in
@@ -826,7 +826,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
         | [(_, e)] when untagged -> e.expression_desc
         | _ when untagged -> assert false (* should not happen *)
         (* TODO: put restriction on the variant definitions allowed, to make sure this never happens. *)
-        | _ -> J.Object objs in
+        | _ -> J.Object (None, objs) in
       expression_desc cxt ~level f exp
   | Caml_block
       ( _,
@@ -890,7 +890,7 @@ and expression_desc cxt ~(level : int) f x : cxt =
         P.group f 1 (fun _ -> expression ~level:3 cxt f e2)
       in
       if level > 2 then P.paren_vgroup f 1 action else action ()
-  | Object lst ->
+  | Object (dup, lst) ->
       (* #1946 object literal is easy to be
          interpreted as block statement
          here we avoid parens in such case
@@ -899,11 +899,22 @@ and expression_desc cxt ~(level : int) f x : cxt =
          ]}
       *)
       P.cond_paren_group f (level > 1) (fun _ ->
-          if lst = [] then (
-            P.string f "{}";
-            cxt)
+          let dup_expression e =
+            expression ~level:1 cxt f { e with expression_desc = J.Spread e }
+          in
+          if lst = [] then
+            P.brace f (fun _ -> match dup with Some e -> dup_expression e | _ -> cxt)
           else
-            P.brace_vgroup f 1 (fun _ -> property_name_and_value_list cxt f lst))
+            P.brace_vgroup f 1 (fun _ ->
+              let cxt =
+                match dup with
+                | Some e ->
+                  let cxt = dup_expression e in
+                  comma_nl f;
+                  cxt
+                | _ -> cxt
+              in
+              property_name_and_value_list cxt f lst))
   | Await e ->
       P.cond_paren_group f (level > 13) (fun _ ->
           P.string f "await ";
diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml
@@ -251,7 +251,7 @@ let dummy_obj ?comment (info : Lam_tag_info.t) : t =
   match info with
   | Blk_record _ | Blk_module _ | Blk_constructor _ | Blk_record_inlined _
   | Blk_poly_var _ | Blk_extension | Blk_record_ext _ ->
-      { comment; expression_desc = Object [] }
+      { comment; expression_desc = Object (None, []) }
   | Blk_tuple | Blk_module_export _ ->
       { comment; expression_desc = Array ([], Mutable) }
   | Blk_some | Blk_some_not_nested | Blk_lazy_general -> assert false
@@ -563,8 +563,8 @@ let rec string_append ?comment (e : t) (el : t) : t =
       { (concat a b ~delim) with comment }
   | _, _ -> { comment; expression_desc = String_append (e, el) }
 
-let obj ?comment properties : t =
-  { expression_desc = Object properties; comment }
+let obj ?comment ?dup properties : t =
+  { expression_desc = Object (dup, properties); comment }
 
 let str_equal (txt0:string) (delim0:External_arg_spec.delim) txt1 delim1 =
   if delim0 = delim1 then
diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli
@@ -317,7 +317,7 @@ val seq : ?comment:string -> t -> t -> t
 
 val fuse_to_seq : t -> t list -> t
 
-val obj : ?comment:string -> J.property_map -> t
+val obj : ?comment:string -> ?dup:J.expression -> J.property_map -> t
 
 val true_ : t
 
diff --git a/jscomp/core/js_fold.ml b/jscomp/core/js_fold.ml
@@ -169,8 +169,9 @@ class fold =
           let _self = _self#expression _x0 in
           _self
       | Number _ -> _self
-      | Object _x0 ->
-          let _self = _self#property_map _x0 in
+      | Object (_x0, _x1) ->
+          let _self = option (fun _self -> _self#expression) _self _x0 in
+          let _self = _self#property_map _x1 in
           _self
       | Undefined _ -> _self
       | Null -> _self
diff --git a/jscomp/core/js_record_fold.ml b/jscomp/core/js_record_fold.ml
@@ -175,8 +175,9 @@ let expression_desc : 'a. ('a, expression_desc) fn =
       let st = _self.expression _self st _x0 in
       st
   | Number _ -> st
-  | Object _x0 ->
-      let st = property_map _self st _x0 in
+  | Object (_x0, _x1) ->
+      let st = option _self.expression _self st _x0 in
+      let st = property_map _self st _x1 in
       st
   | Undefined _ -> st
   | Null -> st
diff --git a/jscomp/core/js_record_iter.ml b/jscomp/core/js_record_iter.ml
@@ -132,7 +132,9 @@ let expression_desc : expression_desc fn =
       _self.expression _self _x2
   | Caml_block_tag (_x0, _tag) -> _self.expression _self _x0
   | Number _ -> ()
-  | Object _x0 -> property_map _self _x0
+  | Object (_x0, _x1) ->
+      option _self.expression _self _x0;
+      property_map _self _x1
   | Undefined _ -> ()
   | Null -> ()
   | Await _x0 -> _self.expression _self _x0
diff --git a/jscomp/core/js_record_map.ml b/jscomp/core/js_record_map.ml
@@ -173,9 +173,10 @@ let expression_desc : expression_desc fn =
       let _x0 = _self.expression _self _x0 in
       Caml_block_tag (_x0, tag)
   | Number _ as v -> v
-  | Object _x0 ->
-      let _x0 = property_map _self _x0 in
-      Object _x0
+  | Object (_x0, _x1) ->
+      let _x0 = option _self.expression _self _x0 in
+      let _x1 = property_map _self _x1 in
+      Object (_x0, _x1)
   | Undefined _ as v -> v
   | Null as v -> v
   | Await _x0 ->
diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml
@@ -48,7 +48,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
               (* more safe to check if arguments are constant *)
               (* non-observable side effect *)
               | "?sys_get_argv" (* should be fine *)
-              | "?string_repeat" | "?make_vect" | "?create_bytes" | "?obj_dup"
+              | "?string_repeat" | "?make_vect" | "?create_bytes"
               | "caml_array_dup" | "?nativeint_add" | "?nativeint_div"
               | "?nativeint_mod" | "?nativeint_lsr" | "?nativeint_mul" ),
               _ ) ->
diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml
@@ -391,7 +391,10 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
           E.make_block E.zero_int_literal
             (Blk_constructor { name = "Other"; num_nonconst = 1; tag = 0; attrs = [] })
             [ E.str "BS" ] Immutable)
-  | Pduprecord -> Lam_dispatch_primitive.translate loc "?obj_dup" args
+  | Pduprecord -> (
+      match args with
+      | [ e1 ] -> E.obj ~dup:e1 []
+      | _ -> assert false)
   | Plazyforce
   (* FIXME: we don't inline lazy force or at least
      let buckle handle it
diff --git a/jscomp/core/lam_dispatch_primitive.ml b/jscomp/core/lam_dispatch_primitive.ml
@@ -224,7 +224,6 @@ let translate loc (prim_name : string) (args : J.expression list) : J.expression
   | "?int_of_string" (* what is the semantics?*)
   | "?int64_format" | "?int64_of_string" | "?format_int" ->
       call Js_runtime_modules.format
-  | "?obj_dup" -> call Js_runtime_modules.obj_runtime
   | "?obj_tag" -> (
       (* Note that in ocaml, [int] has tag [1000] and [string] has tag [252]
          also now we need do nullary check
diff --git a/jscomp/ext/ext_array.ml b/jscomp/ext/ext_array.ml
@@ -80,6 +80,16 @@ let filter_map a (f : _ -> _ option) =
   in
   aux [] 0
 
+let filter_mapi a (f : _ -> _ -> _ option) =
+  let arr_len = Array.length a in
+  let rec aux acc i =
+    if i = arr_len then reverse_of_list acc
+    else
+      let v = Array.unsafe_get a i in
+      match f i v with Some v -> aux (v :: acc) (i + 1) | None -> aux acc (i + 1)
+  in
+  aux [] 0
+
 let range from to_ =
   if from > to_ then invalid_arg "Ext_array.range"
   else Array.init (to_ - from + 1) (fun i -> i + from)
diff --git a/jscomp/ext/ext_array.mli b/jscomp/ext/ext_array.mli
@@ -35,6 +35,8 @@ val filter : 'a array -> ('a -> bool) -> 'a array
 
 val filter_map : 'a array -> ('a -> 'b option) -> 'b array
 
+val filter_mapi : 'a array -> (int -> 'a -> 'b option) -> 'b array
+
 val range : int -> int -> int array
 
 val map2i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array
diff --git a/jscomp/ml/translcore.ml b/jscomp/ml/translcore.ml
@@ -314,6 +314,7 @@ let primitives_table =
       (* Finish Triples for  ref data type *)
       ("%field0", Pfield (0, Fld_tuple));
       ("%field1", Pfield (1, Fld_tuple));
+      ("%obj_dup", Pduprecord);
       ("%obj_field", Parrayrefu);
       ("%obj_set_field", Parraysetu);
       ("%obj_is_int", Pisint);
diff --git a/jscomp/runtime/caml_obj.res b/jscomp/runtime/caml_obj.res
@@ -45,47 +45,6 @@ module O = {
   @get_index external get_value: (Obj.t, key) => Obj.t = ""
 }
 
-/**
-   Since now we change it back to use
-   Array representation
-   this function is higly dependent
-   on how objects are encoded in buckle.
-
-   There are potentially some issues with wrong implementation of
-   `obj_dup`, for example, people call `Obj.dup` for a record,
-   and new record, since currently, `new record` will generate a
-   `slice` function (which assume the record is an array), and the
-   output is no longer an array. (it might be  something like { 0 : x , 1 : y} )
-
-   {[
-     let u : record = Obj.dup x in
-     let h = {u with x = 3}
-   ]}
-
-   ==>
-
-   {[
-     var u = obj_dup (x)
-       var new_record = u.slice ()
-
-   ]}
-   `obj_dup` is a superset of `array_dup`
-*/
-let obj_dup: Obj.t => Obj.t = %raw(`function(x){
-  if(Array.isArray(x)){
-    var len = x.length  
-    var v = new Array(len)
-    for(var i = 0 ; i < len ; ++i){
-      v[i] = x[i]
-    }
-    if(x.TAG !== undefined){
-      v.TAG = x.TAG // TODO this can be removed eventually
-    }  
-    return v 
-  } 
-  return Object.assign({},x)    
-}`)
-
 /** 
    For the empty dummy object, whether it's 
    [[]] or [{}] depends on how 
diff --git a/jscomp/runtime/caml_obj.resi b/jscomp/runtime/caml_obj.resi
@@ -24,8 +24,6 @@
 
 type t = Obj.t
 
-let obj_dup: Obj.t => Obj.t
-
 let update_dummy: (Obj.t, Obj.t) => unit
 
 let compare: (Obj.t, Obj.t) => int
diff --git a/jscomp/stdlib-406/obj.res b/jscomp/stdlib-406/obj.res
@@ -26,4 +26,4 @@ external tag: t => int = "?obj_tag"
 external size: t => int = "#obj_length"
 external field: (t, int) => t = "%obj_field"
 external set_field: (t, int, t) => unit = "%obj_set_field"
-external dup: t => t = "?obj_dup"
+external dup: t => t = "%obj_dup"
diff --git a/jscomp/stdlib-406/obj.resi b/jscomp/stdlib-406/obj.resi
@@ -48,4 +48,4 @@ external field: (t, int) => t = "%obj_field"
     be propagated.
 */
 external set_field: (t, int, t) => unit = "%obj_set_field"
-external dup: t => t = "?obj_dup"
+external dup: t => t = "%obj_dup"
diff --git a/jscomp/test/large_record_duplication_test.js b/jscomp/test/large_record_duplication_test.js
diff --git a/jscomp/test/record_regression.js b/jscomp/test/record_regression.js
diff --git a/jscomp/test/res_debug.js b/jscomp/test/res_debug.js
diff --git a/jscomp/test/update_record_test.js b/jscomp/test/update_record_test.js
diff --git a/lib/es6/caml_obj.js b/lib/es6/caml_obj.js
diff --git a/lib/js/caml_obj.js b/lib/js/caml_obj.js
