Skip to content

Commit 0dc30d5

Browse files
cristianoccristianoc
committed
Make legacy uncurried apply for .ml use new uncurried application.
This is an extra check that existing uncurried tests still work. Later, they can be converted to .res.
1 parent 3114872 commit 0dc30d5

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)