Merge pull request #4072 from BuckleScript/clean_up_method_encoding

bobzhang · web-flow · commit 1adc1bc27baa · 2020-01-02T16:29:11.000+08:00
clean up method compilation
diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml
@@ -175,7 +175,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Pjs_unsafe_downgrade _
       | Pdebugger 
       | Pjs_fn_run _ 
-      | Pjs_fn_method _ | Pjs_fn_runmethod _
+      | Pjs_fn_method _ 
       (* TODO *)
       | Praw_js_code_exp _ 
       | Praw_js_code_stmt _
diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml
@@ -1432,13 +1432,14 @@ and compile_prim (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t
        we need mark something that such eta-conversion can not be simplified in some cases
     *)
 
-    |  {primitive = Pjs_unsafe_downgrade (name,loc); args = [obj]}
-      when not (Ext_string.ends_with name Literals.setter_suffix)
+    |  {primitive = Pjs_unsafe_downgrade {name = property;loc; setter }; args = [obj]}
+      
       ->
       (**
          either a getter {[ x #. height ]} or {[ x ## method_call ]}
       *)
-      let property =  Lam_methname.translate ~loc name  in      
+      assert (not setter);
+    
       (match compile_lambda {lambda_cxt with continuation = NeedValue Not_tail} obj
        with
        | {value = None} -> assert false
@@ -1451,7 +1452,7 @@ and compile_prim (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t
              | Some (x, b) ->
                Ext_list.append_one block  x,  E.dot (E.var b) property in
          Js_output.output_of_block_and_expression lambda_cxt.continuation blocks ret)
-    | {primitive = Pjs_fn_run arity;  args = args_lambda}
+    | {primitive = Pjs_fn_run _;  args = args_lambda}
       ->
       (* 1. prevent eta-conversion
          by using [App_js_full]
@@ -1463,10 +1464,11 @@ and compile_prim (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t
       (match args_lambda with
        | [Lprim{
            primitive =
-             Pjs_unsafe_downgrade(method_name,loc);
-           args = [obj]} as fn;
-          arg]
-         ->
+             Pjs_unsafe_downgrade {name = property; loc; setter = true};
+           args = args_l} ;
+          arg] (** x##name arg  could be specialized as a setter *)         
+          ->
+         let obj = Ext_list.singleton_exn args_l in         
          let need_value_no_return_cxt = {lambda_cxt with continuation = NeedValue Not_tail} in
          let obj_output = compile_lambda  need_value_no_return_cxt obj in
          let arg_output = compile_lambda need_value_no_return_cxt arg in
@@ -1482,49 +1484,23 @@ and compile_prim (prim_info : Lam.prim_info) (lambda_cxt : Lam_compile_context.t
           | {value = None}, _ | _, {value = None} -> assert false
           | {block = obj_block; value = Some obj },
             {block = arg_block; value = Some value}
-            ->
-            if  Ext_string.ends_with method_name Literals.setter_suffix then
-              let property =
-                Lam_methname.translate ~loc
-                  (String.sub method_name 0
-                     (String.length method_name - Literals.setter_suffix_len)) in
-              match Js_ast_util.named_expression  obj with
-              | None ->
-                cont obj_block arg_block None
-                  (E.seq (E.assign (E.dot obj property) value) E.unit)
-              | Some (obj_code, obj)
-                ->
-                cont obj_block arg_block (Some obj_code)
-                  (E.seq (E.assign (E.dot (E.var obj) property) value) E.unit)
-            else
-              compile_lambda lambda_cxt
-                (Lam.apply fn [arg]
-                   Location.none (* TODO *) App_js_full))
+            ->            
+            match Js_ast_util.named_expression  obj with
+            | None ->
+              cont obj_block arg_block None
+                (E.seq (E.assign (E.dot obj property) value) E.unit)
+            | Some (obj_code, obj)
+              ->
+              cont obj_block arg_block (Some obj_code)
+                (E.seq (E.assign (E.dot (E.var obj) property) value) E.unit)
+         )
        | fn :: rest ->
          compile_lambda lambda_cxt
            (Lam.apply fn rest
               Location.none (*TODO*)
               App_js_full)
        | [] -> assert false)
       
-    | {primitive = Pjs_fn_runmethod arity ; args }
-      ->
-      (match args with
-       | (Lprim{primitive = Pjs_unsafe_downgrade (name,loc);
-                args = [ _ ]} as fn)
-         :: _obj
-         :: rest ->
-         (* assert (Ident.same id2 id) ;  *)
-         (* we ignore the computation of [_obj],
-            since our ast writer
-            {[ obj#.f (x,y)
-            ]}
-            -->
-            {[ runmethod2 f obj#.f x y]}
-         *)
-         compile_lambda lambda_cxt (Lam.apply fn rest loc App_js_full)
-       | _ -> assert false)
-
     | {primitive = Pjs_fn_method arity;  args = args_lambda} ->
       (match args_lambda with
        | [Lfunction{arity = len; params; body} ]
diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml
@@ -121,8 +121,6 @@ let translate  loc
   | Pdebugger 
   | Pjs_fn_run _ 
   | Pjs_fn_make _
-
-  | Pjs_fn_runmethod _ 
     -> assert false (* already handled by {!Lam_compile} *)
   | Pjs_fn_method _ -> assert false
   | Pglobal_exception id ->
diff --git a/jscomp/core/lam_convert.ml b/jscomp/core/lam_convert.ml
@@ -528,7 +528,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
         | "#fn_run" | "#method_run" -> Pjs_fn_run(Ext_pervasives.nat_of_string_exn p.prim_native_name)
         | "#fn_mk" -> Pjs_fn_make (Ext_pervasives.nat_of_string_exn p.prim_native_name)
         | "#fn_method" -> Pjs_fn_method (Ext_pervasives.nat_of_string_exn p.prim_native_name)
-        | "#unsafe_downgrade" -> Pjs_unsafe_downgrade (Ext_string.empty,loc)
+        | "#unsafe_downgrade" -> Pjs_unsafe_downgrade {name = Ext_string.empty; loc ; setter = false}
         | _ -> Location.raise_errorf ~loc
                  "@{<error>Error:@} internal error, using unrecorgnized primitive %s" s
       in
@@ -634,11 +634,18 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
     | Lsend (kind, a,b,ls, loc) ->
       (* Format.fprintf Format.err_formatter "%a@." Printlambda.lambda b ; *)
         (match convert_aux b with
-        | Lprim {primitive =  Pjs_unsafe_downgrade(_,loc);  args}
+        | Lprim {primitive =  Pjs_unsafe_downgrade {loc};  args}
           ->
           begin match kind, ls with
             | Public (Some name), [] ->
-              prim ~primitive:(Pjs_unsafe_downgrade (name,loc))
+              let setter = Ext_string.ends_with name Literals.setter_suffix in 
+              let property = 
+                if setter then   
+                  Lam_methname.translate ~loc
+                    (String.sub name 0
+                       (String.length name - Literals.setter_suffix_len))
+                else Lam_methname.translate ~loc name in 
+              prim ~primitive:(Pjs_unsafe_downgrade {name = property;loc; setter})
                 ~args loc
             | _ -> assert false
           end
diff --git a/jscomp/core/lam_primitive.ml b/jscomp/core/lam_primitive.ml
@@ -139,7 +139,12 @@ type t =
   (* Integer to external pointer *)
 
   | Pdebugger
-  | Pjs_unsafe_downgrade of string * Location.t
+  | Pjs_unsafe_downgrade of 
+    { 
+      name : string ;
+      setter : bool;
+      loc : Location.t;
+     }
   | Pinit_mod
   | Pupdate_mod
   | Praw_js_code_exp of string
@@ -148,7 +153,7 @@ type t =
   | Pjs_fn_make of int
   | Pjs_fn_run of int
   | Pjs_fn_method of int
-  | Pjs_fn_runmethod of int
+  
 
   | Pundefined_to_opt
   | Pnull_to_opt
@@ -319,12 +324,10 @@ let eq_primitive_approx ( lhs : t) (rhs : t) =
   | Pbigstring_set_32 b -> (match rhs with Pbigstring_set_32 b1 -> b = b1 | _ -> false )      
   | Pbigstring_set_64 b -> (match rhs with Pbigstring_set_64 b1 -> b = b1 | _ -> false )      
   | Pctconst compile_time_constant -> (match rhs with Pctconst compile_time_constant1 -> Lam_compat.eq_compile_time_constant compile_time_constant compile_time_constant1 | _ -> false)
-  | Pjs_unsafe_downgrade ( s,_loc) -> (match rhs with Pjs_unsafe_downgrade (s1,_) -> s = s1 | _ -> false)  
+  | Pjs_unsafe_downgrade {name; loc=_; setter } -> (match rhs with Pjs_unsafe_downgrade rhs -> name = rhs.name && setter = rhs.setter | _ -> false)  
   | Pjs_fn_make i -> (match rhs with Pjs_fn_make i1 -> i = i1 | _ -> false)
   | Pjs_fn_run i -> (match rhs with Pjs_fn_run i1 -> i = i1 | _ -> false)
-  | Pjs_fn_method i -> (match rhs with Pjs_fn_method i1 -> i = i1 | _ ->  false )
-  | Pjs_fn_runmethod i -> (match rhs with Pjs_fn_runmethod i1 -> i = i1 | _ -> false ) 
-
+  | Pjs_fn_method i -> (match rhs with Pjs_fn_method i1 -> i = i1 | _ ->  false )  
   | Pbigarrayref  _ 
   | Pbigarrayset _ 
   | Praw_js_function _
diff --git a/jscomp/core/lam_primitive.mli b/jscomp/core/lam_primitive.mli
@@ -133,7 +133,12 @@ type t =
   (* Integer to external pointer *)
 
   | Pdebugger
-  | Pjs_unsafe_downgrade of string * Location.t
+  | Pjs_unsafe_downgrade of 
+    { 
+      name : string ; 
+      setter : bool;
+      loc : Location.t;
+    }
   | Pinit_mod
   | Pupdate_mod
 
@@ -143,7 +148,6 @@ type t =
   | Pjs_fn_make of int 
   | Pjs_fn_run of int 
   | Pjs_fn_method of int 
-  | Pjs_fn_runmethod of int 
   | Pundefined_to_opt
   | Pnull_to_opt
   | Pnull_undefined_to_opt 
diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml
@@ -118,12 +118,11 @@ let primitive ppf (prim : Lam_primitive.t) = match prim with
   | Pbytes_of_string -> fprintf ppf "bytes_of_string"
   | Pjs_apply -> fprintf ppf "#apply"
   | Pjs_runtime_apply -> fprintf ppf "#runtime_apply"
-  | Pjs_unsafe_downgrade (s,_loc) -> fprintf ppf "##%s" s 
+  | Pjs_unsafe_downgrade {name = s} -> fprintf ppf "##%s" s 
   | Pjs_function_length -> fprintf ppf "#function_length"
   | Pjs_fn_run i -> fprintf ppf "#fn_run_%i" i 
   | Pjs_fn_make i -> fprintf ppf "js_fn_make_%i" i
   | Pjs_fn_method i -> fprintf ppf "js_fn_method_%i" i 
-  | Pjs_fn_runmethod i -> fprintf ppf "js_fn_runmethod_%i" i 
   | Pdebugger -> fprintf ppf "debugger"
   | Praw_js_function _ -> fprintf ppf "[raw.fun]"
   | Praw_js_code_exp _ -> fprintf ppf "[raw.exp]"
diff --git a/jscomp/test/class_repr.js b/jscomp/test/class_repr.js
@@ -176,6 +176,46 @@ if (Caml_oo_curry.js1(590348294, 8, v$1) !== 5) {
       ];
 }
 
+function xx0_init($$class) {
+  var x = CamlinternalOO.new_variable($$class, "");
+  var ids = CamlinternalOO.new_methods_variables($$class, shared$2, [
+        "money",
+        "a0",
+        "a1",
+        "a2"
+      ]);
+  var incr = ids[0];
+  var get_money = ids[1];
+  var money = ids[2];
+  var a0 = ids[3];
+  var a1 = ids[4];
+  var a2 = ids[5];
+  CamlinternalOO.set_methods($$class, [
+        get_money,
+        (function (self$5) {
+            return self$5[money];
+          }),
+        incr,
+        (function (self$5) {
+            var copy = Caml_exceptions.caml_set_oo_id(Caml_obj.caml_obj_dup(self$5));
+            copy[money] = 2 * self$5[x] + Curry._1(self$5[0][get_money], self$5);
+            copy[a0] = 2;
+            return copy;
+          })
+      ]);
+  return (function (env, self, x$1) {
+      var self$1 = CamlinternalOO.create_object_opt(self, $$class);
+      self$1[x] = x$1;
+      self$1[money] = x$1;
+      self$1[a0] = 0;
+      self$1[a1] = 1;
+      self$1[a2] = 2;
+      return self$1;
+    });
+}
+
+var xx0 = CamlinternalOO.make_class(shared$2, xx0_init);
+
 exports.x0 = x0;
 exports.x = x;
 exports.u = u;
@@ -184,4 +224,5 @@ exports.v1 = v1;
 exports.v2 = v2;
 exports.point = point;
 exports.v = v$1;
+exports.xx0 = xx0;
 /* x0 Not a pure module */
diff --git a/jscomp/test/class_repr.ml b/jscomp/test/class_repr.ml
@@ -96,4 +96,14 @@ end
 let v = new point 
 
 let () = 
-  assert (v#get_x5 = 5)
+  assert (v#get_x5 = 5)
+
+class xx0 (x : float)= object (self)
+  val money = x 
+  val a0 = 0
+  val a1 = 1
+  val a2 = 2
+  method get_money = money (* Texp_instvar *)
+  method incr = {< money = 2. *. x +. self#get_money; a0 = 2 >}
+  (* Texp_instvar *) (* camlinternalOO.copy is inlined here *)
+end
diff --git a/lib/4.06.1/unstable/js_compiler.ml b/lib/4.06.1/unstable/js_compiler.ml
diff --git a/lib/4.06.1/unstable/js_refmt_compiler.ml b/lib/4.06.1/unstable/js_refmt_compiler.ml
diff --git a/lib/4.06.1/whole_compiler.ml b/lib/4.06.1/whole_compiler.ml
