Skip to content

Commit 6c51e38

Browse files
bobzhangbobzhang
committed
make sure when optional obj is None, no such label is set, add more tests
1 parent a0d78d4 commit 6c51e38

9 files changed

+298
-78
lines changed

‎jscomp/all.depend

+3-2
Original file line numberDiff line numberDiff line change
@@ -539,8 +539,9 @@ core/lam_compile_external_call.cmx : core/lam_compile_env.cmx \
539539
ext/ext_ident.cmx syntax/ast_ffi_types.cmx syntax/ast_arg.cmx \
540540
core/lam_compile_external_call.cmi
541541
core/lam_compile_external_obj.cmx : core/lam_compile_external_call.cmx \
542-
core/lam_compile_const.cmx core/js_op.cmx core/js_exp_make.cmx \
543-
core/js_analyzer.cmx core/j.cmx syntax/ast_arg.cmx \
542+
core/lam_compile_const.cmx core/js_stmt_make.cmx core/js_op.cmx \
543+
core/js_exp_make.cmx core/js_ast_util.cmx core/js_analyzer.cmx core/j.cmx \
544+
ext/ext_list.cmx ext/ext_ident.cmx syntax/ast_arg.cmx \
544545
core/lam_compile_external_obj.cmi
545546
core/lam_compile_primitive.cmx : core/lam_util.cmx \
546547
core/lam_dispatch_primitive.cmx core/lam_compile_external_call.cmx \

‎jscomp/bin/whole_compiler.ml

+71-33
Original file line numberDiff line numberDiff line change
@@ -92837,7 +92837,12 @@ module Lam_compile_external_obj : sig
9283792837
val assemble_args_obj :
9283892838
Ast_arg.kind list ->
9283992839
J.expression list ->
92840-
J.expression
92840+
J.block * J.expression
92841+
(* It returns a block in cases we need set the property dynamically: we need
92842+
create a place holder assignment first and then set it accordingly
92843+
*)
92844+
92845+
9284192846

9284292847
end = struct
9284392848
#1 "lam_compile_external_obj.ml"
@@ -92869,7 +92874,7 @@ end = struct
9286992874

9287092875

9287192876
module E = Js_exp_make
92872-
92877+
module S = Js_stmt_make
9287392878

9287492879
(* Note: can potentially be inconsistent, sometimes
9287592880
{[
@@ -92881,57 +92886,90 @@ module E = Js_exp_make
9288192886
]}
9288292887
But the default to be undefined seems reasonable
9288392888
*)
92884-
92885-
let assemble_args_obj (labels : Ast_arg.kind list) (args : J.expression list) =
92886-
let rec aux (labels : Ast_arg.kind list) args
92887-
: (Js_op.property_name * E.t ) list * _ =
92889+
92890+
(* TODO: check stackoverflow *)
92891+
let assemble_args_obj (labels : Ast_arg.kind list) (args : J.expression list)
92892+
: J.block * J.expression =
92893+
let rec aux (labels : Ast_arg.kind list) args
92894+
: (Js_op.property_name * E.t ) list * J.expression list * _ =
9288892895
match labels, args with
92889-
| [] , [] as empty_pair -> empty_pair
92896+
| [] , [] -> [], [], []
9289092897
| {arg_label = Label (label, Some cst )} :: labels , args ->
92891-
let accs, eff = aux labels args in
92892-
(Key label, Lam_compile_const.translate_arg_cst cst )::accs, eff
92898+
let accs, eff, assign = aux labels args in
92899+
(Key label, Lam_compile_const.translate_arg_cst cst )::accs, eff, assign
9289392900
| {arg_label = Empty (Some _) } :: rest , args -> assert false
9289492901
| {arg_label = Empty None }::labels, arg::args
92895-
->
92896-
let (accs, eff) as r = aux labels args in
92902+
-> (* unit type*)
92903+
let (accs, eff, assign) as r = aux labels args in
9289792904
if Js_analyzer.no_side_effect_expression arg then r
92898-
else (accs, arg::eff)
92905+
else (accs, arg::eff, assign)
9289992906
| ({arg_label = Label (label,None) } as arg_kind)::labels, arg::args
9290092907
->
92901-
let accs, eff = aux labels args in
92908+
let accs, eff, assign = aux labels args in
9290292909
let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff arg_kind arg in
9290392910
begin match acc with
9290492911
| [ ] -> assert false
9290592912
| x::xs ->
92906-
(Key label, E.fuse_to_seq x xs ) :: accs , new_eff @ eff
92913+
(Key label, E.fuse_to_seq x xs ) :: accs , new_eff @ eff , assign
9290792914
end (* evaluation order is undefined *)
9290892915

92909-
| ({arg_label = Optional label } as arg_kind)::labels, arg::args
92916+
| ({arg_label = Optional label; arg_type } as arg_kind)::labels, arg::args
9291092917
->
92911-
let (accs, eff) as r = aux labels args in
92918+
let (accs, eff, assign) as r = aux labels args in
9291292919
begin match arg.expression_desc with
9291392920
| Number _ -> (*Invariant: None encoding*)
9291492921
r
92915-
| _ ->
92916-
let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff arg_kind arg in
92922+
| Array ([x],_)
92923+
| Caml_block ([x],_,_,_) ->
92924+
let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff
92925+
({Ast_arg.arg_label = Ast_arg.label label None; arg_type}) x in
9291792926
begin match acc with
92918-
| [] -> assert false
92919-
| x::xs ->
92920-
(Key label, E.fuse_to_seq x xs)::accs ,
92921-
new_eff @ eff
92922-
end
92927+
| [] -> assert false
92928+
| x::xs ->
92929+
(Key label, E.fuse_to_seq x xs ) :: accs , new_eff @ eff , assign
92930+
end
92931+
| _ ->
92932+
accs, eff , (arg_kind,arg)::assign
9292392933
end
92924-
9292592934
| {arg_label = Empty None | Label (_,None) | Optional _ } :: _ , [] -> assert false
9292692935
| [], _ :: _ -> assert false
9292792936
in
92928-
let map, eff = aux labels args in
92929-
92930-
match eff with
92937+
let map, eff, assignment = aux labels args in
92938+
match assignment with
9293192939
| [] ->
92932-
E.obj map
92933-
| x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)
92934-
92940+
[], begin match eff with
92941+
| [] ->
92942+
E.obj map
92943+
| x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)
92944+
end
92945+
| _ ->
92946+
let v = Ext_ident.gen_js () in
92947+
let var_v = E.var v in
92948+
S.define ~kind:Variable v
92949+
(begin match eff with
92950+
| [] ->
92951+
E.obj map
92952+
| x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)
92953+
end) ::
92954+
(Ext_list.flat_map (fun
92955+
((label : Ast_arg.kind), (arg : J.expression )) ->
92956+
match label with
92957+
| {arg_label = Optional label } ->
92958+
(* Need make sure whether assignment is effectful or not
92959+
to avoid code duplication
92960+
*)
92961+
begin match Js_ast_util.named_expression arg with
92962+
| None ->
92963+
[S.if_ arg [S.exp (E.assign (E.dot var_v label) arg) ] ]
92964+
| Some (st,id) ->
92965+
let var_id = E.var id in
92966+
st ::
92967+
[S.if_ var_id [S.exp (E.assign (E.dot var_v label) var_id) ]]
92968+
end
92969+
| _ -> assert false
92970+
)
92971+
assignment)
92972+
, var_v
9293592973

9293692974
end
9293792975
module Js_of_lam_exception : sig
@@ -96640,10 +96678,10 @@ and
9664096678
| _ -> assert false ) args
9664196679
in
9664296680
let args_code = List.concat args_block in
96643-
let exp =
96681+
let block, exp =
9664496682
Lam_compile_external_obj.assemble_args_obj labels args_expr
9664596683
in
96646-
Js_output.handle_block_return st should_return lam args_code exp
96684+
Js_output.handle_block_return st should_return lam (args_code @ block) exp
9664796685

9664896686
| Lprim{primitive = prim; args = args_lambda; loc} ->
9664996687
let args_block, args_expr =
@@ -96654,7 +96692,7 @@ and
9665496692
| _ -> assert false ) args_lambda
9665596693

9665696694
in
96657-
let args_code = List.concat args_block in
96695+
let args_code : J.block = List.concat args_block in
9665896696
let exp = (* TODO: all can be done in [compile_primitive] *)
9665996697
Lam_compile_primitive.translate loc cxt prim args_expr in
9666096698
Js_output.handle_block_return st should_return lam args_code exp

‎jscomp/core/lam_compile.ml

+3-3
Original file line numberDiff line numberDiff line change
@@ -894,10 +894,10 @@ and
894894
| _ -> assert false ) args
895895
in
896896
let args_code = List.concat args_block in
897-
let exp =
897+
let block, exp =
898898
Lam_compile_external_obj.assemble_args_obj labels args_expr
899899
in
900-
Js_output.handle_block_return st should_return lam args_code exp
900+
Js_output.handle_block_return st should_return lam (args_code @ block) exp
901901

902902
| Lprim{primitive = prim; args = args_lambda; loc} ->
903903
let args_block, args_expr =
@@ -908,7 +908,7 @@ and
908908
| _ -> assert false ) args_lambda
909909

910910
in
911-
let args_code = List.concat args_block in
911+
let args_code : J.block = List.concat args_block in
912912
let exp = (* TODO: all can be done in [compile_primitive] *)
913913
Lam_compile_primitive.translate loc cxt prim args_expr in
914914
Js_output.handle_block_return st should_return lam args_code exp

‎jscomp/core/lam_compile_external_obj.ml

+62-29
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@
2626

2727

2828
module E = Js_exp_make
29-
29+
module S = Js_stmt_make
3030

3131
(* Note: can potentially be inconsistent, sometimes
3232
{[
@@ -38,54 +38,87 @@ module E = Js_exp_make
3838
]}
3939
But the default to be undefined seems reasonable
4040
*)
41-
42-
let assemble_args_obj (labels : Ast_arg.kind list) (args : J.expression list) =
43-
let rec aux (labels : Ast_arg.kind list) args
44-
: (Js_op.property_name * E.t ) list * _ =
41+
42+
(* TODO: check stackoverflow *)
43+
let assemble_args_obj (labels : Ast_arg.kind list) (args : J.expression list)
44+
: J.block * J.expression =
45+
let rec aux (labels : Ast_arg.kind list) args
46+
: (Js_op.property_name * E.t ) list * J.expression list * _ =
4547
match labels, args with
46-
| [] , [] as empty_pair -> empty_pair
48+
| [] , [] -> [], [], []
4749
| {arg_label = Label (label, Some cst )} :: labels , args ->
48-
let accs, eff = aux labels args in
49-
(Key label, Lam_compile_const.translate_arg_cst cst )::accs, eff
50+
let accs, eff, assign = aux labels args in
51+
(Key label, Lam_compile_const.translate_arg_cst cst )::accs, eff, assign
5052
| {arg_label = Empty (Some _) } :: rest , args -> assert false
5153
| {arg_label = Empty None }::labels, arg::args
52-
->
53-
let (accs, eff) as r = aux labels args in
54+
-> (* unit type*)
55+
let (accs, eff, assign) as r = aux labels args in
5456
if Js_analyzer.no_side_effect_expression arg then r
55-
else (accs, arg::eff)
57+
else (accs, arg::eff, assign)
5658
| ({arg_label = Label (label,None) } as arg_kind)::labels, arg::args
5759
->
58-
let accs, eff = aux labels args in
60+
let accs, eff, assign = aux labels args in
5961
let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff arg_kind arg in
6062
begin match acc with
6163
| [ ] -> assert false
6264
| x::xs ->
63-
(Key label, E.fuse_to_seq x xs ) :: accs , new_eff @ eff
65+
(Key label, E.fuse_to_seq x xs ) :: accs , new_eff @ eff , assign
6466
end (* evaluation order is undefined *)
6567

66-
| ({arg_label = Optional label } as arg_kind)::labels, arg::args
68+
| ({arg_label = Optional label; arg_type } as arg_kind)::labels, arg::args
6769
->
68-
let (accs, eff) as r = aux labels args in
70+
let (accs, eff, assign) as r = aux labels args in
6971
begin match arg.expression_desc with
7072
| Number _ -> (*Invariant: None encoding*)
7173
r
72-
| _ ->
73-
let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff arg_kind arg in
74+
| Array ([x],_)
75+
| Caml_block ([x],_,_,_) ->
76+
let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff
77+
({Ast_arg.arg_label = Ast_arg.label label None; arg_type}) x in
7478
begin match acc with
75-
| [] -> assert false
76-
| x::xs ->
77-
(Key label, E.fuse_to_seq x xs)::accs ,
78-
new_eff @ eff
79-
end
79+
| [] -> assert false
80+
| x::xs ->
81+
(Key label, E.fuse_to_seq x xs ) :: accs , new_eff @ eff , assign
82+
end
83+
| _ ->
84+
accs, eff , (arg_kind,arg)::assign
8085
end
81-
8286
| {arg_label = Empty None | Label (_,None) | Optional _ } :: _ , [] -> assert false
8387
| [], _ :: _ -> assert false
8488
in
85-
let map, eff = aux labels args in
86-
87-
match eff with
89+
let map, eff, assignment = aux labels args in
90+
match assignment with
8891
| [] ->
89-
E.obj map
90-
| x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)
91-
92+
[], begin match eff with
93+
| [] ->
94+
E.obj map
95+
| x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)
96+
end
97+
| _ ->
98+
let v = Ext_ident.gen_js () in
99+
let var_v = E.var v in
100+
S.define ~kind:Variable v
101+
(begin match eff with
102+
| [] ->
103+
E.obj map
104+
| x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)
105+
end) ::
106+
(Ext_list.flat_map (fun
107+
((label : Ast_arg.kind), (arg : J.expression )) ->
108+
match label with
109+
| {arg_label = Optional label } ->
110+
(* Need make sure whether assignment is effectful or not
111+
to avoid code duplication
112+
*)
113+
begin match Js_ast_util.named_expression arg with
114+
| None ->
115+
[S.if_ arg [S.exp (E.assign (E.dot var_v label) arg) ] ]
116+
| Some (st,id) ->
117+
let var_id = E.var id in
118+
st ::
119+
[S.if_ var_id [S.exp (E.assign (E.dot var_v label) var_id) ]]
120+
end
121+
| _ -> assert false
122+
)
123+
assignment)
124+
, var_v

‎jscomp/core/lam_compile_external_obj.mli

+6-1
Original file line numberDiff line numberDiff line change
@@ -40,4 +40,9 @@
4040
val assemble_args_obj :
4141
Ast_arg.kind list ->
4242
J.expression list ->
43-
J.expression
43+
J.block * J.expression
44+
(* It returns a block in cases we need set the property dynamically: we need
45+
create a place holder assignment first and then set it accordingly
46+
*)
47+
48+

‎jscomp/test/.depend

+2-1
Original file line numberDiff line numberDiff line change
@@ -215,7 +215,8 @@ gpr_1154_test.cmj : mt.cmj ../stdlib/int64.cmj
215215
gpr_1170.cmj :
216216
gpr_1240_missing_unbox.cmj :
217217
gpr_1268.cmj : ../runtime/js.cmj
218-
gpr_1409_test.cmj : mt.cmj ../runtime/js.cmj ../stdlib/array.cmj
218+
gpr_1409_test.cmj : string_set.cmj mt.cmj ../runtime/js.cmj \
219+
../stdlib/array.cmj
219220
gpr_1423_app_test.cmj : mt.cmj ../runtime/js.cmj gpr_1423_nav.cmj
220221
gpr_1423_nav.cmj :
221222
gpr_1438.cmj :

0 commit comments

Comments
 (0)