Process @set annotation for field update as generating an uncurried…

CHANGELOG.md

@@ -52,6 +52,7 @@ These are only breaking changes for unformatted code.
 - Remove class type processing from compiler ppx https://github.com/rescript-lang/rescript-compiler/pull/5842
 - Remove method application via operator `##`, which does not exist in `.res` syntax https://github.com/rescript-lang/rescript-compiler/pull/5844
 - Treat `@meth` annotation as making the type uncurried for backwards compatibitly with some examples https://github.com/rescript-lang/rescript-compiler/pull/5845
+- Process `@set` annotation for field update as generating an uncurried function https://github.com/rescript-lang/rescript-compiler/pull/5846
 
 # 10.1.0-rc.6
 

jscomp/frontend/ast_core_type_class_type.ml

@@ -120,7 +120,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) =
                     | Meth_callback attr, attrs -> (attrs, attr +> ty)
                   in
                   Ast_compatible.object_field name attrs
-                    (Ast_typ_uncurry.to_method_type loc self Nolabel core_type
+                    (Ast_typ_uncurry.to_uncurry_type loc self Nolabel core_type
                        (Ast_literal.type_unit ~loc ()))
                 in
                 let not_getter_setter ty =

jscomp/frontend/ast_exp_apply.ml

@@ -182,14 +182,16 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
   | Some { op = "#="; loc; args = [ obj; arg ] } -> (
       let gen_assignment obj name name_loc =
         sane_property_name_check name_loc name;
+        let obj = self.expr self obj in
+        let arg = self.expr self arg in
+        let fn =
+          Exp.send ~loc obj { txt = name ^ Literals.setter_suffix; loc }
+        in
         Exp.constraint_ ~loc
-          {
-            e with
-            pexp_desc =
-              Ast_uncurry_apply.method_apply loc self obj
-                (name ^ Literals.setter_suffix)
-                [ (Nolabel, arg) ];
-          }
+          (Exp.apply ~loc
+             ~attrs:[ Ast_attributes.res_uapp ]
+             fn
+             [ (Nolabel, arg) ])
           (Ast_literal.type_unit ~loc ())
       in
       match obj.pexp_desc with

jscomp/frontend/ast_literal.ml

@@ -59,8 +59,6 @@ module Lid = struct
 
   let js_oo : t = Lident "Js_OO"
 
-  let js_meth : t = Ldot (js_oo, "Meth")
-
   let js_meth_callback : t = Ldot (js_oo, "Callback")
 
   let ignore_id : t = Ldot (Lident "Pervasives", "ignore")

jscomp/frontend/ast_literal.mli

@@ -47,8 +47,6 @@ module Lid : sig
 
   val js_oo : t
 
-  val js_meth : t
-
   val js_meth_callback : t
 
   val hidden_field : string -> t

jscomp/frontend/ast_typ_uncurry.ml

@@ -48,73 +48,6 @@ let to_method_callback_type loc (mapper : Bs_ast_mapper.mapper)
         [ meth_type ]
   | None -> assert false
 
-let self_type_lit = "self_type"
-
-let generate_method_type loc (mapper : Bs_ast_mapper.mapper) ?alias_type
-    method_name lbl pat e : Parsetree.core_type =
-  let arity = Ast_pat.arity_of_fun pat e in
-  let result = Typ.var ~loc method_name in
-  let self_type loc = Typ.var ~loc self_type_lit in
-
-  let self_type =
-    let v = self_type loc in
-    match alias_type with
-    | None -> v
-    | Some ty -> Typ.alias ~loc ty self_type_lit
-  in
-  if arity = 0 then to_method_callback_type loc mapper Nolabel self_type result
-  else
-    let tyvars =
-      Ext_list.mapi (lbl :: Ast_pat.labels_of_fun e) (fun i x ->
-          (x, Typ.var ~loc (method_name ^ string_of_int i)))
-      (* Ext_list.init arity (fun i -> Typ.var ~loc (method_name ^ string_of_int i)) *)
-    in
-    match tyvars with
-    | (label, x) :: rest ->
-        let method_rest =
-          Ext_list.fold_right rest result (fun (label, v) acc ->
-              Typ.arrow ~loc label v acc)
-        in
-        to_method_callback_type loc mapper Nolabel self_type
-          (Typ.arrow ~loc label x method_rest)
-    | _ -> assert false
-
-let to_method_type loc (mapper : Bs_ast_mapper.mapper)
-    (label : Asttypes.arg_label) (first_arg : Parsetree.core_type)
-    (typ : Parsetree.core_type) =
-  let first_arg = mapper.typ mapper first_arg in
-  let typ = mapper.typ mapper typ in
-  let meth_type = Typ.arrow ~loc label first_arg typ in
-  let arity = Ast_core_type.get_uncurry_arity meth_type in
-  match arity with
-  | Some 0 ->
-      Typ.constr { txt = Ldot (Ast_literal.Lid.js_meth, "arity0"); loc } [ typ ]
-  | Some n ->
-      Typ.constr
-        { txt = Ldot (Ast_literal.Lid.js_meth, "arity" ^ string_of_int n); loc }
-        [ meth_type ]
-  | None -> assert false
-
-let generate_arg_type loc (mapper : Bs_ast_mapper.mapper) method_name label pat
-    body : Ast_core_type.t =
-  let arity = Ast_pat.arity_of_fun pat body in
-  let result = Typ.var ~loc method_name in
-  if arity = 0 then
-    to_method_type loc mapper Nolabel (Ast_literal.type_unit ~loc ()) result
-  else
-    let tyvars =
-      Ext_list.mapi (label :: Ast_pat.labels_of_fun body) (fun i x ->
-          (x, Typ.var ~loc (method_name ^ string_of_int i)))
-    in
-    match tyvars with
-    | (label, x) :: rest ->
-        let method_rest =
-          Ext_list.fold_right rest result (fun (label, v) acc ->
-              Typ.arrow ~loc label v acc)
-        in
-        to_method_type loc mapper label x method_rest
-    | _ -> assert false
-
 let to_uncurry_type loc (mapper : Bs_ast_mapper.mapper)
     (label : Asttypes.arg_label) (first_arg : Parsetree.core_type)
     (typ : Parsetree.core_type) =

jscomp/frontend/ast_typ_uncurry.mli

@@ -54,31 +54,7 @@ val to_uncurry_type : uncurry_type_gen
     {[ int -> int -> int [@bs]]}
 *)
 
-val to_method_type : uncurry_type_gen
-(** syntax
-    {[ method : int -> itn -> int ]}
-*)
-
 val to_method_callback_type : uncurry_type_gen
 (** syntax:
     {[ 'obj -> int -> int [@bs.this] ]}
 *)
-
-val generate_method_type :
-  Location.t ->
-  Bs_ast_mapper.mapper ->
-  ?alias_type:Parsetree.core_type ->
-  string ->
-  Asttypes.arg_label ->
-  Parsetree.pattern ->
-  Parsetree.expression ->
-  Parsetree.core_type
-
-val generate_arg_type :
-  Location.t ->
-  Bs_ast_mapper.mapper ->
-  string ->
-  Asttypes.arg_label ->
-  Parsetree.pattern ->
-  Parsetree.expression ->
-  Parsetree.core_type

jscomp/others/js_OO.ml

@@ -94,87 +94,3 @@ module Callback = struct
     i22 : 'a [@internal]
   }  
 end  
-module Meth = struct
-  type + 'a arity0 
-  type 'a arity1 = {
-    i1 : 'a [@internal]
-  }
-  type 'a arity2 = {
-    i2 : 'a [@internal]
-  }
-  type 'a arity3 = {
-    i3 : 'a [@internal]
-  }
-  type 'a arity4 = {
-    i4 : 'a [@internal]
-  }
-  type 'a arity5 = {
-    i5 : 'a [@internal]
-  }
-  type 'a arity6 = {
-    i6 : 'a [@internal]
-  }
-  type 'a arity7 = {
-    i7 : 'a [@internal]
-  }
-  type 'a arity8 = {
-    i8 : 'a [@internal]
-  }
-  type 'a arity9 = {
-    i9 : 'a [@internal]
-  }
-  type 'a arity10 = {
-    i10 : 'a [@internal]
-  }
-  type 'a arity11 = {
-    i11 : 'a [@internal]
-  }
-  type 'a arity12 = {
-    i12 : 'a [@internal]
-  }
-  type 'a arity13 = {
-    i13 : 'a [@internal]
-  }
-  type 'a arity14 = {
-    i14 : 'a [@internal]
-  }
-  type 'a arity15 = {
-    i15 : 'a [@internal]
-  }
-  type 'a arity16 = {
-    i16 : 'a [@internal]
-  }
-  type 'a arity17 = {
-    i17 : 'a [@internal]
-  }
-  type 'a arity18 = {
-    i18 : 'a [@internal]
-  }
-  type 'a arity19 = {
-    i19 : 'a [@internal]
-  }
-  type 'a arity20 = {
-    i20 : 'a [@internal]
-  }
-  type 'a arity21 = {
-    i21 : 'a [@internal]
-  }
-  type 'a arity22 = {
-    i22 : 'a [@internal]
-  }
-end
-
-(**/**)
-module Internal = struct
-  open Meth
-  (* Use opaque instead of `._n` to prevent some optimizations happening *)
-
-  external run : 'a arity0 -> 'a = "#run" "0"
-  (* FIXME: remove the need for native string
-    x##meth a b --> 
-    fullApppy (
-        (id (unsafe_downgrade x)#meth).I_2) 
-        a b)
-  *)  
-end  
-(**/**)

jscomp/test/set_annotation.js

@@ -0,0 +1,7 @@
+'use strict';
+
+var MyJSFile = require("MyJSFile");
+
+MyJSFile.student1.name = "Mary";
+
+/*  Not a pure module */

jscomp/test/set_annotation.res

@@ -0,0 +1,7 @@
+type student = {
+  @set "age": int,
+  @set "name": string,
+}
+@module("MyJSFile") external student1: student = "student1"
+
+student1["name"] = "Mary"