Skip to content

Commit 3800dc0

Browse files
cannorincannorin
committed
Support @new @variadic
Signed-off-by: Yuta Sato <[email protected]>
1 parent cf8ff3b commit 3800dc0

15 files changed

+648
-497
lines changed

‎jscomp/core/lam_compile_external_call.ml

Lines changed: 27 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
(* Copyright (C) 2015 - 2016 Bloomberg Finance L.P.
2-
* Copyright (C) 2017 - Hongbo Zhang, Authors of ReScript
2+
* Copyright (C) 2017 - Hongbo Zhang, Authors of ReScript
33
* This program is free software: you can redistribute it and/or modify
44
* it under the terms of the GNU Lesser General Public License as published by
55
* the Free Software Foundation, either version 3 of the License, or
@@ -17,7 +17,7 @@
1717
* but WITHOUT ANY WARRANTY; without even the implied warranty of
1818
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1919
* GNU Lesser General Public License for more details.
20-
*
20+
*
2121
* You should have received a copy of the GNU Lesser General Public License
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
@@ -30,13 +30,17 @@ let splice_fn_apply fn args =
3030
E.runtime_call Js_runtime_modules.caml_splice_call "spliceApply"
3131
[ fn; E.array Immutable args ]
3232

33+
let splice_fn_new_apply fn args =
34+
E.runtime_call Js_runtime_modules.caml_splice_call "spliceNewApply"
35+
[ fn; E.array Immutable args ]
36+
3337
let splice_obj_fn_apply obj name args =
3438
E.runtime_call Js_runtime_modules.caml_splice_call "spliceObjApply"
3539
[ obj; E.str name; E.array Immutable args ]
3640

37-
(**
38-
[bind_name] is a hint to the compiler to generate
39-
better names for external module
41+
(**
42+
[bind_name] is a hint to the compiler to generate
43+
better names for external module
4044
*)
4145
(* let handle_external
4246
({bundle ; module_bind_name} : External_ffi_types.external_module_name)
@@ -271,7 +275,7 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types
271275
let args, eff = assemble_args_no_splice arg_types args in
272276
(* TODO: fix in rest calling convention *)
273277
add_eff eff (E.call ~info:{ arity = Full; call_info = Call_na } fn args)
274-
| Js_new { external_module_name = module_name; name = fn; scopes } ->
278+
| Js_new { external_module_name = module_name; name = fn; splice; scopes } ->
275279
(* handle [@@new]*)
276280
(* This has some side effect, it will
277281
mark its identifier (If it has) as an object,
@@ -281,15 +285,24 @@ let translate_ffi (cxt : Lam_compile_context.t) arg_types
281285
TODO: we should propagate this property
282286
as much as we can(in alias table)
283287
*)
284-
let args, eff = assemble_args_no_splice arg_types args in
288+
let mark () =
289+
match cxt.continuation with
290+
| Declare (_, id) | Assign id ->
291+
(* Format.fprintf Format.err_formatter "%a@."Ident.print id; *)
292+
Ext_ident.make_js_object id
293+
| EffectCall _ | NeedValue _ -> ()
294+
in
285295
let fn = translate_scoped_module_val module_name fn scopes in
286-
add_eff eff
287-
((match cxt.continuation with
288-
| Declare (_, id) | Assign id ->
289-
(* Format.fprintf Format.err_formatter "%a@."Ident.print id; *)
290-
Ext_ident.make_js_object id
291-
| EffectCall _ | NeedValue _ -> ());
292-
E.new_ fn args)
296+
if splice then
297+
let args, eff, dynamic = assemble_args_has_splice arg_types args in
298+
add_eff eff
299+
(mark ();
300+
if dynamic then splice_fn_new_apply fn args
301+
else E.new_ fn args)
302+
else
303+
let args, eff = assemble_args_no_splice arg_types args in
304+
add_eff eff
305+
(mark (); E.new_ fn args)
293306
| Js_send { splice; name; js_send_scopes } -> (
294307
match args with
295308
| self :: args ->

‎jscomp/frontend/ast_external_process.ml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@ let spec_of_ptyp (nolabel : bool) (ptyp : Parsetree.core_type) :
8282
if nolabel then Extern_unit else Nothing
8383
| _ -> Nothing)
8484

85-
(* is_optional = false
85+
(* is_optional = false
8686
*)
8787
let refine_arg_type ~(nolabel : bool) (ptyp : Ast_core_type.t) :
8888
External_arg_spec.attr =
@@ -675,7 +675,7 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
675675
{[
676676
external ff : int -> int [@bs] = "" [@@module "xx"]
677677
]}
678-
FIXME: splice is not supported here
678+
FIXME: splice is not supported here
679679
*)
680680
Js_var { name; external_module_name = None; scopes }
681681
else Js_call { splice; name; external_module_name = None; scopes }
@@ -800,12 +800,12 @@ let external_desc_of_non_obj (loc : Location.t) (st : external_desc)
800800
val_send = None;
801801
set_name = None;
802802
get_name = None;
803-
splice = false;
803+
splice;
804804
scopes;
805805
mk_obj = _;
806806
return_wrapper = _;
807807
} ->
808-
Js_new { name; external_module_name; scopes }
808+
Js_new { name; external_module_name; splice; scopes }
809809
| { new_name = Some _; _ } ->
810810
Bs_syntaxerr.err loc
811811
(Conflict_ffi_attribute "Attribute found that conflicts with %@new")

‎jscomp/frontend/external_ffi_types.ml

Lines changed: 76 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ type module_bind_name =
2929
| Phint_nothing
3030

3131

32-
type external_module_name = {
32+
type external_module_name = {
3333
bundle : string ;
3434
module_bind_name : module_bind_name
3535
}
@@ -51,7 +51,7 @@ type external_spec =
5151
scopes : string list
5252
}
5353
| Js_module_as_var of external_module_name
54-
| Js_module_as_fn of {
54+
| Js_module_as_fn of {
5555
external_module_name : external_module_name;
5656
splice : bool
5757
}
@@ -72,13 +72,14 @@ type external_spec =
7272
| Js_new of {
7373
name : string ;
7474
external_module_name : external_module_name option;
75+
splice : bool ;
7576
scopes : string list;
7677
}
77-
| Js_set of {
78+
| Js_set of {
7879
js_set_name : string ;
7980
js_set_scopes : string list
8081
}
81-
| Js_get of {
82+
| Js_get of {
8283
js_get_name : string ;
8384
js_get_scopes : string list;
8485
}
@@ -119,9 +120,9 @@ type return_wrapper =
119120
| Return_null_undefined_to_opt
120121
| Return_replaced_with_unit
121122

122-
type params =
123+
type params =
123124
| Params of External_arg_spec.params
124-
| Param_number of int
125+
| Param_number of int
125126

126127
type t =
127128
| Ffi_bs of params *
@@ -166,7 +167,7 @@ let valid_ident (s : string) =
166167
true
167168
with E -> false )
168169

169-
let is_package_relative_path (x : string) =
170+
let is_package_relative_path (x : string) =
170171
Ext_string.starts_with x "./" ||
171172
Ext_string.starts_with x "../"
172173

@@ -177,7 +178,7 @@ let valid_global_name ?loc txt =
177178
(fun s ->
178179
if not (valid_ident s) then
179180
Location.raise_errorf ?loc "Not a valid global name %s" txt
180-
)
181+
)
181182

182183
(*
183184
We loose such check (see #2583),
@@ -200,14 +201,14 @@ let check_external_module_name ?loc x =
200201

201202

202203

203-
let check_ffi ?loc ffi : bool =
204-
let xrelative = ref false in
205-
let upgrade bool =
206-
if not (!xrelative) then xrelative := bool in
204+
let check_ffi ?loc ffi : bool =
205+
let xrelative = ref false in
206+
let upgrade bool =
207+
if not (!xrelative) then xrelative := bool in
207208
begin match ffi with
208-
| Js_var {name; external_module_name; scopes = _} ->
209+
| Js_var {name; external_module_name; scopes = _} ->
209210
upgrade (is_package_relative_path name);
210-
Ext_option.iter external_module_name (fun name ->
211+
Ext_option.iter external_module_name (fun name ->
211212
upgrade (is_package_relative_path name.bundle));
212213
valid_global_name ?loc name
213214
| Js_send {name ; splice = _; js_send_scopes = _}
@@ -221,10 +222,10 @@ let check_ffi ?loc ffi : bool =
221222
| Js_module_as_var external_module_name
222223
| Js_module_as_fn {external_module_name; splice = _}
223224
| Js_module_as_class external_module_name
224-
->
225+
->
225226
upgrade (is_package_relative_path external_module_name.bundle);
226227
check_external_module_name external_module_name
227-
| Js_new {external_module_name ; name; scopes = _}
228+
| Js_new {external_module_name ; name; splice = _; scopes = _}
228229
| Js_call {external_module_name ; name ; splice = _; scopes = _ }
229230
->
230231
Ext_option.iter external_module_name (fun external_module_name ->
@@ -233,8 +234,8 @@ let check_ffi ?loc ffi : bool =
233234
check_external_module_name ?loc name
234235
);
235236

236-
valid_global_name ?loc name
237-
end;
237+
valid_global_name ?loc name
238+
end;
238239
!xrelative
239240

240241
(* let bs_prefix = "BS:"
@@ -255,119 +256,119 @@ let check_ffi ?loc ffi : bool =
255256
let to_string (t : t) =
256257
Marshal.to_string t []
257258

258-
(* \132\149\166\190
259+
(* \132\149\166\190
259260
0x84 95 A6 BE Intext_magic_small intext.h
260261
https://github.com/ocaml/merlin/commit/b094c937c3a360eb61054f7652081b88e4f3612f
261262
*)
262-
let is_bs_primitive s =
263+
let is_bs_primitive s =
263264
String.length s >= 20 (* Marshal.header_size*) &&
264265
String.unsafe_get s 0 = '\132' &&
265-
String.unsafe_get s 1 = '\149'
266+
String.unsafe_get s 1 = '\149'
266267

267-
let () = Oprint.map_primitive_name :=
268+
let () = Oprint.map_primitive_name :=
268269

269-
# 272 "frontend/external_ffi_types.pp.ml"
270+
# 273 "frontend/external_ffi_types.pp.ml"
270271
String.escaped
271272

272-
# 275 "frontend/external_ffi_types.pp.ml"
273+
# 276 "frontend/external_ffi_types.pp.ml"
273274
(* TODO: better error message when version mismatch *)
274275
let from_string s : t =
275-
if is_bs_primitive s then
276+
if is_bs_primitive s then
276277
Ext_marshal.from_string s
277278
else Ffi_normal
278279

279-
let () =
280-
Primitive.coerce :=
281-
(fun
282-
({prim_name; prim_arity; prim_native_name;
283-
prim_alloc = _;
284-
prim_native_repr_args = _;
285-
prim_native_repr_res = _} : Primitive.description)
286-
(p2 : Primitive.description) ->
287-
let p2_native = p2.prim_native_name in
288-
prim_name = p2.prim_name &&
280+
let () =
281+
Primitive.coerce :=
282+
(fun
283+
({prim_name; prim_arity; prim_native_name;
284+
prim_alloc = _;
285+
prim_native_repr_args = _;
286+
prim_native_repr_res = _} : Primitive.description)
287+
(p2 : Primitive.description) ->
288+
let p2_native = p2.prim_native_name in
289+
prim_name = p2.prim_name &&
289290
prim_arity = p2.prim_arity &&
290291
prim_native_name = p2_native || (
291-
match from_string prim_native_name, from_string p2_native with
292-
| Ffi_obj_create obj_parms, Ffi_obj_create obj_parms2 ->
293-
Ext_list.for_all2_no_exn obj_parms obj_parms2 (fun {obj_arg_type; obj_arg_label} b ->
294-
let b_obj_arg_label = b.obj_arg_label in
292+
match from_string prim_native_name, from_string p2_native with
293+
| Ffi_obj_create obj_parms, Ffi_obj_create obj_parms2 ->
294+
Ext_list.for_all2_no_exn obj_parms obj_parms2 (fun {obj_arg_type; obj_arg_label} b ->
295+
let b_obj_arg_label = b.obj_arg_label in
295296
obj_arg_type = b.obj_arg_type &&
296297
(obj_arg_label = b_obj_arg_label ||
297-
match obj_arg_label, b_obj_arg_label with
298+
match obj_arg_label, b_obj_arg_label with
298299
| Obj_optional {name; for_sure_no_nested_option}, Obj_optional p
299-
->
300+
->
300301
name = p.name &&
301302
((Obj.magic for_sure_no_nested_option : int) <= (Obj.magic p.for_sure_no_nested_option))
302-
| _ -> false
303+
| _ -> false
303304
)
304305
)
305-
| Ffi_bs _, Ffi_bs _ -> false
306-
| _ -> false
306+
| Ffi_bs _, Ffi_bs _ -> false
307+
| _ -> false
307308
)
308309
)
309-
let inline_string_primitive (s : string) (op : string option) : string list =
310-
let lam : Lam_constant.t =
311-
match op with
310+
let inline_string_primitive (s : string) (op : string option) : string list =
311+
let lam : Lam_constant.t =
312+
match op with
312313
| Some op
313314
when Ast_utf8_string_interp.is_unicode_string op ->
314315
Const_unicode s
315316
| _ ->
316-
(Const_string s) in
317+
(Const_string s) in
317318
[""; to_string (Ffi_inline_const lam )]
318319

319320
(* Let's only do it for string ATM
320-
for boolean, and ints, a good optimizer should
321+
for boolean, and ints, a good optimizer should
321322
do it by default?
322323
But it may not work after layers of indirection
323324
e.g, submodule
324325
*)
325-
let inline_bool_primitive b : string list =
326-
let lam : Lam_constant.t =
327-
if b then Lam_constant.Const_js_true
326+
let inline_bool_primitive b : string list =
327+
let lam : Lam_constant.t =
328+
if b then Lam_constant.Const_js_true
328329
else Lam_constant.Const_js_false
329-
in
330+
in
330331
[""; to_string (Ffi_inline_const lam )]
331332

332333
(* FIXME: check overflow ?*)
333-
let inline_int_primitive (i : int32) : string list =
334-
["";
335-
to_string
336-
(Ffi_inline_const
334+
let inline_int_primitive (i : int32) : string list =
335+
["";
336+
to_string
337+
(Ffi_inline_const
337338
(Const_int {i; comment = None}))
338339
]
339340

340-
let inline_int64_primitive (i : int64) : string list =
341-
["";
342-
to_string
343-
(Ffi_inline_const
341+
let inline_int64_primitive (i : int64) : string list =
342+
["";
343+
to_string
344+
(Ffi_inline_const
344345
(Const_int64 i))
345346
]
346347

347348
let inline_float_primitive (i : string) : string list =
348349
["";
349-
to_string
350+
to_string
350351
(Ffi_inline_const (Const_float i))
351-
]
352-
let rec ffi_bs_aux acc (params : External_arg_spec.params) =
353-
match params with
354-
| {arg_type = Nothing; arg_label = Arg_empty}
352+
]
353+
let rec ffi_bs_aux acc (params : External_arg_spec.params) =
354+
match params with
355+
| {arg_type = Nothing; arg_label = Arg_empty}
355356
(* same as External_arg_spec.dummy*)
356-
:: rest ->
357-
ffi_bs_aux (acc + 1) rest
358-
| _ :: _ -> -1
359-
| [] -> acc
357+
:: rest ->
358+
ffi_bs_aux (acc + 1) rest
359+
| _ :: _ -> -1
360+
| [] -> acc
360361

361362
let ffi_bs (params : External_arg_spec.params) return attr =
362-
let n = ffi_bs_aux 0 params in
363-
if n < 0 then Ffi_bs (Params params,return,attr)
364-
else Ffi_bs (Param_number n, return, attr)
363+
let n = ffi_bs_aux 0 params in
364+
if n < 0 then Ffi_bs (Params params,return,attr)
365+
else Ffi_bs (Param_number n, return, attr)
365366

366-
let ffi_bs_as_prims params return attr =
367+
let ffi_bs_as_prims params return attr =
367368
[""; to_string (ffi_bs params return attr)]
368369

369370
let ffi_obj_create obj_params =
370371
Ffi_obj_create obj_params
371372

372-
let ffi_obj_as_prims obj_params =
373+
let ffi_obj_as_prims obj_params =
373374
["";to_string (Ffi_obj_create obj_params)]

0 commit comments

Comments
 (0)