Skip to content

Commit a12ac63

Browse files
bobzhangbobzhang
committed
split arity handling
1 parent 448594e commit a12ac63

File tree

7 files changed

+420
-420
lines changed

7 files changed

+420
-420
lines changed

‎jscomp/syntax/ast_util.ml

Lines changed: 60 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -74,31 +74,35 @@ let generic_apply kind loc
7474
-> []
7575
| _ -> args in
7676
let arity = List.length args in
77-
if arity < 10 then
78-
let txt =
79-
match kind with
80-
| `Fn | `PropertyFn ->
81-
Longident.Ldot (Ast_literal.Lid.js_internal,
82-
Literals.fn_run ^ string_of_int arity)
83-
| `Method ->
84-
Longident.Ldot(Lident "Js_internalOO",
85-
Literals.method_run ^ string_of_int arity
86-
) in
87-
Parsetree.Pexp_apply (Exp.ident {txt ; loc}, (Nolabel,fn) :: Ext_list.map args (fun x -> Asttypes.Nolabel,x))
88-
else
89-
let fn_type, args_type, result_type = Ast_comb.tuple_type_pair ~loc `Run arity in
90-
let string_arity = string_of_int arity in
91-
let pval_prim, pval_type =
92-
match kind with
93-
| `Fn | `PropertyFn ->
77+
match kind with
78+
| `Fn | `PropertyFn ->
79+
if arity < 10 then
80+
let txt : Longident.t =
81+
Ldot (Ast_literal.Lid.js_internal, Literals.fn_run ^ string_of_int arity) in
82+
Parsetree.Pexp_apply (Exp.ident {txt ; loc}, (Nolabel,fn) :: Ext_list.map args (fun x -> Asttypes.Nolabel,x))
83+
else
84+
let fn_type, args_type, result_type = Ast_comb.tuple_type_pair ~loc `Run arity in
85+
let string_arity = string_of_int arity in
86+
let pval_prim, pval_type =
9487
["#fn_run"; string_arity],
9588
arrow ~loc (Ast_typ_uncurry.lift_curry_type loc args_type result_type ) fn_type
96-
| `Method ->
89+
in
90+
Ast_external_mk.local_external_apply loc ~pval_prim ~pval_type
91+
( fn :: args )
92+
| `Method ->
93+
if arity < 10 then
94+
let txt : Longident.t =
95+
Ldot(Lident "Js_internalOO", Literals.method_run ^ string_of_int arity) in
96+
Parsetree.Pexp_apply (Exp.ident {txt ; loc}, (Nolabel,fn) :: Ext_list.map args (fun x -> Asttypes.Nolabel,x))
97+
else
98+
let fn_type, args_type, result_type = Ast_comb.tuple_type_pair ~loc `Run arity in
99+
let string_arity = string_of_int arity in
100+
let pval_prim, pval_type =
97101
["#method_run" ; string_arity],
98102
arrow ~loc (Ast_typ_uncurry.lift_method_type loc args_type result_type) fn_type
99-
in
100-
Ast_external_mk.local_external_apply loc ~pval_prim ~pval_type
101-
( fn :: args )
103+
in
104+
Ast_external_mk.local_external_apply loc ~pval_prim ~pval_type
105+
( fn :: args )
102106

103107

104108
let uncurry_fn_apply loc self fn args =
@@ -137,48 +141,44 @@ let generic_to_uncurry_exp kind loc (self : Bs_ast_mapper.mapper) pat body
137141
Bs_syntaxerr.err first_arg.ppat_loc Bs_this_simple_pattern
138142
| _ -> ()
139143
in
140-
141144
let result, rev_extra_args = aux [first_arg] body in
142145
let body =
143146
Ext_list.fold_left rev_extra_args result (fun e p -> Ast_compatible.fun_ ~loc p e )
144-
in
145-
let len = List.length rev_extra_args in
146-
let arity =
147-
match kind with
148-
| `Fn ->
149-
begin match rev_extra_args with
150-
| [ p]
151-
->
152-
Ast_pat.is_unit_cont ~yes:0 ~no:len p
153-
154-
| _ -> len
155-
end
156-
| `Method_callback -> len in
157-
if arity < 10 then
158-
let txt =
159-
match kind with
160-
| `Fn ->
161-
Longident.Ldot ( Ast_literal.Lid.js_internal, Literals.fn_mk ^ string_of_int arity)
162-
| `Method_callback ->
163-
Longident.Ldot (Lident "Js_internalOO", Literals.fn_method ^ string_of_int arity) in
164-
Parsetree.Pexp_apply (Exp.ident {txt;loc} , [ Nolabel, body])
165-
166-
else
167-
let pval_prim =
168-
[ (match kind with
169-
| `Fn -> "#fn_mk"
170-
| `Method_callback -> "#fn_method");
171-
string_of_int arity] in
172-
let fn_type , args_type, result_type = Ast_comb.tuple_type_pair ~loc `Make arity in
173-
let pval_type = arrow ~loc fn_type (
174-
match kind with
175-
| `Fn ->
176-
Ast_typ_uncurry.lift_curry_type loc args_type result_type
177-
| `Method_callback ->
178-
Ast_typ_uncurry.lift_js_method_callback loc args_type result_type
179-
) in
180-
Ast_external_mk.local_extern_cont loc ~pval_prim ~pval_type
181-
(fun prim -> Ast_compatible.app1 ~loc prim body)
147+
in
148+
let len = List.length rev_extra_args in
149+
match kind with
150+
| `Fn ->
151+
let arity =
152+
match rev_extra_args with
153+
| [ p]
154+
->
155+
Ast_pat.is_unit_cont ~yes:0 ~no:len p
156+
| _ -> len
157+
in
158+
if arity < 10 then
159+
let txt =
160+
Longident.Ldot ( Ast_literal.Lid.js_internal, Literals.fn_mk ^ string_of_int arity) in
161+
Parsetree.Pexp_apply (Exp.ident {txt;loc} , [ Nolabel, body])
162+
else
163+
let pval_prim =
164+
[ "#fn_mk"; string_of_int arity] in
165+
let fn_type , args_type, result_type = Ast_comb.tuple_type_pair ~loc `Make arity in
166+
let pval_type = arrow ~loc fn_type (Ast_typ_uncurry.lift_curry_type loc args_type result_type) in
167+
Ast_external_mk.local_extern_cont loc ~pval_prim ~pval_type
168+
(fun prim -> Ast_compatible.app1 ~loc prim body)
169+
| `Method_callback ->
170+
let arity = len in
171+
if arity < 10 then
172+
let txt = Longident.Ldot (Lident "Js_internalOO", Literals.fn_method ^ string_of_int arity) in
173+
Parsetree.Pexp_apply (Exp.ident {txt;loc} , [ Nolabel, body])
174+
else
175+
let pval_prim =
176+
[ "#fn_method"; string_of_int arity] in
177+
let fn_type , args_type, result_type = Ast_comb.tuple_type_pair ~loc `Make arity in
178+
let pval_type = arrow ~loc fn_type
179+
(Ast_typ_uncurry.lift_js_method_callback loc args_type result_type) in
180+
Ast_external_mk.local_extern_cont loc ~pval_prim ~pval_type
181+
(fun prim -> Ast_compatible.app1 ~loc prim body)
182182

183183
let to_uncurry_fn =
184184
generic_to_uncurry_exp `Fn

‎lib/4.06.1/bsdep.ml

Lines changed: 60 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -44790,31 +44790,35 @@ let generic_apply kind loc
4479044790
-> []
4479144791
| _ -> args in
4479244792
let arity = List.length args in
44793-
if arity < 10 then
44794-
let txt =
44795-
match kind with
44796-
| `Fn | `PropertyFn ->
44797-
Longident.Ldot (Ast_literal.Lid.js_internal,
44798-
Literals.fn_run ^ string_of_int arity)
44799-
| `Method ->
44800-
Longident.Ldot(Lident "Js_internalOO",
44801-
Literals.method_run ^ string_of_int arity
44802-
) in
44803-
Parsetree.Pexp_apply (Exp.ident {txt ; loc}, (Nolabel,fn) :: Ext_list.map args (fun x -> Asttypes.Nolabel,x))
44804-
else
44805-
let fn_type, args_type, result_type = Ast_comb.tuple_type_pair ~loc `Run arity in
44806-
let string_arity = string_of_int arity in
44807-
let pval_prim, pval_type =
44808-
match kind with
44809-
| `Fn | `PropertyFn ->
44793+
match kind with
44794+
| `Fn | `PropertyFn ->
44795+
if arity < 10 then
44796+
let txt : Longident.t =
44797+
Ldot (Ast_literal.Lid.js_internal, Literals.fn_run ^ string_of_int arity) in
44798+
Parsetree.Pexp_apply (Exp.ident {txt ; loc}, (Nolabel,fn) :: Ext_list.map args (fun x -> Asttypes.Nolabel,x))
44799+
else
44800+
let fn_type, args_type, result_type = Ast_comb.tuple_type_pair ~loc `Run arity in
44801+
let string_arity = string_of_int arity in
44802+
let pval_prim, pval_type =
4481044803
["#fn_run"; string_arity],
4481144804
arrow ~loc (Ast_typ_uncurry.lift_curry_type loc args_type result_type ) fn_type
44812-
| `Method ->
44805+
in
44806+
Ast_external_mk.local_external_apply loc ~pval_prim ~pval_type
44807+
( fn :: args )
44808+
| `Method ->
44809+
if arity < 10 then
44810+
let txt : Longident.t =
44811+
Ldot(Lident "Js_internalOO", Literals.method_run ^ string_of_int arity) in
44812+
Parsetree.Pexp_apply (Exp.ident {txt ; loc}, (Nolabel,fn) :: Ext_list.map args (fun x -> Asttypes.Nolabel,x))
44813+
else
44814+
let fn_type, args_type, result_type = Ast_comb.tuple_type_pair ~loc `Run arity in
44815+
let string_arity = string_of_int arity in
44816+
let pval_prim, pval_type =
4481344817
["#method_run" ; string_arity],
4481444818
arrow ~loc (Ast_typ_uncurry.lift_method_type loc args_type result_type) fn_type
44815-
in
44816-
Ast_external_mk.local_external_apply loc ~pval_prim ~pval_type
44817-
( fn :: args )
44819+
in
44820+
Ast_external_mk.local_external_apply loc ~pval_prim ~pval_type
44821+
( fn :: args )
4481844822

4481944823

4482044824
let uncurry_fn_apply loc self fn args =
@@ -44853,48 +44857,44 @@ let generic_to_uncurry_exp kind loc (self : Bs_ast_mapper.mapper) pat body
4485344857
Bs_syntaxerr.err first_arg.ppat_loc Bs_this_simple_pattern
4485444858
| _ -> ()
4485544859
in
44856-
4485744860
let result, rev_extra_args = aux [first_arg] body in
4485844861
let body =
4485944862
Ext_list.fold_left rev_extra_args result (fun e p -> Ast_compatible.fun_ ~loc p e )
44860-
in
44861-
let len = List.length rev_extra_args in
44862-
let arity =
44863-
match kind with
44864-
| `Fn ->
44865-
begin match rev_extra_args with
44866-
| [ p]
44867-
->
44868-
Ast_pat.is_unit_cont ~yes:0 ~no:len p
44869-
44870-
| _ -> len
44871-
end
44872-
| `Method_callback -> len in
44873-
if arity < 10 then
44874-
let txt =
44875-
match kind with
44876-
| `Fn ->
44877-
Longident.Ldot ( Ast_literal.Lid.js_internal, Literals.fn_mk ^ string_of_int arity)
44878-
| `Method_callback ->
44879-
Longident.Ldot (Lident "Js_internalOO", Literals.fn_method ^ string_of_int arity) in
44880-
Parsetree.Pexp_apply (Exp.ident {txt;loc} , [ Nolabel, body])
44881-
44882-
else
44883-
let pval_prim =
44884-
[ (match kind with
44885-
| `Fn -> "#fn_mk"
44886-
| `Method_callback -> "#fn_method");
44887-
string_of_int arity] in
44888-
let fn_type , args_type, result_type = Ast_comb.tuple_type_pair ~loc `Make arity in
44889-
let pval_type = arrow ~loc fn_type (
44890-
match kind with
44891-
| `Fn ->
44892-
Ast_typ_uncurry.lift_curry_type loc args_type result_type
44893-
| `Method_callback ->
44894-
Ast_typ_uncurry.lift_js_method_callback loc args_type result_type
44895-
) in
44896-
Ast_external_mk.local_extern_cont loc ~pval_prim ~pval_type
44897-
(fun prim -> Ast_compatible.app1 ~loc prim body)
44863+
in
44864+
let len = List.length rev_extra_args in
44865+
match kind with
44866+
| `Fn ->
44867+
let arity =
44868+
match rev_extra_args with
44869+
| [ p]
44870+
->
44871+
Ast_pat.is_unit_cont ~yes:0 ~no:len p
44872+
| _ -> len
44873+
in
44874+
if arity < 10 then
44875+
let txt =
44876+
Longident.Ldot ( Ast_literal.Lid.js_internal, Literals.fn_mk ^ string_of_int arity) in
44877+
Parsetree.Pexp_apply (Exp.ident {txt;loc} , [ Nolabel, body])
44878+
else
44879+
let pval_prim =
44880+
[ "#fn_mk"; string_of_int arity] in
44881+
let fn_type , args_type, result_type = Ast_comb.tuple_type_pair ~loc `Make arity in
44882+
let pval_type = arrow ~loc fn_type (Ast_typ_uncurry.lift_curry_type loc args_type result_type) in
44883+
Ast_external_mk.local_extern_cont loc ~pval_prim ~pval_type
44884+
(fun prim -> Ast_compatible.app1 ~loc prim body)
44885+
| `Method_callback ->
44886+
let arity = len in
44887+
if arity < 10 then
44888+
let txt = Longident.Ldot (Lident "Js_internalOO", Literals.fn_method ^ string_of_int arity) in
44889+
Parsetree.Pexp_apply (Exp.ident {txt;loc} , [ Nolabel, body])
44890+
else
44891+
let pval_prim =
44892+
[ "#fn_method"; string_of_int arity] in
44893+
let fn_type , args_type, result_type = Ast_comb.tuple_type_pair ~loc `Make arity in
44894+
let pval_type = arrow ~loc fn_type
44895+
(Ast_typ_uncurry.lift_js_method_callback loc args_type result_type) in
44896+
Ast_external_mk.local_extern_cont loc ~pval_prim ~pval_type
44897+
(fun prim -> Ast_compatible.app1 ~loc prim body)
4489844898

4489944899
let to_uncurry_fn =
4490044900
generic_to_uncurry_exp `Fn

0 commit comments

Comments
 (0)