avoid creating unnecessary copies of allocating constants in field fl…

CHANGELOG.md

@@ -28,6 +28,7 @@
 #### :bug: Bug fix
 
 - Fix broken `bstracing` CLI location. https://github.com/rescript-lang/rescript/pull/7398
+- Fix field flattening optimization to avoid creating unnecessary copies of allocating constants. https://github.com/rescript-lang/rescript-compiler/pull/7421
 
 #### :house: Internal
 

compiler/core/lam_util.ml

@@ -200,14 +200,15 @@ let field_flatten_get
         for i = 0 to Array.length fields - 1 do
           if fst(fields.(i)) = name then found := Ext_list.nth_opt ls i done;
         (match !found with
-        | Some c -> Lam.const c
-        | None  -> lam())
+        | Some c when not (Lam_constant.is_allocating c) -> Lam.const c
+        | _ -> lam())
       | _ -> lam ()
     )
   | Some (Constant (Const_block (_,_,ls))) ->
     begin match Ext_list.nth_opt ls i with 
       | None -> lam  ()
-      | Some x -> Lam.const x
+      | Some x when not (Lam_constant.is_allocating x) -> Lam.const x
+      | Some _ -> lam ()
     end
   | Some _
   | None -> lam ()

compiler/frontend/lam_constant.ml

@@ -100,3 +100,12 @@ let rec eq_approx (x : t) (y : t) =
     | _ -> false)
 
 let lam_none : t = Const_js_undefined {is_unit = false}
+
+let rec is_allocating (c : t) : bool =
+  match c with
+  | Const_some t -> is_allocating t
+  | Const_block _ -> true
+  | Const_js_null | Const_js_undefined _ | Const_js_true | Const_js_false
+  | Const_int _ | Const_char _ | Const_string _ | Const_float _ | Const_bigint _
+  | Const_pointer _ | Const_module_alias ->
+    false

compiler/frontend/lam_constant.mli

@@ -57,3 +57,5 @@ type t =
 val eq_approx : t -> t -> bool
 
 val lam_none : t
+
+val is_allocating : t -> bool

tests/tests/src/field_flattening_opt.mjs

@@ -0,0 +1,39 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Stdlib_Int from "rescript/lib/es6/Stdlib_Int.js";
+
+let group = {
+  nested: {}
+};
+
+function fn(str) {
+  group.nested.field = Stdlib_Int.fromString(str, undefined);
+}
+
+let WithNestedMutableFields = {
+  group: group,
+  fn: fn
+};
+
+let p = [
+  {
+    field: 2
+  },
+  ""
+];
+
+let x = p[0];
+
+let y = p[0];
+
+let NoOptionalFields = {
+  p: p,
+  x: x,
+  y: y
+};
+
+export {
+  WithNestedMutableFields,
+  NoOptionalFields,
+}
+/* No side effect */

tests/tests/src/field_flattening_opt.res

@@ -0,0 +1,20 @@
+module WithNestedMutableFields = {
+  type nested = {mutable field?: int}
+  type group = {nested: nested}
+
+  let group: group = {nested: {}}
+
+  let fn = str => {
+    group.nested.field = str->Int.fromString
+  }
+}
+
+module NoOptionalFields = {
+  type record = {field: int}
+  type pair = (record, string)
+
+  let p: pair = ({field: 2}, "")
+
+  let x = fst(p)
+  let y = fst(p)
+}

tests/tests/src/gpr_4632.mjs

@@ -15,10 +15,7 @@ if (myList !== 0) {
   T0 = {
     myList: myList,
     head: 1,
-    tail: {
-      hd: 2,
-      tl: /* [] */0
-    }
+    tail: myList.tl
   };
 } else {
   throw {
@@ -47,11 +44,7 @@ if (myList$1 !== 0) {
   if (/* [] */0 !== 0) {
     T1 = {
       myList: myList$1,
-      h0: [
-        1,
-        2,
-        3
-      ],
+      h0: myList$1.hd,
       h1: /* [] */(0).hd,
       h2: /* [] */(0).tl
     };

tests/tests/src/record_debug_test.mjs

@@ -25,10 +25,7 @@ let v = {
 
 let u_a = 2;
 
-let u_b = {
-  xx: 2,
-  yy: 3
-};
+let u_b = v.b;
 
 let u = {
   a: u_a,