Skip to content

Commit ed3166a

Browse files
bobzhangbobzhang
authored
Merge pull request #667 from bloomberg/module_as_class
fix #666 see test/module_as_class_ffi
2 parents d0e2d07 + cdc162a commit ed3166a

11 files changed

+367
-56
lines changed

‎jscomp/bin/bs_ppx.ml

Lines changed: 89 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
(** Bundled by bspack 08/22-17:28 *)
1+
(** Bundled by bspack 08/23-11:37 *)
22
module String_map : sig
33
#1 "string_map.mli"
44
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -4034,7 +4034,7 @@ let int32 = "Caml_int32"
40344034
let block = "Block"
40354035
let js_primitive = "Js_primitive"
40364036
let module_ = "Caml_module"
4037-
let version = "0.9.4"
4037+
let version = "0.9.5"
40384038

40394039

40404040
let runtime_set =
@@ -4240,7 +4240,8 @@ type ffi =
42404240
| Obj_create of arg_label list
42414241
| Js_global of js_val
42424242
| Js_module_as_var of external_module_name
4243-
| Js_module_as_fn of external_module_name
4243+
| Js_module_as_fn of external_module_name
4244+
| Js_module_as_class of external_module_name
42444245
| Js_call of js_call external_module
42454246
| Js_send of js_send
42464247
| Js_new of js_val
@@ -4340,7 +4341,8 @@ type ffi =
43404341
| Obj_create of arg_label list
43414342
| Js_global of js_val
43424343
| Js_module_as_var of external_module_name
4343-
| Js_module_as_fn of external_module_name
4344+
| Js_module_as_fn of external_module_name
4345+
| Js_module_as_class of external_module_name
43444346
| Js_call of js_call external_module
43454347
| Js_send of js_send
43464348
| Js_new of js_val
@@ -4416,7 +4418,8 @@ let check_ffi ?loc ffi =
44164418
-> ()
44174419

44184420
| Js_module_as_var external_module_name
4419-
| Js_module_as_fn external_module_name
4421+
| Js_module_as_fn external_module_name
4422+
| Js_module_as_class external_module_name
44204423
-> check_external_module_name external_module_name
44214424
| Js_new {external_module_name ; txt = name}
44224425
| Js_call {external_module_name ; txt = {name ; _}}
@@ -4579,7 +4582,19 @@ let handle_attributes
45794582
let result_type = aux result_type_ty in
45804583
let ffi =
45814584
match st with
4582-
| {mk_obj = true} ->
4585+
| {mk_obj = true;
4586+
4587+
val_name = None;
4588+
external_module_name = None ;
4589+
module_as_val = None;
4590+
val_send = None;
4591+
splice = false;
4592+
new_name = None;
4593+
call_name = None;
4594+
set_name = None ;
4595+
get_name = None ;
4596+
get_index = false ;
4597+
} ->
45834598
let labels = List.map (function
45844599
| {arg_type = Unit ; arg_label = (Empty as l)}
45854600
-> l
@@ -4592,7 +4607,24 @@ let handle_attributes
45924607
if String.length prim_name <> 0 then
45934608
Location.raise_errorf ~loc "[@@bs.obj] expect external names to be empty string";
45944609
Obj_create labels(* Need fetch label here, for better error message *)
4595-
| {set_index = true}
4610+
| {mk_obj = true; _}
4611+
->
4612+
Location.raise_errorf ~loc "conflict attributes found"
4613+
| {set_index = true;
4614+
4615+
val_name = None;
4616+
external_module_name = None ;
4617+
module_as_val = None;
4618+
val_send = None;
4619+
splice = false;
4620+
get_index = false;
4621+
new_name = None;
4622+
call_name = None;
4623+
set_name = None ;
4624+
get_name = None ;
4625+
mk_obj = false ;
4626+
4627+
}
45964628
->
45974629
if String.length prim_name <> 0 then
45984630
Location.raise_errorf ~loc "[@@bs.set_index] expect external names to be empty string";
@@ -4602,19 +4634,63 @@ let handle_attributes
46024634
Js_set_index
46034635
| _ -> Location.raise_errorf ~loc "Ill defined attribute [@@bs.set_index](arity of 3)"
46044636
end
4605-
| {get_index = true} ->
4637+
| {set_index = true; _}
4638+
->
4639+
Location.raise_errorf ~loc "conflict attributes found"
4640+
4641+
| {get_index = true;
4642+
4643+
val_name = None;
4644+
external_module_name = None ;
4645+
module_as_val = None;
4646+
val_send = None;
4647+
splice = false;
4648+
new_name = None;
4649+
call_name = None;
4650+
set_name = None ;
4651+
get_name = None ;
4652+
mk_obj = false ;
4653+
} ->
46064654
if String.length prim_name <> 0 then
46074655
Location.raise_errorf ~loc "[@@bs.get_index] expect external names to be empty string";
46084656
begin match arg_types with
46094657
| [_obj; _v ] ->
46104658
Js_get_index
46114659
| _ -> Location.raise_errorf ~loc "Ill defined attribute [@@bs.get_index] (arity of 2)"
46124660
end
4613-
| {module_as_val = Some v } ->
4614-
begin match arg_types_ty with
4615-
| [] -> Js_module_as_var v
4616-
| _ -> Js_module_as_fn v
4617-
end
4661+
| {get_index = true; _}
4662+
-> Location.raise_errorf ~loc "conflict attributes found"
4663+
| {module_as_val = Some v ;
4664+
4665+
get_index = false;
4666+
val_name ;
4667+
new_name ;
4668+
(*TODO: a better way to avoid breaking existing code,
4669+
we need tell the difference from
4670+
{[
4671+
1. [@@bs.val "x"]
4672+
2. external x : .. "x" [@@bs.val ]
4673+
3. external x : .. "" [@@bs.val]
4674+
]}
4675+
*)
4676+
external_module_name = None ;
4677+
val_send = None;
4678+
splice = false;
4679+
call_name = None;
4680+
set_name = None ;
4681+
get_name = None ;
4682+
mk_obj = false ;
4683+
} ->
4684+
begin match arg_types_ty, new_name, val_name with
4685+
| [], None, _ -> Js_module_as_var v
4686+
| _, None, _ -> Js_module_as_fn v
4687+
| _, Some _, Some _ ->
4688+
Location.raise_errorf ~loc "conflict attributes found"
4689+
| _, Some n, None
4690+
-> Js_module_as_class v
4691+
end
4692+
| {module_as_val = Some _}
4693+
-> Location.raise_errorf ~loc "conflict attributes found"
46184694
| {call_name = Some name ;
46194695
splice;
46204696
external_module_name;

‎jscomp/bin/compiler.ml

Lines changed: 117 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
(** Bundled by bspack 08/22-17:28 *)
1+
(** Bundled by bspack 08/23-11:37 *)
22
module String_map : sig
33
#1 "string_map.mli"
44
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -4034,7 +4034,7 @@ let int32 = "Caml_int32"
40344034
let block = "Block"
40354035
let js_primitive = "Js_primitive"
40364036
let module_ = "Caml_module"
4037-
let version = "0.9.4"
4037+
let version = "0.9.5"
40384038

40394039

40404040
let runtime_set =
@@ -4240,7 +4240,8 @@ type ffi =
42404240
| Obj_create of arg_label list
42414241
| Js_global of js_val
42424242
| Js_module_as_var of external_module_name
4243-
| Js_module_as_fn of external_module_name
4243+
| Js_module_as_fn of external_module_name
4244+
| Js_module_as_class of external_module_name
42444245
| Js_call of js_call external_module
42454246
| Js_send of js_send
42464247
| Js_new of js_val
@@ -4340,7 +4341,8 @@ type ffi =
43404341
| Obj_create of arg_label list
43414342
| Js_global of js_val
43424343
| Js_module_as_var of external_module_name
4343-
| Js_module_as_fn of external_module_name
4344+
| Js_module_as_fn of external_module_name
4345+
| Js_module_as_class of external_module_name
43444346
| Js_call of js_call external_module
43454347
| Js_send of js_send
43464348
| Js_new of js_val
@@ -4416,7 +4418,8 @@ let check_ffi ?loc ffi =
44164418
-> ()
44174419

44184420
| Js_module_as_var external_module_name
4419-
| Js_module_as_fn external_module_name
4421+
| Js_module_as_fn external_module_name
4422+
| Js_module_as_class external_module_name
44204423
-> check_external_module_name external_module_name
44214424
| Js_new {external_module_name ; txt = name}
44224425
| Js_call {external_module_name ; txt = {name ; _}}
@@ -4579,7 +4582,19 @@ let handle_attributes
45794582
let result_type = aux result_type_ty in
45804583
let ffi =
45814584
match st with
4582-
| {mk_obj = true} ->
4585+
| {mk_obj = true;
4586+
4587+
val_name = None;
4588+
external_module_name = None ;
4589+
module_as_val = None;
4590+
val_send = None;
4591+
splice = false;
4592+
new_name = None;
4593+
call_name = None;
4594+
set_name = None ;
4595+
get_name = None ;
4596+
get_index = false ;
4597+
} ->
45834598
let labels = List.map (function
45844599
| {arg_type = Unit ; arg_label = (Empty as l)}
45854600
-> l
@@ -4592,7 +4607,24 @@ let handle_attributes
45924607
if String.length prim_name <> 0 then
45934608
Location.raise_errorf ~loc "[@@bs.obj] expect external names to be empty string";
45944609
Obj_create labels(* Need fetch label here, for better error message *)
4595-
| {set_index = true}
4610+
| {mk_obj = true; _}
4611+
->
4612+
Location.raise_errorf ~loc "conflict attributes found"
4613+
| {set_index = true;
4614+
4615+
val_name = None;
4616+
external_module_name = None ;
4617+
module_as_val = None;
4618+
val_send = None;
4619+
splice = false;
4620+
get_index = false;
4621+
new_name = None;
4622+
call_name = None;
4623+
set_name = None ;
4624+
get_name = None ;
4625+
mk_obj = false ;
4626+
4627+
}
45964628
->
45974629
if String.length prim_name <> 0 then
45984630
Location.raise_errorf ~loc "[@@bs.set_index] expect external names to be empty string";
@@ -4602,19 +4634,63 @@ let handle_attributes
46024634
Js_set_index
46034635
| _ -> Location.raise_errorf ~loc "Ill defined attribute [@@bs.set_index](arity of 3)"
46044636
end
4605-
| {get_index = true} ->
4637+
| {set_index = true; _}
4638+
->
4639+
Location.raise_errorf ~loc "conflict attributes found"
4640+
4641+
| {get_index = true;
4642+
4643+
val_name = None;
4644+
external_module_name = None ;
4645+
module_as_val = None;
4646+
val_send = None;
4647+
splice = false;
4648+
new_name = None;
4649+
call_name = None;
4650+
set_name = None ;
4651+
get_name = None ;
4652+
mk_obj = false ;
4653+
} ->
46064654
if String.length prim_name <> 0 then
46074655
Location.raise_errorf ~loc "[@@bs.get_index] expect external names to be empty string";
46084656
begin match arg_types with
46094657
| [_obj; _v ] ->
46104658
Js_get_index
46114659
| _ -> Location.raise_errorf ~loc "Ill defined attribute [@@bs.get_index] (arity of 2)"
46124660
end
4613-
| {module_as_val = Some v } ->
4614-
begin match arg_types_ty with
4615-
| [] -> Js_module_as_var v
4616-
| _ -> Js_module_as_fn v
4617-
end
4661+
| {get_index = true; _}
4662+
-> Location.raise_errorf ~loc "conflict attributes found"
4663+
| {module_as_val = Some v ;
4664+
4665+
get_index = false;
4666+
val_name ;
4667+
new_name ;
4668+
(*TODO: a better way to avoid breaking existing code,
4669+
we need tell the difference from
4670+
{[
4671+
1. [@@bs.val "x"]
4672+
2. external x : .. "x" [@@bs.val ]
4673+
3. external x : .. "" [@@bs.val]
4674+
]}
4675+
*)
4676+
external_module_name = None ;
4677+
val_send = None;
4678+
splice = false;
4679+
call_name = None;
4680+
set_name = None ;
4681+
get_name = None ;
4682+
mk_obj = false ;
4683+
} ->
4684+
begin match arg_types_ty, new_name, val_name with
4685+
| [], None, _ -> Js_module_as_var v
4686+
| _, None, _ -> Js_module_as_fn v
4687+
| _, Some _, Some _ ->
4688+
Location.raise_errorf ~loc "conflict attributes found"
4689+
| _, Some n, None
4690+
-> Js_module_as_class v
4691+
end
4692+
| {module_as_val = Some _}
4693+
-> Location.raise_errorf ~loc "conflict attributes found"
46184694
| {call_name = Some name ;
46194695
splice;
46204696
external_module_name;
@@ -25782,6 +25858,25 @@ let translate_ffi (ffi : Ast_external_attributes.ffi ) prim_name
2578225858
| _ ->
2578325859
E.call ~info:{arity=Full; call_info = Call_na} fn args
2578425860
end
25861+
| Js_module_as_class module_name ->
25862+
let fn =
25863+
match handle_external (Some module_name) with
25864+
| Some (id,name) ->
25865+
E.external_var_dot id name None
25866+
| None -> assert false in
25867+
let args =
25868+
Ext_list.flat_map2_last (ocaml_to_js false) arg_types args
25869+
(* TODO: fix in rest calling convention *)
25870+
in
25871+
begin
25872+
(match cxt.st with
25873+
| Declare (_, id) | Assign id ->
25874+
(* Format.fprintf Format.err_formatter "%a@."Ident.print id; *)
25875+
Ext_ident.make_js_object id
25876+
| EffectCall | NeedValue -> ())
25877+
;
25878+
E.new_ fn args
25879+
end
2578525880

2578625881
| Js_new { external_module_name = module_name;
2578725882
txt = fn;
@@ -25808,14 +25903,15 @@ let translate_ffi (ffi : Ast_external_attributes.ffi ) prim_name
2580825903
TODO: we should propagate this property
2580925904
as much as we can(in alias table)
2581025905
*)
25811-
(
25812-
match cxt.st with
25813-
| Declare (_, id) | Assign id ->
25814-
(* Format.fprintf Format.err_formatter "%a@."Ident.print id; *)
25815-
Ext_ident.make_js_object id
25816-
| EffectCall | NeedValue -> ()
25817-
);
25818-
E.new_ fn args
25906+
begin
25907+
(match cxt.st with
25908+
| Declare (_, id) | Assign id ->
25909+
(* Format.fprintf Format.err_formatter "%a@."Ident.print id; *)
25910+
Ext_ident.make_js_object id
25911+
| EffectCall | NeedValue -> ())
25912+
;
25913+
E.new_ fn args
25914+
end
2581925915

2582025916

2582125917

‎jscomp/common/js_config.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -248,7 +248,7 @@ let int32 = "Caml_int32"
248248
let block = "Block"
249249
let js_primitive = "Js_primitive"
250250
let module_ = "Caml_module"
251-
let version = "0.9.4"
251+
let version = "0.9.5"
252252

253253

254254
let runtime_set =

0 commit comments

Comments
 (0)