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")
+ }
+}