make typechecker account for res.dictPattern attribute to infer record pattern as dict pattern match when the type is not already known

Author: zth

jscomp/build_tests/super_errors/expected/dict_pattern_inference.res.expected

@@ -0,0 +1,12 @@
+
+  We've found a bug for you!
+  /.../fixtures/dict_pattern_inference.res:3:36-42
+
+  1 │ let foo = dict =>
+  2 │   switch dict {
+  3 │   | @res.dictPattern {one: 1, two: "hello"} => Js.log("one")
+  4 │   | _ => Js.log("not one")
+  5 │   }
+
+  This pattern matches values of type string
+  but a pattern was expected which matches values of type int

jscomp/build_tests/super_errors/fixtures/dict_pattern_inference.res

@@ -0,0 +1,5 @@
+let foo = dict =>
+  switch dict {
+  | @res.dictPattern {one: 1, two: "hello"} => Js.log("one")
+  | _ => Js.log("not one")
+  }

jscomp/ml/dicts.ml

@@ -0,0 +1,5 @@
+let has_dict_pattern_attribute attrs =
+  attrs
+  |> List.find_opt (fun (({txt}, _) : Parsetree.attribute) ->
+          txt = "res.dictPattern")
+  |> Option.is_some

jscomp/ml/typecore.ml

@@ -1370,12 +1370,20 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
         | _            -> k None
       end
   | Ppat_record(lid_sp_list, closed) ->
-      let opath, record_ty =
+      let has_dict_pattern_attr = Dicts.has_dict_pattern_attribute sp.ppat_attributes in
+      let opath, record_ty = (
+      match (has_dict_pattern_attr, expected_ty.desc) with 
+      | (true, Tvar _) -> 
+        (* When this is a dict pattern and we don't have an actual expected type yet, 
+         infer the type as a dict with a new type variable. This let us hook into the 
+         existing inference mechanism for records in dict pattern matching too. *)
+        (Some (Predef.path_dict, Predef.path_dict), newgenty (Tconstr (Predef.path_dict, [newvar ()], ref Mnil)))
+      | _ ->
         try
           let (p0, p, _, _) = extract_concrete_record !env expected_ty in
           Some (p0, p), expected_ty
         with Not_found -> None, newvar ()
-      in
+      ) in
       let get_jsx_component_error_info = get_jsx_component_error_info ~extract_concrete_typedecl opath !env record_ty in
       let process_optional_label (ld, pat) =
         let exp_optional_attr = check_optional_attr !env ld pat.ppat_attributes pat.ppat_loc in

jscomp/test/DictTests.js

@@ -14,3 +14,11 @@ let intDict = dict{
   "two": 2,
   "three": three,
 }
+
+module PatternMatching = {
+  let foo = dict =>
+    switch dict {
+    | @res.dictPattern {one: 1} => Js.log("one")
+    | _ => Js.log("not one")
+    }
+}