Skip to content

Commit 33aa3a3

Browse files
cristianoccristianoc
authored
Make legacy uncurried apply for .ml use new uncurried application. (#5837)
1 parent 4242f3b commit 33aa3a3

File tree

6 files changed

+80
-76
lines changed

6 files changed

+80
-76
lines changed

‎jscomp/frontend/ast_exp_apply.ml

Lines changed: 20 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -258,11 +258,24 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
258258
match
259259
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
260260
with
261-
| Some pexp_attributes ->
262-
{
263-
e with
264-
pexp_desc =
265-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
266-
pexp_attributes;
267-
}
261+
| Some pexp_attributes -> (
262+
(* syntax: {[f arg0 arg1 [@bs]]} only for legacy .ml files *)
263+
let fn = self.expr self fn in
264+
let args =
265+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
266+
in
267+
let jsInternal = Ast_literal.Lid.js_internal in
268+
let loc = e.pexp_loc in
269+
match args with
270+
| [
271+
( Nolabel,
272+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
273+
] ->
274+
Exp.apply ~loc ~attrs:pexp_attributes
275+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
276+
[ (Nolabel, fn) ]
277+
| _ ->
278+
Exp.apply ~loc
279+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
280+
fn args)
268281
| None -> default_expr_mapper self e))

‎jscomp/frontend/ast_uncurry_apply.ml

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -127,10 +127,6 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
127127
{ loc; txt = Ast_literal.Lid.hidden_field arity_s } );
128128
])
129129
args)
130-
131-
let uncurry_fn_apply loc self fn args =
132-
generic_apply loc self fn args (fun _ obj -> obj)
133-
134130
let property_apply loc self obj name args =
135131
generic_apply loc self obj args (fun loc obj ->
136132
Exp.send ~loc obj { txt = name; loc })

‎jscomp/frontend/ast_uncurry_apply.mli

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -24,14 +24,6 @@
2424

2525
(* TODO: the interface is not reusable, it depends on too much context *)
2626

27-
val uncurry_fn_apply :
28-
Location.t ->
29-
Bs_ast_mapper.mapper ->
30-
Parsetree.expression ->
31-
Ast_compatible.args ->
32-
Parsetree.expression_desc
33-
(** syntax: {[f arg0 arg1 [@bs]]}*)
34-
3527
val method_apply :
3628
Location.t ->
3729
Bs_ast_mapper.mapper ->

‎lib/4.06.1/unstable/js_compiler.ml

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -148534,14 +148534,6 @@ module Ast_uncurry_apply : sig
148534148534

148535148535
(* TODO: the interface is not reusable, it depends on too much context *)
148536148536

148537-
val uncurry_fn_apply :
148538-
Location.t ->
148539-
Bs_ast_mapper.mapper ->
148540-
Parsetree.expression ->
148541-
Ast_compatible.args ->
148542-
Parsetree.expression_desc
148543-
(** syntax: {[f arg0 arg1 [@bs]]}*)
148544-
148545148537
val method_apply :
148546148538
Location.t ->
148547148539
Bs_ast_mapper.mapper ->
@@ -148691,10 +148683,6 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
148691148683
{ loc; txt = Ast_literal.Lid.hidden_field arity_s } );
148692148684
])
148693148685
args)
148694-
148695-
let uncurry_fn_apply loc self fn args =
148696-
generic_apply loc self fn args (fun _ obj -> obj)
148697-
148698148686
let property_apply loc self obj name args =
148699148687
generic_apply loc self obj args (fun loc obj ->
148700148688
Exp.send ~loc obj { txt = name; loc })
@@ -150683,13 +150671,26 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
150683150671
match
150684150672
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
150685150673
with
150686-
| Some pexp_attributes ->
150687-
{
150688-
e with
150689-
pexp_desc =
150690-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
150691-
pexp_attributes;
150692-
}
150674+
| Some pexp_attributes -> (
150675+
(* syntax: {[f arg0 arg1 [@bs]]} only for legacy .ml files *)
150676+
let fn = self.expr self fn in
150677+
let args =
150678+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
150679+
in
150680+
let jsInternal = Ast_literal.Lid.js_internal in
150681+
let loc = e.pexp_loc in
150682+
match args with
150683+
| [
150684+
( Nolabel,
150685+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
150686+
] ->
150687+
Exp.apply ~loc ~attrs:pexp_attributes
150688+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
150689+
[ (Nolabel, fn) ]
150690+
| _ ->
150691+
Exp.apply ~loc
150692+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
150693+
fn args)
150693150694
| None -> default_expr_mapper self e))
150694150695

150695150696
end

‎lib/4.06.1/unstable/js_playground_compiler.ml

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -148534,14 +148534,6 @@ module Ast_uncurry_apply : sig
148534148534

148535148535
(* TODO: the interface is not reusable, it depends on too much context *)
148536148536

148537-
val uncurry_fn_apply :
148538-
Location.t ->
148539-
Bs_ast_mapper.mapper ->
148540-
Parsetree.expression ->
148541-
Ast_compatible.args ->
148542-
Parsetree.expression_desc
148543-
(** syntax: {[f arg0 arg1 [@bs]]}*)
148544-
148545148537
val method_apply :
148546148538
Location.t ->
148547148539
Bs_ast_mapper.mapper ->
@@ -148691,10 +148683,6 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
148691148683
{ loc; txt = Ast_literal.Lid.hidden_field arity_s } );
148692148684
])
148693148685
args)
148694-
148695-
let uncurry_fn_apply loc self fn args =
148696-
generic_apply loc self fn args (fun _ obj -> obj)
148697-
148698148686
let property_apply loc self obj name args =
148699148687
generic_apply loc self obj args (fun loc obj ->
148700148688
Exp.send ~loc obj { txt = name; loc })
@@ -150683,13 +150671,26 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
150683150671
match
150684150672
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
150685150673
with
150686-
| Some pexp_attributes ->
150687-
{
150688-
e with
150689-
pexp_desc =
150690-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
150691-
pexp_attributes;
150692-
}
150674+
| Some pexp_attributes -> (
150675+
(* syntax: {[f arg0 arg1 [@bs]]} only for legacy .ml files *)
150676+
let fn = self.expr self fn in
150677+
let args =
150678+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
150679+
in
150680+
let jsInternal = Ast_literal.Lid.js_internal in
150681+
let loc = e.pexp_loc in
150682+
match args with
150683+
| [
150684+
( Nolabel,
150685+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
150686+
] ->
150687+
Exp.apply ~loc ~attrs:pexp_attributes
150688+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
150689+
[ (Nolabel, fn) ]
150690+
| _ ->
150691+
Exp.apply ~loc
150692+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
150693+
fn args)
150693150694
| None -> default_expr_mapper self e))
150694150695

150695150696
end

‎lib/4.06.1/whole_compiler.ml

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -158818,14 +158818,6 @@ module Ast_uncurry_apply : sig
158818158818

158819158819
(* TODO: the interface is not reusable, it depends on too much context *)
158820158820

158821-
val uncurry_fn_apply :
158822-
Location.t ->
158823-
Bs_ast_mapper.mapper ->
158824-
Parsetree.expression ->
158825-
Ast_compatible.args ->
158826-
Parsetree.expression_desc
158827-
(** syntax: {[f arg0 arg1 [@bs]]}*)
158828-
158829158821
val method_apply :
158830158822
Location.t ->
158831158823
Bs_ast_mapper.mapper ->
@@ -158975,10 +158967,6 @@ let method_apply loc (self : Bs_ast_mapper.mapper) (obj : Parsetree.expression)
158975158967
{ loc; txt = Ast_literal.Lid.hidden_field arity_s } );
158976158968
])
158977158969
args)
158978-
158979-
let uncurry_fn_apply loc self fn args =
158980-
generic_apply loc self fn args (fun _ obj -> obj)
158981-
158982158970
let property_apply loc self obj name args =
158983158971
generic_apply loc self obj args (fun loc obj ->
158984158972
Exp.send ~loc obj { txt = name; loc })
@@ -160967,13 +160955,26 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
160967160955
match
160968160956
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
160969160957
with
160970-
| Some pexp_attributes ->
160971-
{
160972-
e with
160973-
pexp_desc =
160974-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
160975-
pexp_attributes;
160976-
}
160958+
| Some pexp_attributes -> (
160959+
(* syntax: {[f arg0 arg1 [@bs]]} only for legacy .ml files *)
160960+
let fn = self.expr self fn in
160961+
let args =
160962+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
160963+
in
160964+
let jsInternal = Ast_literal.Lid.js_internal in
160965+
let loc = e.pexp_loc in
160966+
match args with
160967+
| [
160968+
( Nolabel,
160969+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
160970+
] ->
160971+
Exp.apply ~loc ~attrs:pexp_attributes
160972+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
160973+
[ (Nolabel, fn) ]
160974+
| _ ->
160975+
Exp.apply ~loc
160976+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
160977+
fn args)
160977160978
| None -> default_expr_mapper self e))
160978160979

160979160980
end

0 commit comments

Comments
 (0)