From f04fb33bc84f2ffed3e2d5a044b86ae8fdf50daf Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Fri, 1 Nov 2024 18:26:59 +0100
Subject: [PATCH] Code gen: improve pattern matching of optional fields.

Pattern matching of optional fields such as
```res
| {x: 1, y: "hello"}
```

can be specialised as the constants already imply the values cannot be absent.
---
 compiler/ml/parmatch.ml       | 20 +++++++++++++++++++-
 tests/tests/src/DictTests.mjs | 29 +++++++++--------------------
 2 files changed, 28 insertions(+), 21 deletions(-)

diff --git a/compiler/ml/parmatch.ml b/compiler/ml/parmatch.ml
index 346ac58c61..03f11793f6 100644
--- a/compiler/ml/parmatch.ml
+++ b/compiler/ml/parmatch.ml
@@ -524,7 +524,25 @@ let all_record_args lbls =
         (fun lbl -> (mknoloc (Longident.Lident "?temp?"), lbl, omega))
         lbl_all
     in
-    List.iter (fun ((_, lbl, _) as x) -> t.(lbl.lbl_pos) <- x) lbls;
+    List.iter
+      (fun ((id, lbl, pat) as x) ->
+        let lbl_is_optional () =
+          match lbl.lbl_repres with
+          | Record_optional_labels labels -> List.mem lbl.lbl_name labels
+          | _ -> false
+        in
+        let x =
+          match pat.pat_desc with
+          | Tpat_construct
+              ( {txt = Longident.Ldot (Longident.Lident "*predef*", "Some")},
+                _,
+                [({pat_desc = Tpat_constant _} as c)] )
+            when lbl_is_optional () ->
+            (id, lbl, c)
+          | _ -> x
+        in
+        t.(lbl.lbl_pos) <- x)
+      lbls;
     Array.to_list t
   | _ -> fatal_error "Parmatch.all_record_args"
 
diff --git a/tests/tests/src/DictTests.mjs b/tests/tests/src/DictTests.mjs
index 703caeb496..a1a763250b 100644
--- a/tests/tests/src/DictTests.mjs
+++ b/tests/tests/src/DictTests.mjs
@@ -17,33 +17,22 @@ let intDict = {
 };
 
 function inferDictByPattern(dict) {
-  let match = dict.one;
-  if (match === 1) {
-    let match$1 = dict.three;
-    if (match$1 === 3) {
-      let match$2 = dict.four;
-      if (match$2 === 4) {
-        dict["five"] = 5;
-        return;
-      }
-      
-    }
-    
+  if (dict.one === 1 && dict.three === 3 && dict.four === 4) {
+    dict["five"] = 5;
+    return;
   }
-  let match$3 = dict.two;
-  if (match$3 === 1) {
-    console.log("two");
-  } else {
+  if (dict.two !== 1) {
     console.log("not one");
+  } else {
+    console.log("two");
   }
 }
 
 function constrainedAsDict(dict) {
-  let match = dict.one;
-  if (match === 1) {
-    console.log("one");
-  } else {
+  if (dict.one !== 1) {
     console.log("not one");
+  } else {
+    console.log("one");
   }
 }