Skip to content

Commit 45b3799

Browse files
committed
Remove Exp.apply
1 parent a8a4ea0 commit 45b3799

14 files changed

+988
-1005
lines changed

jscomp/all.depend

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -201,7 +201,7 @@ syntax/ast_derive.cmx : ext/string_map.cmx ext/literals.cmx \
201201
syntax/ast_structure.cmx syntax/ast_signature.cmx syntax/ast_payload.cmx \
202202
syntax/ast_derive.cmi
203203
syntax/ast_comb.cmx : ext/ext_list.cmx syntax/ast_literal.cmx \
204-
syntax/ast_comb.cmi
204+
syntax/ast_compatible.cmx syntax/ast_comb.cmi
205205
syntax/ast_core_type.cmx : ext/ext_list.cmx syntax/bs_syntaxerr.cmx \
206206
syntax/ast_comb.cmx syntax/ast_core_type.cmi
207207
syntax/bs_ast_invariant.cmx : ext/literals.cmx ext/hash_set_poly.cmx \
@@ -258,12 +258,14 @@ syntax/ast_tuple_pattern_flatten.cmx : ext/ext_list.cmx \
258258
syntax/ast_exp_apply.cmx : ext/literals.cmx ext/ext_list.cmx \
259259
syntax/bs_ast_mapper.cmx syntax/bs_ast_invariant.cmx syntax/ast_util.cmx \
260260
syntax/ast_tuple_pattern_flatten.cmx syntax/ast_literal.cmx \
261-
syntax/ast_attributes.cmx syntax/ast_exp_apply.cmi
261+
syntax/ast_compatible.cmx syntax/ast_attributes.cmx \
262+
syntax/ast_exp_apply.cmi
262263
syntax/ast_exp_extension.cmx : ext/literals.cmx ext/ext_string.cmx \
263264
ext/ext_ref.cmx ext/ext_pervasives.cmx common/bs_version.cmx \
264265
syntax/bs_ast_mapper.cmx syntax/ast_util.cmx syntax/ast_payload.cmx \
265266
syntax/ast_literal.cmx syntax/ast_derive.cmx syntax/ast_core_type.cmx \
266-
syntax/ast_comb.cmx syntax/ast_exp_extension.cmi
267+
syntax/ast_compatible.cmx syntax/ast_comb.cmx \
268+
syntax/ast_exp_extension.cmi
267269
syntax/ast_core_type_class_type.cmx : ext/literals.cmx ext/ext_ref.cmx \
268270
ext/ext_list.cmx syntax/bs_ast_mapper.cmx syntax/ast_util.cmx \
269271
syntax/ast_literal.cmx syntax/ast_comb.cmx syntax/ast_attributes.cmx \
@@ -277,7 +279,7 @@ syntax/ppx_entry.cmx : ext/string_map.cmx ext/literals.cmx \
277279
syntax/ast_literal.cmx syntax/ast_exp_extension.cmx \
278280
syntax/ast_exp_apply.cmx syntax/ast_derive_projector.cmx \
279281
syntax/ast_derive_js_mapper.cmx syntax/ast_core_type_class_type.cmx \
280-
syntax/ast_attributes.cmx syntax/ppx_entry.cmi
282+
syntax/ast_compatible.cmx syntax/ast_attributes.cmx syntax/ppx_entry.cmi
281283
syntax/bs_syntaxerr.cmi :
282284
syntax/ast_compatible.cmi :
283285
syntax/ast_utf8_string.cmi :

jscomp/bin/all_ounit_tests.ml

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14376,6 +14376,11 @@ val app3:
1437614376
expression ->
1437714377
expression
1437814378

14379+
(** Note this function would slightly
14380+
change its semantics depending on compiler versions
14381+
for newer version: it means always label
14382+
for older version: it could be optional (which we should avoid)
14383+
*)
1437914384
val apply_labels:
1438014385
?loc:Location.t ->
1438114386
?attrs:attrs ->

jscomp/syntax/ast_comb.ml

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,7 @@
2525

2626
open Ast_helper
2727

28-
let exp_apply_no_label ?loc ?attrs a b =
29-
Exp.apply ?loc ?attrs a (Ext_list.map (fun x -> "", x) b)
28+
3029

3130
(* let fun_no_label ?loc ?attrs pat body =
3231
Ast_compatible.fun_ ?loc ?attrs pat body *)
@@ -35,7 +34,7 @@ let arrow_no_label ?loc ?attrs b c =
3534
Typ.arrow ?loc ?attrs "" b c
3635

3736
let discard_exp_as_unit loc e =
38-
exp_apply_no_label ~loc
37+
Ast_compatible.apply_simple ~loc
3938
(Exp.ident ~loc {txt = Ast_literal.Lid.ignore_id; loc})
4039
[Exp.constraint_ ~loc e
4140
(Ast_literal.type_unit ~loc ())]

jscomp/syntax/ast_comb.mli

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,10 +23,10 @@
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

2525

26-
val exp_apply_no_label :
26+
(* val exp_apply_no_label :
2727
?loc:Location.t ->
2828
?attrs:Parsetree.attributes ->
29-
Parsetree.expression -> Parsetree.expression list -> Parsetree.expression
29+
Parsetree.expression -> Parsetree.expression list -> Parsetree.expression *)
3030

3131
(* val fun_no_label :
3232
?loc:Location.t ->

jscomp/syntax/ast_compatible.mli

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,11 @@ val app3:
7676
expression ->
7777
expression
7878

79+
(** Note this function would slightly
80+
change its semantics depending on compiler versions
81+
for newer version: it means always label
82+
for older version: it could be optional (which we should avoid)
83+
*)
7984
val apply_labels:
8085
?loc:Location.t ->
8186
?attrs:attrs ->

jscomp/syntax/ast_derive_dyn.ml

Lines changed: 21 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -136,8 +136,8 @@ let rec exp_of_core_type prefix
136136
Exp.ident (fn_of_lid prefix lid)
137137
| Ptyp_constr (lid, params)
138138
->
139-
Exp.apply (Exp.ident (fn_of_lid prefix lid))
140-
(Ext_list.map (fun x -> "",exp_of_core_type prefix x ) params)
139+
Ast_compatible.apply_simple (Exp.ident (fn_of_lid prefix lid))
140+
(Ext_list.map (fun x -> exp_of_core_type prefix x ) params)
141141
| Ptyp_tuple lst ->
142142
begin match lst with
143143
| [x] -> exp_of_core_type prefix x
@@ -148,8 +148,8 @@ let rec exp_of_core_type prefix
148148
Location.raise_errorf ~loc "tuple arity > 6 not supported yet"
149149
else
150150
let fn = js_dyn_tuple_to_value len in
151-
let args = Ext_list.map (fun x -> "", exp_of_core_type prefix x) lst in
152-
Exp.apply fn args
151+
let args = Ext_list.map (fun x -> exp_of_core_type prefix x) lst in
152+
Ast_compatible.apply_simple fn args
153153
end
154154

155155

@@ -203,27 +203,27 @@ let case_of_ctdcl (ctdcls : Parsetree.constructor_declaration list) =
203203
(List.mapi (fun i ctdcl ->
204204
let pat, core_type_exprs = destruct_constructor_declaration ctdcl in
205205
Exp.case pat
206-
(Exp.apply
206+
(Ast_compatible.app3
207207
(js_dyn_variant_to_value ())
208-
[("", Exp.ident {txt = Lident shape ; loc});
209-
("", Ast_compatible.const_exp_int i);
210-
("", exp_of_core_type_exprs core_type_exprs);
211-
]
208+
( Exp.ident {txt = Lident shape ; loc})
209+
( Ast_compatible.const_exp_int i)
210+
( exp_of_core_type_exprs core_type_exprs)
211+
212212
)) ctdcls
213213
)
214214
let record args =
215-
Exp.apply
215+
Ast_compatible.app2
216216
(Exp.ident {txt = Ldot (Lident js_dyn, record_to_value ); loc})
217-
["", Exp.ident {txt = Lident shape ; loc};
218-
("", args)
219-
]
217+
(Exp.ident {txt = Lident shape ; loc})
218+
args
219+
220220

221221

222222
let fun_1 name =
223223
Ast_compatible.fun_ ~attrs:bs_attrs
224224
(Pat.var {txt = "x"; loc})
225-
(Exp.apply (Exp.ident name)
226-
["",(Exp.ident {txt = Lident "x"; loc})])
225+
(Ast_compatible.app1 (Exp.ident name)
226+
(Exp.ident {txt = Lident "x"; loc}))
227227

228228
let record_exp name core_type labels : Ast_structure.t =
229229
let arg_name : string = "args" in
@@ -233,8 +233,8 @@ let record_exp name core_type labels : Ast_structure.t =
233233
[Str.value Nonrecursive @@
234234
[Vb.mk
235235
(Pat.var {txt = shape; loc})
236-
(Exp.apply (js_dyn_shape_of_record ())
237-
["", (Ast_derive_util.lift_string_list_to_array labels)]
236+
(Ast_compatible.app1 (js_dyn_shape_of_record ())
237+
(Ast_derive_util.lift_string_list_to_array labels)
238238
) ];
239239
Str.value Nonrecursive @@
240240
[Vb.mk (Pat.var {txt = name ^ to_value_ ; loc })
@@ -288,10 +288,10 @@ let init () =
288288
[
289289
Str.value Nonrecursive @@
290290
[Vb.mk (Pat.var {txt = shape ; loc})
291-
( Exp.apply (js_dyn_shape_of_variant ())
292-
[ "", (Ast_derive_util.lift_string_list_to_array names);
293-
"", (Ast_compatible.const_exp_int_list_as_array arities )
294-
])];
291+
( Ast_compatible.app2 (js_dyn_shape_of_variant ())
292+
(Ast_derive_util.lift_string_list_to_array names)
293+
(Ast_compatible.const_exp_int_list_as_array arities )
294+
)];
295295
Str.value Nonrecursive @@
296296
[Vb.mk (Pat.var {txt = name ^ to_value_ ; loc})
297297
(case_of_ctdcl cd)

jscomp/syntax/ast_derive_js_mapper.ml

Lines changed: 20 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -27,15 +27,14 @@ module U = Ast_derive_util
2727
type tdcls = Parsetree.type_declaration list
2828

2929
let js_field (o : Parsetree.expression) m =
30-
Exp.apply
30+
Ast_compatible.app2
3131
(Exp.ident {txt = Lident "##"; loc = o.pexp_loc})
32-
[
33-
"",o;
34-
"", Exp.ident m
35-
]
36-
let const_int i = Exp.constant (Const_int i)
37-
let const_string s = Exp.constant (Const_string (s,None))
32+
o
33+
(Exp.ident m)
3834

35+
(* let Ast_compatible.const_exp_int i = Exp.constant (Const_int i) *)
36+
let const_string s = Exp.constant (Const_string (s,None))
37+
3938

4039
let handle_config (config : Parsetree.expression option) =
4140
match config with
@@ -65,18 +64,17 @@ let noloc = Location.none
6564
let eraseTypeLit = "jsMapperEraseType"
6665
let eraseTypeExp = Exp.ident {loc = noloc; txt = Lident eraseTypeLit}
6766
let eraseType x =
68-
Exp.apply eraseTypeExp ["", x]
67+
Ast_compatible.app1 eraseTypeExp x
6968
let eraseTypeStr =
7069
let any = Typ.any () in
7170
Str.primitive
7271
(Val.mk ~prim:["%identity"] {loc = noloc; txt = eraseTypeLit}
7372
(Typ.arrow "" any any)
7473
)
7574

76-
let app2 f arg1 arg2 =
77-
Exp.apply f ["",arg1; "", arg2]
78-
let app3 f arg1 arg2 arg3 =
79-
Exp.apply f ["", arg1; "", arg2; "", arg3]
75+
let app2 = Ast_compatible.app2
76+
let app3 = Ast_compatible.app3
77+
8078
let (<=~) a b =
8179
app2 (Exp.ident {loc = noloc; txt = Lident "<="}) a b
8280
let (-~) a b =
@@ -256,7 +254,7 @@ let init () =
256254
begin match attr with
257255
| NullString result ->
258256
let result_len = List.length result in
259-
let exp_len = const_int result_len in
257+
let exp_len = Ast_compatible.const_exp_int result_len in
260258
let v = [
261259
eraseTypeStr;
262260
Ast_comb.single_non_rec_value
@@ -265,7 +263,7 @@ let init () =
265263
(List.map (fun (i,str) ->
266264
Exp.tuple
267265
[
268-
const_int i;
266+
Ast_compatible.const_exp_int i;
269267
const_string str
270268
]
271269
) (List.sort (fun (a,_) (b,_) -> compare (a:int) b) result)));
@@ -317,12 +315,13 @@ let init () =
317315
match xs with
318316
| `New xs ->
319317
let constantArrayExp = Exp.ident {loc; txt = Lident constantArray} in
320-
let exp_len = const_int (List.length ctors) in
318+
let exp_len = Ast_compatible.const_exp_int (List.length ctors) in
321319
let v = [
322320
eraseTypeStr;
323321
Ast_comb.single_non_rec_value
324322
{loc; txt = constantArray}
325-
(Exp.array (List.map (fun i -> const_int i) xs ))
323+
(Ast_compatible.const_exp_int_list_as_array xs)
324+
(* (Exp.array (List.map (fun i -> Ast_compatible.const_exp_int i) xs )) *)
326325
;
327326
toJsBody
328327
(
@@ -361,12 +360,12 @@ let init () =
361360
[ eraseTypeStr;
362361
toJsBody (
363362
coerceResultToNewType
364-
(eraseType exp_param +~ const_int offset)
363+
(eraseType exp_param +~ Ast_compatible.const_exp_int offset)
365364
)
366365
;
367366
let len = List.length ctors in
368-
let range_low = const_int (offset + 0) in
369-
let range_upper = const_int (offset + len - 1) in
367+
let range_low = Ast_compatible.const_exp_int (offset + 0) in
368+
let range_upper = Ast_compatible.const_exp_int (offset + len - 1) in
370369

371370
Ast_comb.single_non_rec_value
372371
{loc ; txt = fromJs}
@@ -383,15 +382,15 @@ let init () =
383382
(assertExp
384383
((exp_param <=~ range_upper) &&~ (range_low <=~ exp_param))
385384
)
386-
(exp_param -~ const_int offset))
385+
(exp_param -~ Ast_compatible.const_exp_int offset))
387386
)
388387
+>
389388
core_type
390389
else
391390
(Exp.ifthenelse
392391
( (exp_param <=~ range_upper) &&~ (range_low <=~ exp_param))
393392
(Exp.construct {loc; txt = Lident "Some"}
394-
( Some (exp_param -~ const_int offset)))
393+
( Some (exp_param -~ Ast_compatible.const_exp_int offset)))
395394
(Some (Exp.construct {loc; txt = Lident "None"} None)))
396395
+>
397396
Ast_core_type.lift_option_type core_type

jscomp/syntax/ast_exp_apply.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -106,9 +106,9 @@ let handle_exp_apply
106106
->
107107
{fn with pexp_desc = Pexp_construct(ctor, Some bounded_obj_arg)}
108108
| _ ->
109-
Exp.apply ~loc:fn.pexp_loc
109+
Ast_compatible.app1 ~loc:fn.pexp_loc
110110
(self.expr self fn )
111-
["", bounded_obj_arg]
111+
bounded_obj_arg
112112
) xs );
113113
pexp_attributes = tuple_attrs;
114114
pexp_loc = fn.pexp_loc;
@@ -117,7 +117,7 @@ let handle_exp_apply
117117
begin match try_dispatch_by_tuple with
118118
| Some x -> x
119119
| None ->
120-
Exp.apply ~loc (self.expr self fn) ["", new_obj_arg]
120+
Ast_compatible.app1 ~loc (self.expr self fn) new_obj_arg
121121
end
122122
end
123123
| _ ->

jscomp/syntax/ast_exp_extension.ml

Lines changed: 15 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -58,17 +58,16 @@ let handle_extension record_as_js_object e (self : Bs_ast_mapper.mapper)
5858
begin match pat.ppat_desc, body.pexp_desc with
5959
| Ppat_construct ({txt = Lident "()"}, None), Pexp_constant(Const_string(block,_))
6060
->
61-
Exp.apply ~loc
62-
(Exp.ident ~loc {txt = Ldot (Ast_literal.Lid.js_unsafe, Literals.raw_function);loc})
63-
[ "",
64-
Exp.constant ~loc (Const_string (toString {args = [] ; block }, None))
65-
]
61+
Ast_compatible.app1 ~loc
62+
(Exp.ident ~loc {txt = Ldot (Ast_literal.Lid.js_unsafe, Literals.raw_function);loc})
63+
(Exp.constant ~loc (Const_string (toString {args = [] ; block }, None)))
64+
6665

6766
| Ppat_var ({txt;}), _ ->
6867
let acc, block = unroll_function_aux [txt] body in
69-
(Exp.apply ~loc
68+
(Ast_compatible.app1 ~loc
7069
(Exp.ident ~loc {txt = Ldot (Ast_literal.Lid.js_unsafe, Literals.raw_function);loc})
71-
[ "", Exp.constant ~loc (Const_string (toString {args = List.rev acc ; block },None))]
70+
(Exp.constant ~loc (Const_string (toString {args = List.rev acc ; block },None)))
7271
)
7372
| _ -> Location.raise_errorf ~loc "bs.raw can only be applied to a string or a special function form "
7473
end
@@ -105,23 +104,23 @@ let handle_extension record_as_js_object e (self : Bs_ast_mapper.mapper)
105104
file lnum in
106105
let e = self.expr self e in
107106
Exp.sequence ~loc
108-
(Exp.apply ~loc
107+
(Ast_compatible.app1 ~loc
109108
(Exp.ident ~loc {loc;
110109
txt =
111110
Ldot (Ldot (Lident "Js", "Console"), "timeStart")
112111
})
113-
["", Exp.constant ~loc (Const_string (locString,None))]
112+
(Exp.constant ~loc (Const_string (locString,None)))
114113
)
115114
( Exp.let_ ~loc Nonrecursive
116115
[Vb.mk ~loc (Pat.var ~loc {loc; txt = "timed"}) e ;
117116
]
118117
(Exp.sequence ~loc
119-
(Exp.apply ~loc
118+
(Ast_compatible.app1 ~loc
120119
(Exp.ident ~loc {loc;
121120
txt =
122121
Ldot (Ldot (Lident "Js", "Console"), "timeEnd")
123122
})
124-
["", Exp.constant ~loc (Const_string (locString,None))]
123+
(Exp.constant ~loc (Const_string (locString,None)))
125124
)
126125
(Exp.ident ~loc {loc; txt = Lident "timed"})
127126
)
@@ -147,13 +146,10 @@ let handle_extension record_as_js_object e (self : Bs_ast_mapper.mapper)
147146
Printf.sprintf "File %S, line %d, characters %d-%d"
148147
file lnum cnum enum in
149148
let raiseWithString locString =
150-
(Exp.apply ~loc
149+
Ast_compatible.app1 ~loc
151150
(Exp.ident ~loc {loc; txt =
152-
Ldot(Ldot (Lident "Js","Exn"),"raiseError")})
153-
["",
154-
155-
Exp.constant (Const_string (locString,None))
156-
])
151+
Ldot(Ldot (Lident "Js","Exn"),"raiseError")})
152+
(Exp.constant (Const_string (locString,None)))
157153
in
158154
(match e.pexp_desc with
159155
| Pexp_construct({txt = Lident "false"},None) ->
@@ -178,9 +174,9 @@ let handle_extension record_as_js_object e (self : Bs_ast_mapper.mapper)
178174
Exp.assert_ ~loc e
179175
else
180176
Exp.ifthenelse ~loc
181-
(Exp.apply ~loc
177+
(Ast_compatible.app1 ~loc
182178
(Exp.ident {loc ; txt = Ldot(Lident "Pervasives","not")})
183-
["", e]
179+
e
184180
)
185181
(raiseWithString locString)
186182
None

0 commit comments

Comments
 (0)