Merge pull request #4984 from rescript-lang/simplify_method_call

simplify the method call

Author: bobzhang

jscomp/.merlin

@@ -15,6 +15,9 @@ B ounit
 S ounit_tests
 B ounit_tests
 
+S main
+B main
+
 S depends
 B depends
 

jscomp/core/lam_convert.ml

@@ -816,22 +816,20 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
       Lam.for_ id (convert_aux from_) (convert_aux to_) dir (convert_aux loop)
     | Lassign (id, body) ->
       Lam.assign id (convert_aux body)
-    | Lsend (Public(Some name), _, obj, _, _loc) ->
+    | Lsend (Public(Some name), _, obj, _, loc) ->
       (* Format.fprintf Format.err_formatter "%a@." Printlambda.lambda b ; *)
-        (match convert_aux obj with
-        | Lprim {primitive =  Pjs_unsafe_downgrade _;  args;loc}
-          ->
-              let setter = Ext_string.ends_with name Literals.setter_suffix in 
-              let property = 
-                if setter then   
-                  Lam_methname.translate 
-                    (String.sub name 0
-                       (String.length name - Literals.setter_suffix_len))
-                else Lam_methname.translate  name in 
-              prim ~primitive:(Pjs_unsafe_downgrade {name = property; setter})
-                ~args loc                
-        | _ ->
-          assert false)
+      let obj =  convert_aux obj in 
+      let args = [obj] in 
+      let setter = Ext_string.ends_with name Literals.setter_suffix in 
+      let property = 
+        if setter then   
+          Lam_methname.translate 
+            (String.sub name 0
+               (String.length name - Literals.setter_suffix_len))
+        else Lam_methname.translate  name in 
+      prim ~primitive:(Pjs_unsafe_downgrade {name = property; setter})
+        ~args loc                
+
     | Lsend _ -> assert false  
     | Levent _ ->
       (* disabled by upstream*)

jscomp/ext/literals.ml

@@ -53,7 +53,7 @@ let setter_suffix = "#="
 let setter_suffix_len = String.length setter_suffix
 
 let debugger = "debugger"
-let unsafe_downgrade = "unsafe_downgrade"
+
 let fn_run = "fn_run"
 let method_run = "method_run"
 

jscomp/frontend/ast_exp_apply.ml

@@ -177,7 +177,9 @@ let app_exp_mapper
             )
             ;
              pexp_loc}
-           (* f##paint  *)
+           (* f##paint  
+            TODO: this is not relevant: remove it later
+           *)
            ->
            sane_property_name_check pexp_loc name ;
            { e with pexp_desc =

jscomp/frontend/ast_uncurry_apply.ml

@@ -86,7 +86,7 @@ let method_apply  loc
       Ext_list.map args (fun (lbl,e) -> 
            Bs_syntaxerr.optional_err loc lbl; 
           (lbl,self.expr self e)) in
-    let fn = Exp.mk ~loc (Ast_util.js_property loc obj name) in   
+    let fn = Exp.send ~loc obj {txt = name;loc} in   
     let args  = 
       match args with 
       | [ Nolabel, {pexp_desc =
@@ -115,4 +115,4 @@ let uncurry_fn_apply loc self fn args =
 
 let property_apply loc self obj name args  
   =  generic_apply loc self obj args 
-    (fun loc obj -> Exp.mk ~loc (Ast_util.js_property loc obj name))
+    (fun loc obj -> Exp.send ~loc obj {txt = name; loc})

jscomp/frontend/ast_util.ml

@@ -29,11 +29,7 @@ type label_exprs = (Longident.t Asttypes.loc * Parsetree.expression) list
 
 let js_property loc obj (name : string) =
   Parsetree.Pexp_send
-    ((Ast_compatible.app1 ~loc
-        (Exp.ident ~loc
-           {loc;
-            txt = Ldot (Ast_literal.Lid.js_oo, Literals.unsafe_downgrade)})
-        obj), 
+    (obj, 
         {loc; txt = name}
         )
 

jscomp/frontend/bs_ast_invariant.ml

@@ -142,12 +142,6 @@ let emit_external_warnings : iterator=
         | Pexp_new _  -> 
           Location.raise_errorf ~loc:a.pexp_loc
             "OCaml style objects are not supported"
-        | Pexp_send (obj, _) ->
-          begin match obj with 
-            | {pexp_desc = Pexp_apply ({pexp_desc = Pexp_ident ({txt = Ldot(_,"unsafe_downgrade")})},_)} -> ()
-            | _ -> Location.raise_errorf ~loc:a.pexp_loc
-                     "OCaml style objects are not supported"
-          end
         | _ -> super.expr self a         
       );
     label_declaration = (fun self lbl ->     

jscomp/main/builtin_cmi_datasets.ml

@@ -24,8 +24,7 @@
 
 [@@@bs.config {flags = [|"-unboxed-types"|]}]
 (**/**)
-external unsafe_downgrade : 'a  -> 'a = "#unsafe_downgrade"
-external unsafe_to_method : 'a -> 'a = "#fn_method"
+external unsafe_to_method : 'a -> 'a =  "#fn_method"
 (**/**)
 module Callback = struct
   type 'a arity1 = {

jscomp/others/js_OO.ml

@@ -335,6 +335,8 @@ o test/gray_code_test.cmi test/gray_code_test.cmj : cc test/gray_code_test.ml |
 o test/guide_for_ext.cmi test/guide_for_ext.cmj : cc test/guide_for_ext.ml | $stdlib
 o test/hamming_test.cmi test/hamming_test.cmj : cc test/hamming_test.ml | test/mt.cmj $stdlib
 o test/hash_collision_test.cmi test/hash_collision_test.cmj : cc test/hash_collision_test.ml | test/mt.cmj $stdlib
+o test/hash_sugar_desugar.cmj : cc_cmi test/hash_sugar_desugar.ml | test/hash_sugar_desugar.cmi $stdlib
+o test/hash_sugar_desugar.cmi : cc test/hash_sugar_desugar.mli | $stdlib
 o test/hash_test.cmi test/hash_test.cmj : cc test/hash_test.ml | test/mt.cmj test/mt_global.cmj $stdlib
 o test/hashtbl_test.cmi test/hashtbl_test.cmj : cc test/hashtbl_test.ml | test/mt.cmj $stdlib
 o test/hello.foo.cmi test/hello.foo.cmj : cc test/hello.foo.ml | $stdlib