disambiguate optional labels

When disambiguating record types, there's a check that all the labels are supplied when constructing a record.
While not supplying all the labels is supported in case of optional labels, the order of disambiguation is affected by the presence of optional labels.

Example:

```res
type t1 = {x:int, y:int}
type t2 = {x:int, y:int, z?:int}

let v = {x:3, y:4}
```

Currently `v` has type `t1`, while it's perfectly fine for it to have type `t2`.
In particular, the normal shadowing behaviour that applies without optional labels, does not happen. (If you remove `z` from the second type definition, then the normal shadowing happens, and `v` gets type `t2`.

This wip changes the disambiguation so that supplying at least all the mandatory labels is enough in disambiguation.

The change also addresses the issue #6752 of spurious warning of unused open.

# Conflicts:
#	CHANGELOG.md
#	jscomp/test/build.ninja

Author: cristianoc

CHANGELOG.md

@@ -16,6 +16,7 @@
 
 - Fix location of let bindings with attributes. https://github.com/rescript-lang/rescript-compiler/pull/6791
 - PPX v4: mark props type in externals as `@live` to avoid dead code warnings for prop fields in the editor tooling. https://github.com/rescript-lang/rescript-compiler/pull/6796
+- Fix issue where optional labels were not taken into account when disambiguating record value construction. https://github.com/rescript-lang/rescript-compiler/pull/6798
 
 # 11.1.1
 

jscomp/ml/typecore.ml

@@ -311,6 +311,12 @@ let extract_concrete_variant env ty =
   | (p0, p, {type_kind=Type_open}) -> (p0, p, [])
   | _ -> raise Not_found
 
+let has_optional_labels ld =
+  match ld.lbl_repres with
+  | Record_optional_labels _ -> true
+  | Record_inlined {optional_labels} -> optional_labels <> []
+  | _ -> false
+
 let label_is_optional ld =
   match ld.lbl_repres with
   | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
@@ -843,9 +849,15 @@ let disambiguate_label_by_ids keep closed ids labels =
   let check_ids (lbl, _) =
     let lbls = Hashtbl.create 8 in
     Array.iter (fun lbl -> Hashtbl.add lbls lbl.lbl_name ()) lbl.lbl_all;
-    List.for_all (Hashtbl.mem lbls) ids
-  and check_closed (lbl, _) =
-    (not closed || List.length ids = Array.length lbl.lbl_all)
+    List.for_all (Hashtbl.mem lbls) ids in
+  let mandatory_labels_are_present num_ids lbl = (* check that all mandatory labels are present *)
+    if has_optional_labels lbl then (
+      let mandatory_lbls = ref 0 in
+      Ext_array.iter lbl.lbl_all (fun l -> if not (label_is_optional l) then incr mandatory_lbls);
+      num_ids >= !mandatory_lbls)
+    else num_ids = Array.length lbl.lbl_all in
+  let check_closed (lbl, _) =
+    (not closed || mandatory_labels_are_present (List.length ids) lbl)
   in
   let labels' = Ext_list.filter labels check_ids in
   if keep && labels' = [] then (false, labels) else

jscomp/test/DisambiguateOptionalFields.js

@@ -0,0 +1,8 @@
+type t1 = {x:int, y:int}
+type t2 = {x:int, y:int, z?:int}
+
+let f1 = (v:t1) => v.x
+let f2 = (v:t2) => v.x
+
+let v = {x:3, y:4}
+let res = f2(v) // Check that t2 shadows t1