Process @set annotation for field update as generating an uncurried function.

No need to use method types.
This is not user visible, except when hovering on the editor, where now no strange type shows up.
Clean up a bunch of infra for object method handling in the compiler front-end.

Author: cristianoc

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