Remove processing of objects expressions, which don't exist in .res syntax

Author: cristianoc

CHANGELOG.md

@@ -48,6 +48,7 @@ These are only breaking changes for unformatted code.
 - Syntax: process uncurried types explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5784 https://github.com/rescript-lang/rescript-compiler/pull/5822
 - Syntax: process uncurried function declarations explicitly in the parser/printer https://github.com/rescript-lang/rescript-compiler/pull/5794
 - PPX V4: allow uncurried `make` function and treat it like a curried one [#5802](https://github.com/rescript-lang/rescript-compiler/pull/5802) [#5808](https://github.com/rescript-lang/rescript-compiler/pull/5808) [#5812](https://github.com/rescript-lang/rescript-compiler/pull/5812)
+- Remove processing of objects expressions, which don't exist in `.res` syntax (`Pexp_object`).
 
 # 10.1.0-rc.6
 

jscomp/frontend/ast_util.ml

@@ -22,172 +22,11 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-open Ast_helper
-
 type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
 
 let js_property loc obj (name : string) =
   Parsetree.Pexp_send (obj, { loc; txt = name })
 
-let ocaml_obj_as_js_object loc (mapper : Bs_ast_mapper.mapper)
-    (self_pat : Parsetree.pattern) (clfs : Parsetree.class_field list) =
-  (* Attention: we should avoid type variable conflict for each method
-      Since the method name is unique, there would be no conflict
-      OCaml does not allow duplicate instance variable and duplicate methods,
-      but it does allow duplicates between instance variable and method name,
-      we should enforce such rules
-     {[
-       object [@bs]
-         val x = 3
-         method x = 3
-       end
-     ]} should not compile with a meaningful error message
-  *)
-  let generate_val_method_pair loc (mapper : Bs_ast_mapper.mapper)
-      (val_name : string Asttypes.loc) is_mutable =
-    let result = Typ.var ~loc val_name.txt in
-    ( result,
-      Parsetree.Otag (val_name, [], result)
-      ::
-      (if is_mutable then
-       [
-         Otag
-           ( { val_name with txt = val_name.txt ^ Literals.setter_suffix },
-             [],
-             Ast_typ_uncurry.to_method_type loc mapper Nolabel result
-               (Ast_literal.type_unit ~loc ()) );
-       ]
-      else []) )
-  in
-
-  (* Note mapper is only for API compatible 
-   * TODO: we should check label name to avoid conflict 
-   *)
-
-  (* we need calculate the real object type
-      and exposed object type, in some cases there are equivalent
-
-      for public object type its [@meth] it does not depend on itself
-      while for label argument it is [@this] which depends internal object
-  *)
-  let ( (internal_label_attr_types : Parsetree.object_field list),
-        (public_label_attr_types : Parsetree.object_field list) ) =
-    Ext_list.fold_right clfs ([], [])
-      (fun
-        ({ pcf_loc = loc } as x : Parsetree.class_field)
-        (label_attr_types, public_label_attr_types)
-      ->
-        match x.pcf_desc with
-        | Pcf_method (label, public_flag, Cfk_concrete (Fresh, e)) -> (
-            match e.pexp_desc with
-            | Pexp_poly ({ pexp_desc = Pexp_fun (lbl, _, pat, e) }, None) ->
-                let method_type =
-                  Ast_typ_uncurry.generate_arg_type x.pcf_loc mapper label.txt
-                    lbl pat e
-                in
-                ( Parsetree.Otag (label, [], method_type) :: label_attr_types,
-                  if public_flag = Public then
-                    Parsetree.Otag (label, [], method_type)
-                    :: public_label_attr_types
-                  else public_label_attr_types )
-            | Pexp_poly (_, Some _) ->
-                Location.raise_errorf ~loc
-                  "polymorphic type annotation not supported yet"
-            | Pexp_poly (_, None) ->
-                Location.raise_errorf ~loc
-                  "Unsupported syntax, expect syntax like `method x () = x ` "
-            | _ -> Location.raise_errorf ~loc "Unsupported syntax in js object")
-        | Pcf_val (label, mutable_flag, Cfk_concrete (Fresh, _)) ->
-            let _, label_attr =
-              generate_val_method_pair x.pcf_loc mapper label
-                (mutable_flag = Mutable)
-            in
-            ( Ext_list.append label_attr label_attr_types,
-              public_label_attr_types )
-        | Pcf_val (_, _, Cfk_concrete (Override, _)) ->
-            Location.raise_errorf ~loc "override flag not support currently"
-        | Pcf_val (_, _, Cfk_virtual _) ->
-            Location.raise_errorf ~loc "virtual flag not support currently"
-        | Pcf_method (_, _, Cfk_concrete (Override, _)) ->
-            Location.raise_errorf ~loc "override flag not supported"
-        | Pcf_method (_, _, Cfk_virtual _) ->
-            Location.raise_errorf ~loc "virtural method not supported"
-        | Pcf_inherit _ | Pcf_initializer _ | Pcf_attribute _ | Pcf_extension _
-        | Pcf_constraint _ ->
-            Location.raise_errorf ~loc "Only method support currently")
-  in
-  let internal_obj_type =
-    Ast_core_type.make_obj ~loc internal_label_attr_types
-  in
-  let public_obj_type = Ast_core_type.make_obj ~loc public_label_attr_types in
-  let labels, label_types, exprs, _ =
-    Ext_list.fold_right clfs ([], [], [], false)
-      (fun (x : Parsetree.class_field) (labels, label_types, exprs, aliased) ->
-        match x.pcf_desc with
-        | Pcf_method (label, _public_flag, Cfk_concrete (Fresh, e)) -> (
-            match e.pexp_desc with
-            | Pexp_poly
-                (({ pexp_desc = Pexp_fun (ll, None, pat, e) } as f), None) ->
-                let alias_type =
-                  if aliased then None else Some internal_obj_type
-                in
-                let label_type =
-                  Ast_typ_uncurry.generate_method_type ?alias_type x.pcf_loc
-                    mapper label.txt ll pat e
-                in
-                ( label :: labels,
-                  label_type :: label_types,
-                  {
-                    f with
-                    pexp_desc =
-                      (let f = Ast_pat.is_unit_cont pat ~yes:e ~no:f in
-                       Ast_uncurry_gen.to_method_callback loc mapper Nolabel
-                         self_pat f)
-                      (* the first argument is this*);
-                  }
-                  :: exprs,
-                  true )
-            | Pexp_poly (_, Some _) ->
-                Location.raise_errorf ~loc
-                  "polymorphic type annotation not supported yet"
-            | Pexp_poly (_, None) ->
-                Location.raise_errorf ~loc
-                  "Unsupported syntax, expect syntax like `method x () = x ` "
-            | _ -> Location.raise_errorf ~loc "Unsupported syntax in js object")
-        | Pcf_val (label, mutable_flag, Cfk_concrete (Fresh, val_exp)) ->
-            let label_type, _ =
-              generate_val_method_pair x.pcf_loc mapper label
-                (mutable_flag = Mutable)
-            in
-            ( label :: labels,
-              label_type :: label_types,
-              mapper.expr mapper val_exp :: exprs,
-              aliased )
-        | Pcf_val (_, _, Cfk_concrete (Override, _)) ->
-            Location.raise_errorf ~loc "override flag not support currently"
-        | Pcf_val (_, _, Cfk_virtual _) ->
-            Location.raise_errorf ~loc "virtual flag not support currently"
-        | Pcf_method (_, _, Cfk_concrete (Override, _)) ->
-            Location.raise_errorf ~loc "override flag not supported"
-        | Pcf_method (_, _, Cfk_virtual _) ->
-            Location.raise_errorf ~loc "virtural method not supported"
-        | Pcf_inherit _ | Pcf_initializer _ | Pcf_attribute _ | Pcf_extension _
-        | Pcf_constraint _ ->
-            Location.raise_errorf ~loc "Only method support currently")
-  in
-  let pval_type =
-    Ext_list.fold_right2 labels label_types public_obj_type
-      (fun label label_type acc ->
-        Ast_compatible.label_arrow ~loc:label.Asttypes.loc label.Asttypes.txt
-          label_type acc)
-  in
-  Ast_external_mk.local_extern_cont_to_obj loc
-    ~pval_prim:(Ast_external_process.pval_prim_of_labels labels)
-    (fun e ->
-      Ast_compatible.apply_labels ~loc e
-        (Ext_list.map2 labels exprs (fun l expr -> (l.txt, expr))))
-    ~pval_type
-
 let record_as_js_object loc (self : Bs_ast_mapper.mapper)
     (label_exprs : label_exprs) : Parsetree.expression_desc =
   let labels, args, arity =

jscomp/frontend/ast_util.mli

@@ -35,10 +35,3 @@ val record_as_js_object :
 
 val js_property :
   Location.t -> Parsetree.expression -> string -> Parsetree.expression_desc
-
-val ocaml_obj_as_js_object :
-  Location.t ->
-  Bs_ast_mapper.mapper ->
-  Parsetree.pattern ->
-  Parsetree.class_field list ->
-  Parsetree.expression_desc

jscomp/frontend/bs_builtin_ppx.ml

@@ -155,22 +155,6 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
             pexp_attributes;
           })
   | Pexp_apply (fn, args) -> Ast_exp_apply.app_exp_mapper e self fn args
-  | Pexp_object { pcstr_self; pcstr_fields } ->
-      let pexp_attributes =
-        match Ast_attributes.process_bs e.pexp_attributes with
-        | true, pexp_attributes ->
-            Location.prerr_warning e.pexp_loc
-              (Bs_ffi_warning "Here @bs attribute not needed any more");
-            pexp_attributes
-        | false, e -> e
-      in
-      {
-        e with
-        pexp_desc =
-          Ast_util.ocaml_obj_as_js_object e.pexp_loc self pcstr_self
-            pcstr_fields;
-        pexp_attributes;
-      }
   | Pexp_match
       ( b,
         [

jscomp/test/arity_ml.js

@@ -66,27 +66,6 @@ function mk_f(param) {
   };
 }
 
-function omk_f(param) {
-  return {
-          huge_methdo: (function (a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) {
-              return Curry.app(a0, [
-                          a1,
-                          a2,
-                          a3,
-                          a4,
-                          a5,
-                          a6,
-                          a7,
-                          a8,
-                          a9,
-                          a10,
-                          a11,
-                          a12
-                        ]);
-            })
-        };
-}
-
 exports.sum_float_array = sum_float_array;
 exports.sum_int_array = sum_int_array;
 exports.sum_poly = sum_poly;
@@ -96,5 +75,4 @@ exports.ff = ff;
 exports.ff2 = ff2;
 exports.off2 = off2;
 exports.mk_f = mk_f;
-exports.omk_f = omk_f;
 /* No side effect */

jscomp/test/arity_ml.ml

@@ -68,10 +68,3 @@ let off2 o  a0  a1  a2  a3  a4  a5  a6  a7  a8  a9  a10  a11 a12 =
 let mk_f () = 
   fun [@bs] a0  a1  a2  a3  a4  a5  a6  a7  a8  a9  a10  a11 a12 -> 
   a0  a1  a2  a3  a4  a5  a6  a7  a8  a9  a10  a11 a12
-
-(* Test [fn_method] *)
-let omk_f ()= 
-  object
-   method huge_methdo a0  a1  a2  a3  a4  a5  a6  a7  a8  a9  a10  a11 a12 =
-  a0  a1  a2  a3  a4  a5  a6  a7  a8  a9  a10  a11 a12
-end 

jscomp/test/build.ninja

@@ -80,32 +80,16 @@ var same_type = [
   same_type_1
 ];
 
-var v_obj = {
-  hi: (function () {
-      console.log("hei");
-    })
-};
-
-eq("File \"ffi_js_test.ml\", line 44, characters 5-12", [
+eq("File \"ffi_js_test.ml\", line 41, characters 5-12", [
       Object.keys(int_config).length,
       2
     ]);
 
-eq("File \"ffi_js_test.ml\", line 45, characters 5-12", [
+eq("File \"ffi_js_test.ml\", line 42, characters 5-12", [
       Object.keys(string_config).length,
       2
     ]);
 
-eq("File \"ffi_js_test.ml\", line 46, characters 5-12", [
-      Object.keys(v_obj).indexOf("hi_x"),
-      -1
-    ]);
-
-eq("File \"ffi_js_test.ml\", line 47, characters 5-12", [
-      Object.keys(v_obj).indexOf("hi"),
-      0
-    ]);
-
 var u = {
   contents: 3
 };
@@ -115,7 +99,7 @@ var side_effect_config = (u.contents = u.contents + 1 | 0, {
     low: 32
   });
 
-eq("File \"ffi_js_test.ml\", line 54, characters 5-12", [
+eq("File \"ffi_js_test.ml\", line 49, characters 5-12", [
       u.contents,
       4
     ]);
@@ -183,7 +167,6 @@ exports.eq = eq;
 exports.int_config = int_config;
 exports.string_config = string_config;
 exports.same_type = same_type;
-exports.v_obj = v_obj;
 exports.u = u;
 exports.side_effect_config = side_effect_config;
 exports.vv = vv;

jscomp/test/class_type_ffi_test.js

@@ -37,14 +37,9 @@ let same_type =
    [string_config ; [%obj{hi = 3 ; low = "32"}]]
   )
 
-let v_obj = object method hi__x () = Js.log "hei" end
-
-
 let () =
   eq __LOC__ (Array.length (Js_obj.keys int_config), 2 );
-  eq __LOC__ (Array.length (Js_obj.keys string_config), 2 );
-  eq __LOC__ (Js_obj.keys v_obj |. Js.Array2.indexOf "hi_x" , -1 );
-  eq __LOC__ (Js_obj.keys v_obj |. Js.Array2.indexOf "hi", 0 )
+  eq __LOC__ (Array.length (Js_obj.keys string_config), 2 )
 
 let u = ref 3