Optional fields pattern matching: untagged variants

Add support for untagged variants to optimised pattern matching for optional fields.

Author: cristianoc

compiler/ml/parmatch.ml

@@ -539,6 +539,31 @@ let all_record_args lbls =
                 [({pat_desc = Tpat_constant _} as c)] )
             when lbl_is_optional () ->
             (id, lbl, c)
+          | Tpat_construct
+              ( {txt = Longident.Ldot (Longident.Lident "*predef*", "Some")},
+                _,
+                [({pat_desc = Tpat_construct (_, cd, _)} as pat_construct)] )
+            when lbl_is_optional () -> (
+            let block_type =
+              match cd.cstr_res.desc with
+              | Tconstr (path, _, _) -> (
+                match Env.find_type path pat.pat_env with
+                | {type_kind = Type_variant cstrs} ->
+                  Ext_list.find_opt cstrs (fun cstr ->
+                      if cstr.cd_id.name = cd.cstr_name then
+                        Ast_untagged_variants.get_block_type ~env:pat.pat_env
+                          cstr
+                      else None)
+                | _ -> None)
+              | _ -> None
+            in
+            match block_type with
+            | Some
+                ( IntType | StringType | FloatType | BigintType | BooleanType
+                | InstanceType _ | FunctionType | ObjectType ) ->
+              (* These types cannot be undefined *)
+              (id, lbl, pat_construct)
+            | _ -> x)
           | _ -> x
         in
         t.(lbl.lbl_pos) <- x)

tests/tests/src/pattern_match_json.mjs

@@ -0,0 +1,35 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function decodeGroup(group) {
+  let id = group.id;
+  if (id === null) {
+    return [
+      "e",
+      "f"
+    ];
+  }
+  if (typeof id !== "string") {
+    return [
+      "e",
+      "f"
+    ];
+  }
+  let name = group.name;
+  if (typeof name !== "string") {
+    return [
+      "e",
+      "f"
+    ];
+  } else {
+    return [
+      id,
+      name
+    ];
+  }
+}
+
+export {
+  decodeGroup,
+}
+/* No side effect */

tests/tests/src/pattern_match_json.res

@@ -0,0 +1,20 @@
+@unboxed
+type rec t =
+  | Boolean(bool)
+  | @as(null) Null
+  | String(string)
+  | Number(float)
+  | Object(Dict.t<t>)
+  | Array(array<t>)
+
+type group = {
+  id: string,
+  name: string,
+}
+
+let decodeGroup = group => {
+  switch group {
+  | dict{"id": String(id), "name": String(name)} => (id, name)
+  | _ => ("e", "f")
+  }
+}