Skip to content

Commit 9ff2fbf

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 9b04e92 commit 9ff2fbf

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
@@ -263,11 +263,24 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
263263
match
264264
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
265265
with
266-
| Some pexp_attributes ->
267-
{
268-
e with
269-
pexp_desc =
270-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
271-
pexp_attributes;
272-
}
266+
| Some pexp_attributes -> (
267+
(* syntax: {[f arg0 arg1 [@bs]]} only for legacy .ml files *)
268+
let fn = self.expr self fn in
269+
let args =
270+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
271+
in
272+
let jsInternal = Ast_literal.Lid.js_internal in
273+
let loc = e.pexp_loc in
274+
match args with
275+
| [
276+
( Nolabel,
277+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
278+
] ->
279+
Exp.apply ~loc ~attrs:pexp_attributes
280+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
281+
[ (Nolabel, fn) ]
282+
| _ ->
283+
Exp.apply ~loc
284+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
285+
fn args)
273286
| 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 })
@@ -150688,13 +150676,26 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
150688150676
match
150689150677
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
150690150678
with
150691-
| Some pexp_attributes ->
150692-
{
150693-
e with
150694-
pexp_desc =
150695-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
150696-
pexp_attributes;
150697-
}
150679+
| Some pexp_attributes -> (
150680+
(* syntax: {[f arg0 arg1 [@bs]]}*)
150681+
let fn = self.expr self fn in
150682+
let args =
150683+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
150684+
in
150685+
let jsInternal = Ast_literal.Lid.js_internal in
150686+
let loc = e.pexp_loc in
150687+
match args with
150688+
| [
150689+
( Nolabel,
150690+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
150691+
] ->
150692+
Exp.apply ~loc ~attrs:pexp_attributes
150693+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
150694+
[ (Nolabel, fn) ]
150695+
| _ ->
150696+
Exp.apply ~loc
150697+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
150698+
fn args)
150698150699
| None -> default_expr_mapper self e))
150699150700

150700150701
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 })
@@ -150688,13 +150676,26 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
150688150676
match
150689150677
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
150690150678
with
150691-
| Some pexp_attributes ->
150692-
{
150693-
e with
150694-
pexp_desc =
150695-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
150696-
pexp_attributes;
150697-
}
150679+
| Some pexp_attributes -> (
150680+
(* syntax: {[f arg0 arg1 [@bs]]}*)
150681+
let fn = self.expr self fn in
150682+
let args =
150683+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
150684+
in
150685+
let jsInternal = Ast_literal.Lid.js_internal in
150686+
let loc = e.pexp_loc in
150687+
match args with
150688+
| [
150689+
( Nolabel,
150690+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
150691+
] ->
150692+
Exp.apply ~loc ~attrs:pexp_attributes
150693+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
150694+
[ (Nolabel, fn) ]
150695+
| _ ->
150696+
Exp.apply ~loc
150697+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
150698+
fn args)
150698150699
| None -> default_expr_mapper self e))
150699150700

150700150701
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 })
@@ -160972,13 +160960,26 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp)
160972160960
match
160973160961
Ext_list.exclude_with_val e.pexp_attributes Ast_attributes.is_bs
160974160962
with
160975-
| Some pexp_attributes ->
160976-
{
160977-
e with
160978-
pexp_desc =
160979-
Ast_uncurry_apply.uncurry_fn_apply e.pexp_loc self fn args;
160980-
pexp_attributes;
160981-
}
160963+
| Some pexp_attributes -> (
160964+
(* syntax: {[f arg0 arg1 [@bs]]}*)
160965+
let fn = self.expr self fn in
160966+
let args =
160967+
Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e))
160968+
in
160969+
let jsInternal = Ast_literal.Lid.js_internal in
160970+
let loc = e.pexp_loc in
160971+
match args with
160972+
| [
160973+
( Nolabel,
160974+
{ pexp_desc = Pexp_construct ({ txt = Lident "()" }, None) } );
160975+
] ->
160976+
Exp.apply ~loc ~attrs:pexp_attributes
160977+
(Exp.ident { txt = Ldot (jsInternal, "run"); loc })
160978+
[ (Nolabel, fn) ]
160979+
| _ ->
160980+
Exp.apply ~loc
160981+
~attrs:(Ast_attributes.res_uapp :: pexp_attributes)
160982+
fn args)
160982160983
| None -> default_expr_mapper self e))
160983160984

160984160985
end

0 commit comments

Comments
 (0)