From e56e8653a8bcb06872e8cc128e3fe76972db9126 Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Mon, 20 Jun 2022 21:25:44 +0200
Subject: [PATCH 1/5] Pattern matching for @nullable records.

This gives pattern matching that mimics expression constructor, where the variable by default is not optional.
The generated code seems fine, thought the checks for exhaustiveness are not kicking in.

See https://github.com/rescript-lang/rescript-compiler/issues/5452
---
 jscomp/ml/typecore.ml                         | 14 ++++++++++++++
 jscomp/test/res_debug.js                      | 10 ++++++++++
 jscomp/test/res_debug.res                     |  8 ++++++++
 lib/4.06.1/unstable/js_compiler.ml            | 14 ++++++++++++++
 lib/4.06.1/unstable/js_playground_compiler.ml | 14 ++++++++++++++
 lib/4.06.1/whole_compiler.ml                  | 14 ++++++++++++++
 6 files changed, 74 insertions(+)

diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml
index 72280eae0d..5262ca7f31 100644
--- a/jscomp/ml/typecore.ml
+++ b/jscomp/ml/typecore.ml
@@ -1149,6 +1149,19 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           Some (p0, p), expected_ty
         with Not_found -> None, newvar ()
       in
+      let label_is_optional ld =
+        match ld.lbl_repres with
+        | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
+        | _ -> false in
+      let process_optional_label (id, ld, pat) =
+        let exp_optional_attr =
+          Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
+        in
+        if label_is_optional ld && not exp_optional_attr then
+          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
+          in {pat with ppat_desc}
+        else pat
+      in    
       let type_label_pat (label_lid, label, sarg) k =
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
@@ -1159,6 +1172,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
+        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();
diff --git a/jscomp/test/res_debug.js b/jscomp/test/res_debug.js
index b116b6f307..e69bda1ade 100644
--- a/jscomp/test/res_debug.js
+++ b/jscomp/test/res_debug.js
@@ -15,6 +15,15 @@ var newrecord = Caml_obj.obj_dup(v0);
 
 newrecord.x = 3;
 
+function testMatch(v) {
+  var y = v.y;
+  if (y !== undefined) {
+    return y;
+  } else {
+    return 42;
+  }
+}
+
 var v2 = newrecord;
 
 var v1 = {
@@ -30,6 +39,7 @@ exports.f = f;
 exports.v0 = v0;
 exports.v2 = v2;
 exports.v1 = v1;
+exports.testMatch = testMatch;
 exports.h = h;
 exports.hey = hey;
 /*  Not a pure module */
diff --git a/jscomp/test/res_debug.res b/jscomp/test/res_debug.res
index bc7e788ada..ce96dbdcc6 100644
--- a/jscomp/test/res_debug.res
+++ b/jscomp/test/res_debug.res
@@ -44,6 +44,14 @@ let v1 : r = { x : 3
   , z : 3
 }
 
+@@warning("-56") // Turn off match case unreachable
+
+let testMatch = v =>
+  switch v {
+  | {y} => y
+  | {y: @optional None} => 42
+  }
+
 let h = '😊'
 let hey = "hello, 世界"
 // failed to type check
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
index 3b02b47df6..b4208df96c 100644
--- a/lib/4.06.1/unstable/js_compiler.ml
+++ b/lib/4.06.1/unstable/js_compiler.ml
@@ -40052,6 +40052,19 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           Some (p0, p), expected_ty
         with Not_found -> None, newvar ()
       in
+      let label_is_optional ld =
+        match ld.lbl_repres with
+        | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
+        | _ -> false in
+      let process_optional_label (id, ld, pat) =
+        let exp_optional_attr =
+          Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
+        in
+        if label_is_optional ld && not exp_optional_attr then
+          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
+          in {pat with ppat_desc}
+        else pat
+      in    
       let type_label_pat (label_lid, label, sarg) k =
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
@@ -40062,6 +40075,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
+        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();
diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml
index f83b4a3128..e642d40b57 100644
--- a/lib/4.06.1/unstable/js_playground_compiler.ml
+++ b/lib/4.06.1/unstable/js_playground_compiler.ml
@@ -40052,6 +40052,19 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           Some (p0, p), expected_ty
         with Not_found -> None, newvar ()
       in
+      let label_is_optional ld =
+        match ld.lbl_repres with
+        | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
+        | _ -> false in
+      let process_optional_label (id, ld, pat) =
+        let exp_optional_attr =
+          Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
+        in
+        if label_is_optional ld && not exp_optional_attr then
+          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
+          in {pat with ppat_desc}
+        else pat
+      in    
       let type_label_pat (label_lid, label, sarg) k =
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
@@ -40062,6 +40075,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
+        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
index 38dbf66325..4b2cee4bde 100644
--- a/lib/4.06.1/whole_compiler.ml
+++ b/lib/4.06.1/whole_compiler.ml
@@ -214583,6 +214583,19 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           Some (p0, p), expected_ty
         with Not_found -> None, newvar ()
       in
+      let label_is_optional ld =
+        match ld.lbl_repres with
+        | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
+        | _ -> false in
+      let process_optional_label (id, ld, pat) =
+        let exp_optional_attr =
+          Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
+        in
+        if label_is_optional ld && not exp_optional_attr then
+          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
+          in {pat with ppat_desc}
+        else pat
+      in    
       let type_label_pat (label_lid, label, sarg) k =
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
@@ -214593,6 +214606,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
+        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();

From b4ac0d8b18bd2d09b21a03f317b7e692dafc0ae5 Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Tue, 21 Jun 2022 03:39:34 +0200
Subject: [PATCH 2/5] Clean up optional implementation.

---
 jscomp/ml/typecore.ml                         | 13 +++++++------
 jscomp/test/res_debug.js                      |  7 +------
 jscomp/test/res_debug.res                     |  4 ++--
 lib/4.06.1/unstable/js_compiler.ml            | 13 +++++++------
 lib/4.06.1/unstable/js_playground_compiler.ml | 13 +++++++------
 lib/4.06.1/whole_compiler.ml                  | 13 +++++++------
 6 files changed, 31 insertions(+), 32 deletions(-)

diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml
index 5262ca7f31..fa915333da 100644
--- a/jscomp/ml/typecore.ml
+++ b/jscomp/ml/typecore.ml
@@ -1153,16 +1153,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         match ld.lbl_repres with
         | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
         | _ -> false in
-      let process_optional_label (id, ld, pat) =
+      let process_optional_label (ld, pat) =
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
         if label_is_optional ld && not exp_optional_attr then
-          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
-          in {pat with ppat_desc}
+          let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+          Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat
       in    
       let type_label_pat (label_lid, label, sarg) k =
+        let sarg = process_optional_label (label, sarg) in
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
         if vars = [] then end_def ();
@@ -1172,7 +1173,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
-        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();
@@ -1879,8 +1879,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
       Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
     in
     if label_is_optional ld && not exp_optional_attr then
-      let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
-      in (id, ld, {e with pexp_desc})
+      let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+      let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+      in (id, ld, e)
     else (id, ld, e)
   in
   match sexp.pexp_desc with
diff --git a/jscomp/test/res_debug.js b/jscomp/test/res_debug.js
index e69bda1ade..a6c3eb4857 100644
--- a/jscomp/test/res_debug.js
+++ b/jscomp/test/res_debug.js
@@ -16,12 +16,7 @@ var newrecord = Caml_obj.obj_dup(v0);
 newrecord.x = 3;
 
 function testMatch(v) {
-  var y = v.y;
-  if (y !== undefined) {
-    return y;
-  } else {
-    return 42;
-  }
+  return v.y;
 }
 
 var v2 = newrecord;
diff --git a/jscomp/test/res_debug.res b/jscomp/test/res_debug.res
index ce96dbdcc6..5b6d6bfeab 100644
--- a/jscomp/test/res_debug.res
+++ b/jscomp/test/res_debug.res
@@ -44,12 +44,12 @@ let v1 : r = { x : 3
   , z : 3
 }
 
-@@warning("-56") // Turn off match case unreachable
+//@@warning("-56") // Turn off match case unreachable
 
 let testMatch = v =>
   switch v {
   | {y} => y
-  | {y: @optional None} => 42
+//  | {y: @optional None} => 42
   }
 
 let h = '😊'
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
index b4208df96c..2d4f92eeab 100644
--- a/lib/4.06.1/unstable/js_compiler.ml
+++ b/lib/4.06.1/unstable/js_compiler.ml
@@ -40056,16 +40056,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         match ld.lbl_repres with
         | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
         | _ -> false in
-      let process_optional_label (id, ld, pat) =
+      let process_optional_label (ld, pat) =
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
         if label_is_optional ld && not exp_optional_attr then
-          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
-          in {pat with ppat_desc}
+          let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+          Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat
       in    
       let type_label_pat (label_lid, label, sarg) k =
+        let sarg = process_optional_label (label, sarg) in
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
         if vars = [] then end_def ();
@@ -40075,7 +40076,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
-        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();
@@ -40782,8 +40782,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
       Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
     in
     if label_is_optional ld && not exp_optional_attr then
-      let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
-      in (id, ld, {e with pexp_desc})
+      let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+      let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+      in (id, ld, e)
     else (id, ld, e)
   in
   match sexp.pexp_desc with
diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml
index e642d40b57..c549070353 100644
--- a/lib/4.06.1/unstable/js_playground_compiler.ml
+++ b/lib/4.06.1/unstable/js_playground_compiler.ml
@@ -40056,16 +40056,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         match ld.lbl_repres with
         | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
         | _ -> false in
-      let process_optional_label (id, ld, pat) =
+      let process_optional_label (ld, pat) =
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
         if label_is_optional ld && not exp_optional_attr then
-          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
-          in {pat with ppat_desc}
+          let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+          Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat
       in    
       let type_label_pat (label_lid, label, sarg) k =
+        let sarg = process_optional_label (label, sarg) in
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
         if vars = [] then end_def ();
@@ -40075,7 +40076,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
-        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();
@@ -40782,8 +40782,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
       Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
     in
     if label_is_optional ld && not exp_optional_attr then
-      let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
-      in (id, ld, {e with pexp_desc})
+      let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+      let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+      in (id, ld, e)
     else (id, ld, e)
   in
   match sexp.pexp_desc with
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
index 4b2cee4bde..3396e7cfb8 100644
--- a/lib/4.06.1/whole_compiler.ml
+++ b/lib/4.06.1/whole_compiler.ml
@@ -214587,16 +214587,17 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         match ld.lbl_repres with
         | Record_optional_labels lbls -> Ext_list.mem_string lbls ld.lbl_name
         | _ -> false in
-      let process_optional_label (id, ld, pat) =
+      let process_optional_label (ld, pat) =
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
         if label_is_optional ld && not exp_optional_attr then
-          let ppat_desc = Ppat_construct ({id with txt = Longident.Lident "Some"}, Some pat)
-          in {pat with ppat_desc}
+          let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+          Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat
       in    
       let type_label_pat (label_lid, label, sarg) k =
+        let sarg = process_optional_label (label, sarg) in
         begin_def ();
         let (vars, ty_arg, ty_res) = instance_label false label in
         if vars = [] then end_def ();
@@ -214606,7 +214607,6 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           raise(Error(label_lid.loc, !env,
                       Label_mismatch(label_lid.txt, trace)))
         end;
-        let sarg = process_optional_label (label_lid, label, sarg) in
         type_pat sarg ty_arg (fun arg ->
           if vars <> [] then begin
             end_def ();
@@ -215313,8 +215313,9 @@ and type_expect_ ?in_function ?(recarg=Rejected) env sexp ty_expected =
       Ext_list.exists e.pexp_attributes (fun ({txt },_) -> txt = "optional")
     in
     if label_is_optional ld && not exp_optional_attr then
-      let pexp_desc = Pexp_construct ({id with txt = Longident.Lident "Some"}, Some e)
-      in (id, ld, {e with pexp_desc})
+      let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
+      let e = Ast_helper.Exp.construct ~loc:e.pexp_loc lid (Some e)
+      in (id, ld, e)
     else (id, ld, e)
   in
   match sexp.pexp_desc with

From 9c1f9f5d14406bcddc3f3f68cca00d1dee2ffce4 Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Tue, 21 Jun 2022 19:35:23 +0200
Subject: [PATCH 3/5] Work around issue with fresh names from pattern matching.

A pattern is type checked twice.
The second time for the exhaustive check coming from the pattern matcher.
The second time constructors, such as optionals, have been replaced by fresh symbols starting with `#$`.
Now recognize these symbols and do not apply the transformation which adds Some.
---
 jscomp/ml/typecore.ml                         |  7 ++++++-
 jscomp/test/res_debug.js                      | 14 +++++++++++++-
 jscomp/test/res_debug.res                     |  2 +-
 lib/4.06.1/unstable/js_compiler.ml            |  7 ++++++-
 lib/4.06.1/unstable/js_playground_compiler.ml |  7 ++++++-
 lib/4.06.1/whole_compiler.ml                  |  7 ++++++-
 6 files changed, 38 insertions(+), 6 deletions(-)

diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml
index fa915333da..8815be4a88 100644
--- a/jscomp/ml/typecore.ml
+++ b/jscomp/ml/typecore.ml
@@ -1157,7 +1157,12 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
-        if label_is_optional ld && not exp_optional_attr then
+        let isFromPamatch = match pat.ppat_desc with
+          | Ppat_construct ({txt = Lident s}, _) ->
+            String.length s >= 2 && s.[0] = '#' && s.[1] = '$'
+          | _ -> false
+        in
+        if label_is_optional ld && not exp_optional_attr && not isFromPamatch then
           let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
           Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat
diff --git a/jscomp/test/res_debug.js b/jscomp/test/res_debug.js
index a6c3eb4857..206296a4e4 100644
--- a/jscomp/test/res_debug.js
+++ b/jscomp/test/res_debug.js
@@ -16,7 +16,19 @@ var newrecord = Caml_obj.obj_dup(v0);
 newrecord.x = 3;
 
 function testMatch(v) {
-  return v.y;
+  var y = v.y;
+  if (y !== undefined) {
+    return y;
+  }
+  throw {
+        RE_EXN_ID: "Match_failure",
+        _1: [
+          "res_debug.res",
+          50,
+          2
+        ],
+        Error: new Error()
+      };
 }
 
 var v2 = newrecord;
diff --git a/jscomp/test/res_debug.res b/jscomp/test/res_debug.res
index 5b6d6bfeab..698946c1f1 100644
--- a/jscomp/test/res_debug.res
+++ b/jscomp/test/res_debug.res
@@ -44,7 +44,7 @@ let v1 : r = { x : 3
   , z : 3
 }
 
-//@@warning("-56") // Turn off match case unreachable
+@@warning("-8") // Turn off incomplete pattern match
 
 let testMatch = v =>
   switch v {
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
index 2d4f92eeab..872c8e329c 100644
--- a/lib/4.06.1/unstable/js_compiler.ml
+++ b/lib/4.06.1/unstable/js_compiler.ml
@@ -40060,7 +40060,12 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
-        if label_is_optional ld && not exp_optional_attr then
+        let isFromPamatch = match pat.ppat_desc with
+          | Ppat_construct ({txt = Lident s}, _) ->
+            String.length s >= 2 && s.[0] = '#' && s.[1] = '$'
+          | _ -> false
+        in
+        if label_is_optional ld && not exp_optional_attr && not isFromPamatch then
           let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
           Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat
diff --git a/lib/4.06.1/unstable/js_playground_compiler.ml b/lib/4.06.1/unstable/js_playground_compiler.ml
index c549070353..ff7b5c757a 100644
--- a/lib/4.06.1/unstable/js_playground_compiler.ml
+++ b/lib/4.06.1/unstable/js_playground_compiler.ml
@@ -40060,7 +40060,12 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
-        if label_is_optional ld && not exp_optional_attr then
+        let isFromPamatch = match pat.ppat_desc with
+          | Ppat_construct ({txt = Lident s}, _) ->
+            String.length s >= 2 && s.[0] = '#' && s.[1] = '$'
+          | _ -> false
+        in
+        if label_is_optional ld && not exp_optional_attr && not isFromPamatch then
           let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
           Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
index 3396e7cfb8..fe84ca7730 100644
--- a/lib/4.06.1/whole_compiler.ml
+++ b/lib/4.06.1/whole_compiler.ml
@@ -214591,7 +214591,12 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         let exp_optional_attr =
           Ext_list.exists pat.ppat_attributes (fun ({txt },_) -> txt = "optional")
         in
-        if label_is_optional ld && not exp_optional_attr then
+        let isFromPamatch = match pat.ppat_desc with
+          | Ppat_construct ({txt = Lident s}, _) ->
+            String.length s >= 2 && s.[0] = '#' && s.[1] = '$'
+          | _ -> false
+        in
+        if label_is_optional ld && not exp_optional_attr && not isFromPamatch then
           let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in
           Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat)
         else pat

From 5920d81e99228da3aaf1d6bf83c0be8e57743de9 Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Tue, 21 Jun 2022 19:41:08 +0200
Subject: [PATCH 4/5] Complete pattern match in the example.

---
 jscomp/test/res_debug.js  | 11 ++---------
 jscomp/test/res_debug.res |  4 +---
 2 files changed, 3 insertions(+), 12 deletions(-)

diff --git a/jscomp/test/res_debug.js b/jscomp/test/res_debug.js
index 206296a4e4..e69bda1ade 100644
--- a/jscomp/test/res_debug.js
+++ b/jscomp/test/res_debug.js
@@ -19,16 +19,9 @@ function testMatch(v) {
   var y = v.y;
   if (y !== undefined) {
     return y;
+  } else {
+    return 42;
   }
-  throw {
-        RE_EXN_ID: "Match_failure",
-        _1: [
-          "res_debug.res",
-          50,
-          2
-        ],
-        Error: new Error()
-      };
 }
 
 var v2 = newrecord;
diff --git a/jscomp/test/res_debug.res b/jscomp/test/res_debug.res
index 698946c1f1..31d08a546d 100644
--- a/jscomp/test/res_debug.res
+++ b/jscomp/test/res_debug.res
@@ -44,12 +44,10 @@ let v1 : r = { x : 3
   , z : 3
 }
 
-@@warning("-8") // Turn off incomplete pattern match
-
 let testMatch = v =>
   switch v {
   | {y} => y
-//  | {y: @optional None} => 42
+  | {y: @optional None} => 42
   }
 
 let h = '😊'

From 2cc9720d1502c7a9a6980e0fd4ed43b499b50bed Mon Sep 17 00:00:00 2001
From: Cristiano Calcagno <cristianoc@users.noreply.github.com>
Date: Wed, 22 Jun 2022 04:55:27 +0200
Subject: [PATCH 5/5] Update changes.

---
 Changes.md | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/Changes.md b/Changes.md
index d054daf0fd..aabe93b73c 100644
--- a/Changes.md
+++ b/Changes.md
@@ -4,11 +4,20 @@
 
 **Compiler**
 
-- Added support for `@new @variadic` (see https://github.com/rescript-lang/rescript-compiler/pull/5364) 
-- Added support for `@optional` fields in records (see https://github.com/rescript-lang/rescript-compiler/pull/5423)
+- Add support for `@new @variadic` (see https://github.com/rescript-lang/rescript-compiler/pull/5364) 
+- New records with `@optional` fields [#5423](https://github.com/rescript-lang/rescript-compiler/pull/5423) [#5452](https://github.com/rescript-lang/rescript-compiler/issues/5452)
 
 **Syntax**
 
+- Fix printing for inline nullary functor types [#477](https://github.com/rescript-lang/syntax/pull/477)
+- Fix stripping of quotes for empty poly variants [#474](https://github.com/rescript-lang/syntax/pull/474)
+- Implement syntax for arity zero vs arity one in uncurried application in [#139](https://github.com/rescript-lang/syntax/pull/139)
+- Fix parsing of first class module exprs as part of binary/ternary expr in [#256](https://github.com/rescript-lang/syntax/pull/256)
+
+**Libraries**
+
+- Several Belt libraries are now converted to ReScript syntax, with corresponding comments in Markdown format suitable for hovering.
+
 **Playground**
 
 - Added `jsoo_playground_main.ml` as the rescript-lang.org playground bundle entrypoint