tweak

Author: bobzhang

jscomp/core/lam_arity.ml

@@ -88,4 +88,11 @@ let first_arity_na ( x : t ) =
   match x with 
   | Arity_na 
   | Arity_info (_, [], _) -> true
-  | _ -> false
+  | _ -> false
+
+let extract_arity ( x : t) =   
+  match x with 
+  | Arity_na  -> None
+  | Arity_info(_,xs,_) -> Some xs 
+
+(* let update_arity (x : t) xs =    *)

jscomp/core/lam_arity.mli

@@ -50,4 +50,6 @@ val raise_arity_info : t
 val na : t
 val info : bool -> int list -> bool -> t 
 
-val first_arity_na :  t -> bool
+val first_arity_na :  t -> bool
+
+val extract_arity : t -> int list option 

jscomp/core/lam_compile.ml

@@ -177,11 +177,11 @@ and compile_external_field_apply
            params body args_lambda)
     | _ ->
       let rec aux (acc : J.expression)
-          (arity : Lam_arity.t) args (len : int)  =
-        match arity, len with
-        | _, 0 ->
+          (arity : Lam_arity.t) args (len : int)  : E.t =
+          if len = 0 then         
           acc (** All arguments consumed so far *)
-        | Arity_info (aaaaa, x :: rest, bbbbb), len   ->
+          else match arity with 
+          | Arity_info (aaaaa, x :: rest, bbbbb)   ->
           let x =
             if x = 0
             then 1
@@ -204,22 +204,25 @@ and compile_external_field_apply
         (* alpha conversion now? --
            Since we did an alpha conversion before so it is not here
         *)
-        | Arity_info (a, [], b ), _ ->
+        | Arity_info (_, [], _ ) ->
           (* can not happen, unless it's an exception ? *)
           E.call ~info:Js_call_info.dummy acc args
-        | Arity_na, _ ->
+        | Arity_na ->
           E.call ~info:Js_call_info.dummy acc args
       in
+      let fn = E.ml_var_dot id name in 
+      let initial_args_len = List.length args in 
+      let expression = 
+        match arity with 
+        | Submodule _ -> E.call ~info:Js_call_info.dummy fn args 
+        | Single x -> 
+          aux fn x  args initial_args_len
+      in   
       Js_output.output_of_block_and_expression
         cxt.st
         cxt.should_return
         lam
-        args_code
-        (
-          aux
-            (E.ml_var_dot id name)
-            (match arity with Single x -> x | Submodule _ -> Lam_arity.na)
-            args (List.length args ))
+        args_code expression
 
 
 and  compile_let

lib/whole_compiler.ml

@@ -69079,6 +69079,8 @@ val na : t
 val info : bool -> int list -> bool -> t 
 
 val first_arity_na :  t -> bool
+
+val extract_arity : t -> int list option 
 end = struct
 #1 "lam_arity.ml"
 (* Copyright (C) Authors of BuckleScript
@@ -69172,6 +69174,13 @@ let first_arity_na ( x : t ) =
   | Arity_na 
   | Arity_info (_, [], _) -> true
   | _ -> false
+
+let extract_arity ( x : t) =   
+  match x with 
+  | Arity_na  -> None
+  | Arity_info(_,xs,_) -> Some xs 
+
+(* let update_arity (x : t) xs =    *)
 end
 module Js_cmj_format : sig 
 #1 "js_cmj_format.mli"
@@ -97282,11 +97291,11 @@ and compile_external_field_apply
            params body args_lambda)
     | _ ->
       let rec aux (acc : J.expression)
-          (arity : Lam_arity.t) args (len : int)  =
-        match arity, len with
-        | _, 0 ->
+          (arity : Lam_arity.t) args (len : int)  : E.t =
+          if len = 0 then         
           acc (** All arguments consumed so far *)
-        | Arity_info (aaaaa, x :: rest, bbbbb), len   ->
+          else match arity with 
+          | Arity_info (aaaaa, x :: rest, bbbbb)   ->
           let x =
             if x = 0
             then 1
@@ -97309,22 +97318,25 @@ and compile_external_field_apply
         (* alpha conversion now? --
            Since we did an alpha conversion before so it is not here
         *)
-        | Arity_info (a, [], b ), _ ->
+        | Arity_info (_, [], _ ) ->
           (* can not happen, unless it's an exception ? *)
           E.call ~info:Js_call_info.dummy acc args
-        | Arity_na, _ ->
+        | Arity_na ->
           E.call ~info:Js_call_info.dummy acc args
       in
+      let fn = E.ml_var_dot id name in 
+      let initial_args_len = List.length args in 
+      let expression = 
+        match arity with 
+        | Submodule _ -> E.call ~info:Js_call_info.dummy fn args 
+        | Single x -> 
+          aux fn x  args initial_args_len
+      in   
       Js_output.output_of_block_and_expression
         cxt.st
         cxt.should_return
         lam
-        args_code
-        (
-          aux
-            (E.ml_var_dot id name)
-            (match arity with Single x -> x | Submodule _ -> Lam_arity.na)
-            args (List.length args ))
+        args_code expression
 
 
 and  compile_let