Skip to content

Commit 1bf1e18

Browse files
authored
Merge pull request #796 from bloomberg/enhance_splice_support
add splice support for bs.send, bs.send.pipe, errof if the last argument is not string
2 parents cbfa07e + 8050e9f commit 1bf1e18

File tree

8 files changed

+115
-93
lines changed

8 files changed

+115
-93
lines changed

jscomp/bin/bsppx.ml

Lines changed: 19 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -3935,15 +3935,11 @@ type external_module_name =
39353935
{ bundle : string ;
39363936
bind_name : string option
39373937
}
3938-
type 'a external_module = {
3939-
txt : 'a ;
3940-
external_module_name : external_module_name option;
3941-
}
3942-
39433938

39443939
type js_call = {
39453940
splice : bool ;
39463941
name : string;
3942+
external_module_name : external_module_name option;
39473943
}
39483944
type pipe = bool
39493945
type js_send = {
@@ -3982,7 +3978,7 @@ type ffi =
39823978
| Js_module_as_var of external_module_name
39833979
| Js_module_as_fn of js_module_as_fn
39843980
| Js_module_as_class of external_module_name
3985-
| Js_call of js_call external_module
3981+
| Js_call of js_call
39863982
| Js_send of js_send
39873983
| Js_new of js_new_val
39883984
| Js_set of string
@@ -4054,15 +4050,12 @@ type external_module_name =
40544050
{ bundle : string ;
40554051
bind_name : string option
40564052
}
4057-
type 'a external_module = {
4058-
txt : 'a ;
4059-
external_module_name : external_module_name option;
4060-
}
40614053

40624054
type pipe = bool
40634055
type js_call = {
40644056
splice : bool ;
40654057
name : string;
4058+
external_module_name : external_module_name option;
40664059
}
40674060

40684061
type js_send = {
@@ -4103,7 +4096,7 @@ type ffi =
41034096
| Js_module_as_var of external_module_name
41044097
| Js_module_as_fn of js_module_as_fn
41054098
| Js_module_as_class of external_module_name
4106-
| Js_call of js_call external_module
4099+
| Js_call of js_call
41074100
| Js_send of js_send
41084101
| Js_new of js_new_val
41094102
| Js_set of string
@@ -4272,7 +4265,7 @@ let check_ffi ?loc ffi =
42724265
| Js_module_as_class external_module_name
42734266
-> check_external_module_name external_module_name
42744267
| Js_new {external_module_name ; txt = name}
4275-
| Js_call {external_module_name ; txt = {name ; _}}
4268+
| Js_call {external_module_name ; name ; _}
42764269
->
42774270
check_external_module_name_opt ?loc external_module_name ;
42784271
valid_global_name ?loc name
@@ -4449,15 +4442,21 @@ let handle_attributes
44494442
process_external_attributes
44504443
(arg_types_ty = [])
44514444
prim_name_or_pval_prim pval_prim prim_attributes in
4445+
4446+
let splice = st.splice in
44524447
let arg_type_specs, new_arg_types_ty, arg_type_specs_length =
44534448
List.fold_right
44544449
(fun (label,ty,attr,loc) (arg_type_specs, arg_types, i) ->
44554450
let spec, new_ty = get_arg_type ty in
4456-
({ arg_label = Ast_core_type.label_name label ;
4457-
arg_type = spec
4458-
} :: arg_type_specs,
4459-
(label, new_ty,attr,loc) :: arg_types,
4460-
i + 1)
4451+
(if i = 0 && splice then
4452+
match spec with
4453+
| Array -> ()
4454+
| _ -> Location.raise_errorf ~loc "[@@bs.splice] expect last type to array");
4455+
({ arg_label = Ast_core_type.label_name label ;
4456+
arg_type = spec
4457+
} :: arg_type_specs,
4458+
(label, new_ty,attr,loc) :: arg_types,
4459+
i + 1)
44614460
) arg_types_ty
44624461
(match st with
44634462
| {val_send_pipe = Some obj} ->
@@ -4609,7 +4608,7 @@ let handle_attributes
46094608
set_name = `Nm_na ;
46104609
get_name = `Nm_na
46114610
} ->
4612-
Js_call {txt = {splice; name}; external_module_name}
4611+
Js_call {splice; name; external_module_name}
46134612
| {call_name = #bundle_source }
46144613
-> Location.raise_errorf ~loc "conflict attributes found"
46154614

@@ -4650,7 +4649,7 @@ let handle_attributes
46504649
let name = string_of_bundle_source prim_name_or_pval_prim in
46514650
if arg_type_specs_length = 0 then
46524651
Js_global {txt = name; external_module_name}
4653-
else Js_call {txt = {splice; name}; external_module_name}
4652+
else Js_call {splice; name; external_module_name}
46544653
| {val_send = (`Nm_val name | `Nm_external name | `Nm_payload name);
46554654
splice;
46564655
val_send_pipe = None;
@@ -4672,7 +4671,7 @@ let handle_attributes
46724671
-> Location.raise_errorf ~loc "conflict attributes found"
46734672

46744673
| {val_send_pipe = Some typ;
4675-
splice = (false as splice);
4674+
(* splice = (false as splice); *)
46764675
val_send = `Nm_na;
46774676
val_name = `Nm_na ;
46784677
call_name = `Nm_na ;

jscomp/bin/compiler.ml

Lines changed: 23 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -4127,15 +4127,11 @@ type external_module_name =
41274127
{ bundle : string ;
41284128
bind_name : string option
41294129
}
4130-
type 'a external_module = {
4131-
txt : 'a ;
4132-
external_module_name : external_module_name option;
4133-
}
4134-
41354130

41364131
type js_call = {
41374132
splice : bool ;
41384133
name : string;
4134+
external_module_name : external_module_name option;
41394135
}
41404136
type pipe = bool
41414137
type js_send = {
@@ -4174,7 +4170,7 @@ type ffi =
41744170
| Js_module_as_var of external_module_name
41754171
| Js_module_as_fn of js_module_as_fn
41764172
| Js_module_as_class of external_module_name
4177-
| Js_call of js_call external_module
4173+
| Js_call of js_call
41784174
| Js_send of js_send
41794175
| Js_new of js_new_val
41804176
| Js_set of string
@@ -4246,15 +4242,12 @@ type external_module_name =
42464242
{ bundle : string ;
42474243
bind_name : string option
42484244
}
4249-
type 'a external_module = {
4250-
txt : 'a ;
4251-
external_module_name : external_module_name option;
4252-
}
42534245

42544246
type pipe = bool
42554247
type js_call = {
42564248
splice : bool ;
42574249
name : string;
4250+
external_module_name : external_module_name option;
42584251
}
42594252

42604253
type js_send = {
@@ -4295,7 +4288,7 @@ type ffi =
42954288
| Js_module_as_var of external_module_name
42964289
| Js_module_as_fn of js_module_as_fn
42974290
| Js_module_as_class of external_module_name
4298-
| Js_call of js_call external_module
4291+
| Js_call of js_call
42994292
| Js_send of js_send
43004293
| Js_new of js_new_val
43014294
| Js_set of string
@@ -4464,7 +4457,7 @@ let check_ffi ?loc ffi =
44644457
| Js_module_as_class external_module_name
44654458
-> check_external_module_name external_module_name
44664459
| Js_new {external_module_name ; txt = name}
4467-
| Js_call {external_module_name ; txt = {name ; _}}
4460+
| Js_call {external_module_name ; name ; _}
44684461
->
44694462
check_external_module_name_opt ?loc external_module_name ;
44704463
valid_global_name ?loc name
@@ -4641,15 +4634,21 @@ let handle_attributes
46414634
process_external_attributes
46424635
(arg_types_ty = [])
46434636
prim_name_or_pval_prim pval_prim prim_attributes in
4637+
4638+
let splice = st.splice in
46444639
let arg_type_specs, new_arg_types_ty, arg_type_specs_length =
46454640
List.fold_right
46464641
(fun (label,ty,attr,loc) (arg_type_specs, arg_types, i) ->
46474642
let spec, new_ty = get_arg_type ty in
4648-
({ arg_label = Ast_core_type.label_name label ;
4649-
arg_type = spec
4650-
} :: arg_type_specs,
4651-
(label, new_ty,attr,loc) :: arg_types,
4652-
i + 1)
4643+
(if i = 0 && splice then
4644+
match spec with
4645+
| Array -> ()
4646+
| _ -> Location.raise_errorf ~loc "[@@bs.splice] expect last type to array");
4647+
({ arg_label = Ast_core_type.label_name label ;
4648+
arg_type = spec
4649+
} :: arg_type_specs,
4650+
(label, new_ty,attr,loc) :: arg_types,
4651+
i + 1)
46534652
) arg_types_ty
46544653
(match st with
46554654
| {val_send_pipe = Some obj} ->
@@ -4801,7 +4800,7 @@ let handle_attributes
48014800
set_name = `Nm_na ;
48024801
get_name = `Nm_na
48034802
} ->
4804-
Js_call {txt = {splice; name}; external_module_name}
4803+
Js_call {splice; name; external_module_name}
48054804
| {call_name = #bundle_source }
48064805
-> Location.raise_errorf ~loc "conflict attributes found"
48074806

@@ -4842,7 +4841,7 @@ let handle_attributes
48424841
let name = string_of_bundle_source prim_name_or_pval_prim in
48434842
if arg_type_specs_length = 0 then
48444843
Js_global {txt = name; external_module_name}
4845-
else Js_call {txt = {splice; name}; external_module_name}
4844+
else Js_call {splice; name; external_module_name}
48464845
| {val_send = (`Nm_val name | `Nm_external name | `Nm_payload name);
48474846
splice;
48484847
val_send_pipe = None;
@@ -4864,7 +4863,7 @@ let handle_attributes
48644863
-> Location.raise_errorf ~loc "conflict attributes found"
48654864

48664865
| {val_send_pipe = Some typ;
4867-
splice = (false as splice);
4866+
(* splice = (false as splice); *)
48684867
val_send = `Nm_na;
48694868
val_name = `Nm_na ;
48704869
call_name = `Nm_na ;
@@ -26994,9 +26993,9 @@ let translate_ffi (ffi : Ast_external_attributes.ffi ) prim_name
2699426993
match ffi with
2699526994
| Obj_create labels -> assemble_args_obj labels args
2699626995
| Js_call{ external_module_name = module_name;
26997-
txt = { name = fn; splice = js_splice ;
26996+
name = fn; splice = js_splice ;
2699826997

26999-
}} ->
26998+
} ->
2700026999
let fn =
2700127000
match handle_external_opt module_name with
2700227001
| Some (id,_) ->
@@ -27114,10 +27113,10 @@ let translate_ffi (ffi : Ast_external_attributes.ffi ) prim_name
2711427113
end
2711527114
| Js_send { name ; pipe = true ; splice = js_splice}
2711627115
-> (* splice should not happen *)
27117-
assert (js_splice = false) ;
27116+
(* assert (js_splice = false) ; *)
2711827117
let self, args = Ext_list.exclude_tail args in
2711927118
let self_type, arg_types = Ext_list.exclude_tail arg_types in
27120-
let args, eff = assemble_args arg_types args in
27119+
let args, eff = assemble_args_splice js_splice arg_types args in
2712127120
add_eff eff @@
2712227121
E.call ~info:{arity=Full; call_info = Call_na} (E.dot self name) args
2712327122

jscomp/bin/whole_compiler.ml

Lines changed: 23 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -72686,15 +72686,11 @@ type external_module_name =
7268672686
{ bundle : string ;
7268772687
bind_name : string option
7268872688
}
72689-
type 'a external_module = {
72690-
txt : 'a ;
72691-
external_module_name : external_module_name option;
72692-
}
72693-
7269472689

7269572690
type js_call = {
7269672691
splice : bool ;
7269772692
name : string;
72693+
external_module_name : external_module_name option;
7269872694
}
7269972695
type pipe = bool
7270072696
type js_send = {
@@ -72733,7 +72729,7 @@ type ffi =
7273372729
| Js_module_as_var of external_module_name
7273472730
| Js_module_as_fn of js_module_as_fn
7273572731
| Js_module_as_class of external_module_name
72736-
| Js_call of js_call external_module
72732+
| Js_call of js_call
7273772733
| Js_send of js_send
7273872734
| Js_new of js_new_val
7273972735
| Js_set of string
@@ -72805,15 +72801,12 @@ type external_module_name =
7280572801
{ bundle : string ;
7280672802
bind_name : string option
7280772803
}
72808-
type 'a external_module = {
72809-
txt : 'a ;
72810-
external_module_name : external_module_name option;
72811-
}
7281272804

7281372805
type pipe = bool
7281472806
type js_call = {
7281572807
splice : bool ;
7281672808
name : string;
72809+
external_module_name : external_module_name option;
7281772810
}
7281872811

7281972812
type js_send = {
@@ -72854,7 +72847,7 @@ type ffi =
7285472847
| Js_module_as_var of external_module_name
7285572848
| Js_module_as_fn of js_module_as_fn
7285672849
| Js_module_as_class of external_module_name
72857-
| Js_call of js_call external_module
72850+
| Js_call of js_call
7285872851
| Js_send of js_send
7285972852
| Js_new of js_new_val
7286072853
| Js_set of string
@@ -73023,7 +73016,7 @@ let check_ffi ?loc ffi =
7302373016
| Js_module_as_class external_module_name
7302473017
-> check_external_module_name external_module_name
7302573018
| Js_new {external_module_name ; txt = name}
73026-
| Js_call {external_module_name ; txt = {name ; _}}
73019+
| Js_call {external_module_name ; name ; _}
7302773020
->
7302873021
check_external_module_name_opt ?loc external_module_name ;
7302973022
valid_global_name ?loc name
@@ -73200,15 +73193,21 @@ let handle_attributes
7320073193
process_external_attributes
7320173194
(arg_types_ty = [])
7320273195
prim_name_or_pval_prim pval_prim prim_attributes in
73196+
73197+
let splice = st.splice in
7320373198
let arg_type_specs, new_arg_types_ty, arg_type_specs_length =
7320473199
List.fold_right
7320573200
(fun (label,ty,attr,loc) (arg_type_specs, arg_types, i) ->
7320673201
let spec, new_ty = get_arg_type ty in
73207-
({ arg_label = Ast_core_type.label_name label ;
73208-
arg_type = spec
73209-
} :: arg_type_specs,
73210-
(label, new_ty,attr,loc) :: arg_types,
73211-
i + 1)
73202+
(if i = 0 && splice then
73203+
match spec with
73204+
| Array -> ()
73205+
| _ -> Location.raise_errorf ~loc "[@@bs.splice] expect last type to array");
73206+
({ arg_label = Ast_core_type.label_name label ;
73207+
arg_type = spec
73208+
} :: arg_type_specs,
73209+
(label, new_ty,attr,loc) :: arg_types,
73210+
i + 1)
7321273211
) arg_types_ty
7321373212
(match st with
7321473213
| {val_send_pipe = Some obj} ->
@@ -73360,7 +73359,7 @@ let handle_attributes
7336073359
set_name = `Nm_na ;
7336173360
get_name = `Nm_na
7336273361
} ->
73363-
Js_call {txt = {splice; name}; external_module_name}
73362+
Js_call {splice; name; external_module_name}
7336473363
| {call_name = #bundle_source }
7336573364
-> Location.raise_errorf ~loc "conflict attributes found"
7336673365

@@ -73401,7 +73400,7 @@ let handle_attributes
7340173400
let name = string_of_bundle_source prim_name_or_pval_prim in
7340273401
if arg_type_specs_length = 0 then
7340373402
Js_global {txt = name; external_module_name}
73404-
else Js_call {txt = {splice; name}; external_module_name}
73403+
else Js_call {splice; name; external_module_name}
7340573404
| {val_send = (`Nm_val name | `Nm_external name | `Nm_payload name);
7340673405
splice;
7340773406
val_send_pipe = None;
@@ -73423,7 +73422,7 @@ let handle_attributes
7342373422
-> Location.raise_errorf ~loc "conflict attributes found"
7342473423

7342573424
| {val_send_pipe = Some typ;
73426-
splice = (false as splice);
73425+
(* splice = (false as splice); *)
7342773426
val_send = `Nm_na;
7342873427
val_name = `Nm_na ;
7342973428
call_name = `Nm_na ;
@@ -75225,9 +75224,9 @@ let translate_ffi (ffi : Ast_external_attributes.ffi ) prim_name
7522575224
match ffi with
7522675225
| Obj_create labels -> assemble_args_obj labels args
7522775226
| Js_call{ external_module_name = module_name;
75228-
txt = { name = fn; splice = js_splice ;
75227+
name = fn; splice = js_splice ;
7522975228

75230-
}} ->
75229+
} ->
7523175230
let fn =
7523275231
match handle_external_opt module_name with
7523375232
| Some (id,_) ->
@@ -75345,10 +75344,10 @@ let translate_ffi (ffi : Ast_external_attributes.ffi ) prim_name
7534575344
end
7534675345
| Js_send { name ; pipe = true ; splice = js_splice}
7534775346
-> (* splice should not happen *)
75348-
assert (js_splice = false) ;
75347+
(* assert (js_splice = false) ; *)
7534975348
let self, args = Ext_list.exclude_tail args in
7535075349
let self_type, arg_types = Ext_list.exclude_tail arg_types in
75351-
let args, eff = assemble_args arg_types args in
75350+
let args, eff = assemble_args_splice js_splice arg_types args in
7535275351
add_eff eff @@
7535375352
E.call ~info:{arity=Full; call_info = Call_na} (E.dot self name) args
7535475353

0 commit comments

Comments
 (0)