Merge 11.0.1 changes into master (#6579)

Author: cknitt

CHANGELOG.md

@@ -12,6 +12,18 @@
 
 # 12.0.0-alpha.1 (Unreleased)
 
+# 11.0.1
+
+#### :bug: Bug Fix
+
+- Renamed inline record fields: fix renamed field access in inline records. https://github.com/rescript-lang/rescript-compiler/pull/6551
+- Fixed issue with coercions sometimes raising a `Not_found` instead of giving a proper error message. https://github.com/rescript-lang/rescript-compiler/pull/6574
+- Fix issue with recursive modules and uncurried. https://github.com/rescript-lang/rescript-compiler/pull/6575
+
+#### :nail_care: Polish
+
+- Improve error message for missing label(s) in function application. https://github.com/rescript-lang/rescript-compiler/pull/6576
+
 # 11.0.0
 
 No changes compared to rc.9.

jscomp/build_tests/super_errors/expected/missing_label.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/missing_label.res:3:9
+
+  1 │ let f = (~a) => a ++ ""
+  2 │ 
+  3 │ let _ = f("")
+  4 │ 
+
+  Label ~a was omitted in the application of this labeled function.

jscomp/build_tests/super_errors/expected/missing_labels.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/missing_labels.res:3:9
+
+  1 │ let f = (~a, ~b) => a ++ b
+  2 │ 
+  3 │ let _ = f("", "")
+  4 │ 
+
+  Labels ~a, ~b were omitted in the application of this labeled function.

jscomp/build_tests/super_errors/fixtures/missing_label.res

@@ -0,0 +1,3 @@
+let f = (~a) => a ++ ""
+
+let _ = f("")

jscomp/build_tests/super_errors/fixtures/missing_labels.res

@@ -0,0 +1,3 @@
+let f = (~a, ~b) => a ++ b
+
+let _ = f("", "")

jscomp/core/bs_conditional_initial.ml

@@ -44,10 +44,6 @@ let setup_env () =
   Builtin_attributes.check_bs_attributes_inclusion := Record_attributes_check.check_bs_attributes_inclusion;
   Builtin_attributes.check_duplicated_labels :=
     Record_attributes_check.check_duplicated_labels;
-  Lambda.fld_record := Record_attributes_check.fld_record;
-  Lambda.fld_record_set := Record_attributes_check.fld_record_set;
-  Lambda.blk_record := Record_attributes_check.blk_record;
-  Lambda.blk_record_inlined := Record_attributes_check.blk_record_inlined;
   Matching.names_from_construct_pattern := 
     Matching_polyfill.names_from_construct_pattern;
 

jscomp/core/record_attributes_check.ml

@@ -24,7 +24,7 @@
 
 type label = Types.label_description
 
-let find_name = Matching.find_name
+let find_name = Lambda.find_name
 
 let find_name_with_loc (attr : Parsetree.attribute) : string Asttypes.loc option
     =
@@ -40,34 +40,6 @@ let find_name_with_loc (attr : Parsetree.attribute) : string Asttypes.loc option
       Some { txt = s; loc }
   | _ -> None
 
-let fld_record (lbl : label) =
-  Lambda.Fld_record
-    {
-      name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name;
-      mutable_flag = lbl.lbl_mut;
-    }
-
-let fld_record_set (lbl : label) =
-  Lambda.Fld_record_set
-    (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
-
-let blk_record (fields : (label * _) array) mut record_repr =
-  let all_labels_info =
-    Ext_array.map fields (fun (lbl, _) ->
-        Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
-  in
-  Lambda.Blk_record
-    { fields = all_labels_info; mutable_flag = mut; record_repr }
-
-let blk_record_inlined fields name num_nonconst optional_labels ~tag ~attrs mutable_flag =
-  let fields =
-    Array.map
-      (fun ((lbl : label), _) ->
-        Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
-      fields
-  in
-  Lambda.Blk_record_inlined {fields; name; num_nonconst; tag; mutable_flag; optional_labels; attrs }
-
 let check_bs_attributes_inclusion (attrs1 : Parsetree.attributes)
     (attrs2 : Parsetree.attributes) lbl_name =
   let a = Ext_list.find_def attrs1 find_name lbl_name in

jscomp/gentype_tests/typescript-react-example/package-lock.json

@@ -10,7 +10,7 @@
     "lint": "eslint src"
   },
   "dependencies": {
-    "@rescript/react": "^0.11.0",
+    "@rescript/react": "^0.12.0",
     "react": "^18.2.0",
     "react-dom": "^18.2.0"
   },

jscomp/gentype_tests/typescript-react-example/package.json

@@ -99,7 +99,7 @@ module ForwardRef = {
   )
 }
 
-@genType type callback<'input, 'output> = React.callback<'input, 'output>
+@genType type callback<'input, 'output> = 'input => 'output
 
 @genType type testReactContext = React.Context.t<int>
 

jscomp/gentype_tests/typescript-react-example/src/Hooks.res

@@ -1,4 +1,4 @@
 open ReactV3
 
 @genType
-type cb = React.callback<int, string>
+type cb = int => string

jscomp/gentype_tests/typescript-react-example/src/V3Compatibility.res

@@ -3904,6 +3904,11 @@ let subtypes = TypePairs.create 17
 let subtype_error env trace =
   raise (Subtype (expand_trace env (List.rev trace), []))
 
+let extract_concrete_typedecl_opt env t = 
+  match extract_concrete_typedecl env t with 
+  | v -> Some v 
+  | exception Not_found -> None
+
 let rec subtype_rec env trace t1 t2 cstrs =
   let t1 = repr t1 in
   let t2 = repr t2 in
@@ -3960,23 +3965,23 @@ let rec subtype_rec env trace t1 t2 cstrs =
     | (Tconstr(p1, [], _), Tconstr(p2, [], _)) when Path.same p1 Predef.path_int && Path.same p2 Predef.path_float ->
         cstrs 
     | (Tconstr(path, [], _), Tconstr(_, [], _)) when Variant_coercion.can_coerce_primitive path && 
-        extract_concrete_typedecl env t2 |> Variant_coercion.can_try_coerce_variant_to_primitive |> Option.is_some
+        extract_concrete_typedecl_opt env t2 |> Variant_coercion.can_try_coerce_variant_to_primitive_opt |> Option.is_some
         ->
       (* type coercion for primitives (int/float/string) to elgible unboxed variants:
          - must be unboxed
          - must have a constructor case with a supported and matching primitive payload *)
-      (match Variant_coercion.can_try_coerce_variant_to_primitive (extract_concrete_typedecl env t2) with
+      (match Variant_coercion.can_try_coerce_variant_to_primitive_opt (extract_concrete_typedecl_opt env t2) with
       | Some (constructors, true) -> 
         if Variant_coercion.variant_has_catch_all_case constructors (fun p -> Path.same p path) then
           cstrs
         else 
           (trace, t1, t2, !univar_pairs)::cstrs
       | _ -> (trace, t1, t2, !univar_pairs)::cstrs)
     | (Tconstr(_, [], _), Tconstr(path, [], _)) when Variant_coercion.can_coerce_primitive path && 
-        extract_concrete_typedecl env t1 |> Variant_coercion.can_try_coerce_variant_to_primitive |> Option.is_some
+        extract_concrete_typedecl_opt env t1 |> Variant_coercion.can_try_coerce_variant_to_primitive_opt |> Option.is_some
         ->
       (* type coercion for variants to primitives *)
-      (match Variant_coercion.can_try_coerce_variant_to_primitive (extract_concrete_typedecl env t1) with
+      (match Variant_coercion.can_try_coerce_variant_to_primitive_opt (extract_concrete_typedecl_opt env t1) with
       | Some (constructors, unboxed) -> 
         if constructors |> Variant_coercion.variant_has_same_runtime_representation_as_target ~targetPath:path ~unboxed then
           cstrs

jscomp/ml/ctype.ml

@@ -86,21 +86,47 @@ let mutable_flag_of_tag_info (tag : tag_info) =
   | Blk_some 
    -> Immutable
 
+type label = Types.label_description
+
+let find_name (attr : Parsetree.attribute) =
+  match attr with
+  | ( { txt = "bs.as" | "as" },
+      PStr
+        [
+          {
+            pstr_desc =
+              Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (s, _)) }, _);
+          };
+        ] ) ->
+      Some s
+  | _ -> None
+     
+let blk_record (fields : (label * _) array) mut record_repr =
+  let all_labels_info =
+    Ext_array.map fields (fun (lbl, _) ->
+        Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
+  in
+  Blk_record
+    { fields = all_labels_info; mutable_flag = mut; record_repr }
 
-let blk_record = ref (fun _ _ _ -> 
-  assert false
-  )
-
-
-let blk_record_ext =  ref (fun fields mutable_flag -> 
-    let all_labels_info = fields |> Array.map (fun (x,_) -> x.Types.lbl_name) in    
-    Blk_record_ext {fields = all_labels_info; mutable_flag }
-  )
 
-let blk_record_inlined = ref (fun fields name num_nonconst optional_labels ~tag ~attrs mutable_flag -> 
-  let fields = fields |> Array.map (fun (x,_) -> x.Types.lbl_name) in    
+let blk_record_ext fields mutable_flag =
+  let all_labels_info =
+    Array.map
+      (fun ((lbl : label), _) ->
+        Ext_list.find_def lbl.Types.lbl_attributes find_name lbl.lbl_name)
+      fields
+  in
+  Blk_record_ext {fields = all_labels_info; mutable_flag }
+
+let blk_record_inlined fields name num_nonconst optional_labels ~tag ~attrs mutable_flag =
+  let fields =
+    Array.map
+      (fun ((lbl : label), _) ->
+        Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
+      fields
+  in
   Blk_record_inlined {fields; name; num_nonconst; tag; mutable_flag; optional_labels; attrs }
-) 
 
 let ref_tag_info : tag_info = 
   Blk_record {fields = [| "contents" |]; mutable_flag = Mutable; record_repr = Record_regular}
@@ -117,9 +143,17 @@ type field_dbg_info =
   | Fld_variant
   | Fld_cons 
   | Fld_array
-  
-let fld_record = ref (fun (lbl : Types.label_description) ->
-  Fld_record {name = lbl.lbl_name; mutable_flag = Mutable})
+
+let fld_record (lbl : label) =
+  Fld_record
+    {
+      name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name;
+      mutable_flag = lbl.lbl_mut;
+    }
+
+let fld_record_extension (lbl : label) =
+  Fld_record_extension
+    { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name }
 
 let ref_field_info : field_dbg_info = 
   Fld_record { name = "contents"; mutable_flag = Mutable}
@@ -131,8 +165,21 @@ type set_field_dbg_info =
     | Fld_record_extension_set of string
 
 let ref_field_set_info : set_field_dbg_info = Fld_record_set "contents"    
-let fld_record_set = ref ( fun (lbl : Types.label_description) ->
-  Fld_record_set lbl.lbl_name  )
+let fld_record_set (lbl : label) =
+  Fld_record_set
+    (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
+
+let fld_record_inline (lbl : label) =
+  Fld_record_inline
+    { name = Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name }
+
+let fld_record_inline_set (lbl : label) =
+  Fld_record_inline_set
+    (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
+
+let fld_record_extension_set (lbl : label) =
+  Fld_record_extension_set
+    (Ext_list.find_def lbl.lbl_attributes find_name lbl.lbl_name)
 
 type immediate_or_pointer =
   | Immediate