Merge pull request #4079 from BuckleScript/seprate_method_uncurried_compilation

bobzhang · web-flow · commit 60ca072350e4 · 2020-01-08T20:08:23.000+08:00
separate method/setter compilation from uncurried compilation
diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml
@@ -26,8 +26,8 @@ type ident = Ident.t
 
 type apply_status =
   | App_na
-  | App_ml_full
-  | App_js_full
+  | App_infer_full
+  | App_uncurry
 
 
 module Types = struct
diff --git a/jscomp/core/lam.mli b/jscomp/core/lam.mli
@@ -37,8 +37,8 @@ type lambda_switch  =
     sw_names: Lambda.switch_names option }
 and apply_status =
   | App_na
-  | App_ml_full
-  | App_js_full      
+  | App_infer_full
+  | App_uncurry      
 and apply_info = private
   { ap_func : t ; 
     ap_args : t list ; 
diff --git a/jscomp/core/lam_analysis.ml b/jscomp/core/lam_analysis.ml
@@ -175,6 +175,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
       | Pjs_unsafe_downgrade _
       | Pdebugger 
       | Pjs_fn_run _ 
+      | Pmethod_run
       | Pjs_fn_method _ 
       (* TODO *)
       | Praw_js_code_exp _ 
diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml
@@ -28,9 +28,9 @@ module S = Js_stmt_make
 
 let call_info_of_ap_status (ap_status : Lam.apply_status) : Js_call_info.t =  
   match  ap_status with
-  | App_ml_full ->
+  | App_infer_full ->
     {arity = Full ; call_info = Call_ml}
-  |  App_js_full ->
+  |  App_uncurry ->
     {arity = Full ; call_info = Call_na}
   |  App_na ->
     {arity = NA; call_info = Call_ml }
@@ -250,7 +250,7 @@ and compile_external_field_apply
     let fn = E.ml_var_dot module_id ident_info.name in     
     let expression = 
       match appinfo.ap_status with 
-      | App_ml_full | App_js_full as ap_status -> 
+      | App_infer_full | App_uncurry as ap_status -> 
         E.call ~info:(call_info_of_ap_status ap_status) fn args 
       | App_na ->   
         match ident_info.arity with 
@@ -1419,53 +1419,54 @@ 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 _;  args = args_lambda}
+    | {primitive = Pmethod_run;  args = [Lprim{
+        primitive =
+          Pjs_unsafe_downgrade {name = property; loc; setter = true};
+        args = [obj]} ;
+       setter_val]} ->        
+       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 setter_val in
+       let cont obj_block arg_block obj_code =
+         Js_output.output_of_block_and_expression lambda_cxt.continuation  
+           (
+             match obj_code with
+             | None -> Ext_list.append obj_block  arg_block
+             | Some obj_code -> Ext_list.append obj_block (obj_code :: arg_block)
+           )
+       in
+       (match obj_output, arg_output with
+        | {value = None}, _ | _, {value = None} -> assert false
+        | {block = obj_block; value = Some obj },
+          {block = arg_block; value = Some value}
+          ->            
+          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)
+       )
+    | {primitive = Pmethod_run;  args = Lprim{
+        primitive =
+          Pjs_unsafe_downgrade {name = property; loc; setter = true};
+        } :: _
+       } -> assert false        
+    | {primitive = Pjs_fn_run _ | Pmethod_run ;  args; loc}
       ->
-      (* 1. prevent eta-conversion
-         by using [App_js_full]
+      (* 1. uncurried call should not do eta-conversion
+            since `fn.length` will broken 
          2. invariant: `external` declaration will guarantee
          the function application is saturated
          3. we need a location for Pccall in the call site
       *)
 
-      (match args_lambda with
-       | [Lprim{
-           primitive =
-             Pjs_unsafe_downgrade {name = property; loc; setter = true};
-           args = args_l} ;
-          setter_val] (** 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 setter_val in
-         let cont obj_block arg_block obj_code =
-           Js_output.output_of_block_and_expression lambda_cxt.continuation  
-             (
-               match obj_code with
-               | None -> Ext_list.append obj_block  arg_block
-               | Some obj_code -> Ext_list.append obj_block (obj_code :: arg_block)
-             )
-         in
-         (match obj_output, arg_output with
-          | {value = None}, _ | _, {value = None} -> assert false
-          | {block = obj_block; value = Some obj },
-            {block = arg_block; value = Some value}
-            ->            
-            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)
-         )
+      (match args with
        | fn :: rest ->
          compile_lambda lambda_cxt
-           (Lam.apply fn rest
-              Location.none (*TODO*)
-              App_js_full)
+           (Lam.apply fn rest loc App_uncurry)
        | [] -> assert false)
       
     | {primitive = Pjs_fn_method arity;  args = args_lambda} ->
diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml
@@ -120,6 +120,7 @@ let translate  loc
   | Pjs_unsafe_downgrade _
   | Pdebugger 
   | Pjs_fn_run _ 
+  | Pmethod_run
   | Pjs_fn_make _
     -> assert false (* already handled by {!Lam_compile} *)
   | Pjs_fn_method _ -> assert false
diff --git a/jscomp/core/lam_convert.ml b/jscomp/core/lam_convert.ml
@@ -525,7 +525,9 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
         | "#unsafe_neq" -> Pjscomp Cneq
 
         | "#typeof" -> Pjs_typeof
-        | "#fn_run" | "#method_run" -> Pjs_fn_run(Ext_pervasives.nat_of_string_exn p.prim_native_name)
+        | "#fn_run"  -> 
+          Pjs_fn_run(Ext_pervasives.nat_of_string_exn p.prim_native_name)
+        | "#method_run" -> Pmethod_run
         | "#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 {name = Ext_string.empty; loc ; setter = false}
diff --git a/jscomp/core/lam_eta_conversion.ml b/jscomp/core/lam_eta_conversion.ml
@@ -191,7 +191,7 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
               ~params:extra_args 
               ~body:(
                 let first_args, rest_args = Ext_list.split_at extra_args from in 
-                Lam.apply (Lam.apply new_fn (Ext_list.map first_args  Lam.var) loc App_ml_full) (Ext_list.map rest_args Lam.var) loc App_na ) in 
+                Lam.apply (Lam.apply new_fn (Ext_list.map first_args  Lam.var) loc App_infer_full) (Ext_list.map rest_args Lam.var) loc App_na ) in 
           begin match wrapper with 
             | None -> cont 
             | Some partial_arg -> 
@@ -245,7 +245,7 @@ let unsafe_adjust_to_arity loc ~(to_:int) ?(from : int option) (fn : Lam.t) : La
                                 (Ext_list.map extra_inner_args Lam.var) 
                                 Lam.var 
                              )      
-                             loc App_ml_full)
+                             loc App_infer_full)
                 )  in 
             begin match wrapper with 
               | None -> cont 
diff --git a/jscomp/core/lam_pass_alpha_conversion.ml b/jscomp/core/lam_pass_alpha_conversion.ml
@@ -38,19 +38,19 @@ let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t =
     | x :: xs -> 
       if x = len 
       then 
-        Lam.apply (simpl fn) (Ext_list.map args simpl) loc App_ml_full
+        Lam.apply (simpl fn) (Ext_list.map args simpl) loc App_infer_full
       else if x > len  
       then 
         let fn = simpl fn in
         let args = Ext_list.map args simpl in
-        Lam_eta_conversion.transform_under_supply (x - len) loc App_ml_full
+        Lam_eta_conversion.transform_under_supply (x - len) loc App_infer_full
           fn args 
       else 
         let first,rest = Ext_list.split_at args x in 
         Lam.apply (
           Lam.apply (simpl fn) 
             (Ext_list.map first simpl ) 
-            loc App_ml_full
+            loc App_infer_full
         )
           (Ext_list.map rest simpl ) loc status (* TODO refien *)
     
diff --git a/jscomp/core/lam_primitive.ml b/jscomp/core/lam_primitive.ml
@@ -152,6 +152,7 @@ type t =
   | Praw_js_function of string * string list
   | Pjs_fn_make of int
   | Pjs_fn_run of int
+  | Pmethod_run
   | Pjs_fn_method of int
   
 
@@ -327,6 +328,7 @@ let eq_primitive_approx ( lhs : t) (rhs : t) =
   | 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)
+  | Pmethod_run  -> rhs = Pmethod_run 
   | Pjs_fn_method i -> (match rhs with Pjs_fn_method i1 -> i = i1 | _ ->  false )  
   | Pbigarrayref  _ 
   | Pbigarrayset _ 
diff --git a/jscomp/core/lam_primitive.mli b/jscomp/core/lam_primitive.mli
@@ -147,6 +147,7 @@ type t =
   | Praw_js_function of string * string list
   | Pjs_fn_make of int 
   | Pjs_fn_run of int 
+  | Pmethod_run
   | Pjs_fn_method of int 
   | Pundefined_to_opt
   | Pnull_to_opt
diff --git a/jscomp/core/lam_print.ml b/jscomp/core/lam_print.ml
@@ -121,6 +121,7 @@ let primitive ppf (prim : Lam_primitive.t) = match prim with
   | 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 
+  | Pmethod_run -> fprintf ppf "#method_run"
   | Pjs_fn_make i -> fprintf ppf "js_fn_make_%i" i
   | Pjs_fn_method i -> fprintf ppf "js_fn_method_%i" i 
   | Pdebugger -> fprintf ppf "debugger"
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
