Skip to content

Commit 2d096b7

Browse files
committed
better compilation of optional (fix rescript-lang#4129)
1 parent a2b123c commit 2d096b7

File tree

5 files changed

+142
-30
lines changed

5 files changed

+142
-30
lines changed

jscomp/core/lam_convert.ml

+30-5
Original file line numberDiff line numberDiff line change
@@ -402,7 +402,24 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
402402

403403
let may_depend = Lam_module_ident.Hash_set.add
404404

405-
405+
let rec rename_optional_parameters map params (body : Lambda.lambda) =
406+
match body with
407+
| Llet(k,value_kind,id, (Lifthenelse(
408+
Lprim(p,[Lvar ({name = "*opt*"} as opt)],p_loc),
409+
Lprim(p1,[Lvar ({name = "*opt*"} as opt2)],x_loc), f)),rest)
410+
when Ident.same opt opt2 && List.mem opt params
411+
->
412+
let map, rest = rename_optional_parameters map params rest in
413+
let new_id = Ident.create (id.name ^ "Opt") in
414+
Map_ident.add map opt new_id,
415+
Lambda.Llet(k,value_kind,id,
416+
(Lifthenelse(
417+
Lprim(p,[Lvar new_id],p_loc),
418+
Lprim(p1,[Lvar new_id],x_loc), f)),rest)
419+
| _ ->
420+
map, body
421+
422+
406423
let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_ident.Hash_set.t =
407424
let alias_tbl = Hash_ident.create 64 in
408425
let exit_map = Hash_int.create 0 in
@@ -436,7 +453,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
436453
and convert_js_primitive (p: Primitive_compat.t) (args : Lambda.lambda list) loc =
437454
let s = p.prim_name in
438455
match () with
439-
| _ when s = "#is_none" ->
456+
| _ when s = "#is_not_none" ->
440457
prim ~primitive:Pis_not_none ~args:(Ext_list.map args convert_aux ) loc
441458
| _ when s = "#val_from_unnest_option"
442459
->
@@ -556,9 +573,17 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
556573
{kind; params; body }
557574
->
558575
assert (kind = Curried);
559-
Lam.function_
560-
~arity:(List.length params) ~params
561-
~body:(convert_aux body)
576+
let new_map,body = rename_optional_parameters Map_ident.empty params body in
577+
if Map_ident.is_empty new_map then
578+
Lam.function_
579+
~arity:(List.length params) ~params
580+
~body:(convert_aux body)
581+
else
582+
let params = Ext_list.map params (fun x -> Map_ident.find_default new_map x x) in
583+
Lam.function_
584+
~arity:(List.length params) ~params
585+
~body:(convert_aux body)
586+
562587
| Llet
563588
(kind,_value_kind, id,e,body) (*FIXME*)
564589
-> convert_let kind id e body

lib/4.06.1/unstable/js_compiler.ml

+37-8
Original file line numberDiff line numberDiff line change
@@ -72827,9 +72827,9 @@ let matcher_constr cstr = match cstr.cstr_arity with
7282772827
| Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
7282872828
| _ -> raise NoMatch
7282972829

72830-
let is_none_bs_primitve : Lambda.primitive =
72830+
let is_not_none_bs_primitve : Lambda.primitive =
7283172831
Pccall
72832-
(Primitive.simple ~name:"#is_none" ~arity:1 ~alloc:false)
72832+
(Primitive.simple ~name:"#is_not_none" ~arity:1 ~alloc:false)
7283372833

7283472834
let val_from_option_bs_primitive : Lambda.primitive =
7283572835
Pccall
@@ -73908,7 +73908,7 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
7390873908
case *)
7390973909
let arg =
7391073910
if !Config.bs_only && Datarepr.constructor_has_optional_shape cstr then
73911-
Lprim(is_none_bs_primitve , [arg], loc)
73911+
Lprim(is_not_none_bs_primitve , [arg], loc)
7391273912
else arg
7391373913
in
7391473914
Lifthenelse(arg, act2, act1)
@@ -74166,6 +74166,10 @@ let rec lower_bind v arg lam = match lam with
7416674166
bind Alias v arg lam
7416774167
else
7416874168
Llet (Alias, k, vv, lv, lower_bind v arg l)
74169+
74170+
| Lvar u when Ident.same u v && Ident.name u = "*sth*" ->
74171+
arg (* eliminate let *sth* = from_option x in *sth* *)
74172+
7416974173
| _ ->
7417074174
bind Alias v arg lam
7417174175

@@ -125730,7 +125734,24 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
125730125734

125731125735
let may_depend = Lam_module_ident.Hash_set.add
125732125736

125733-
125737+
let rec rename_optional_parameters map params (body : Lambda.lambda) =
125738+
match body with
125739+
| Llet(k,value_kind,id, (Lifthenelse(
125740+
Lprim(p,[Lvar ({name = "*opt*"} as opt)],p_loc),
125741+
Lprim(p1,[Lvar ({name = "*opt*"} as opt2)],x_loc), f)),rest)
125742+
when Ident.same opt opt2 && List.mem opt params
125743+
->
125744+
let map, rest = rename_optional_parameters map params rest in
125745+
let new_id = Ident.create (id.name ^ "Opt") in
125746+
Map_ident.add map opt new_id,
125747+
Lambda.Llet(k,value_kind,id,
125748+
(Lifthenelse(
125749+
Lprim(p,[Lvar new_id],p_loc),
125750+
Lprim(p1,[Lvar new_id],x_loc), f)),rest)
125751+
| _ ->
125752+
map, body
125753+
125754+
125734125755
let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_ident.Hash_set.t =
125735125756
let alias_tbl = Hash_ident.create 64 in
125736125757
let exit_map = Hash_int.create 0 in
@@ -125764,7 +125785,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
125764125785
and convert_js_primitive (p: Primitive_compat.t) (args : Lambda.lambda list) loc =
125765125786
let s = p.prim_name in
125766125787
match () with
125767-
| _ when s = "#is_none" ->
125788+
| _ when s = "#is_not_none" ->
125768125789
prim ~primitive:Pis_not_none ~args:(Ext_list.map args convert_aux ) loc
125769125790
| _ when s = "#val_from_unnest_option"
125770125791
->
@@ -125884,9 +125905,17 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
125884125905
{kind; params; body }
125885125906
->
125886125907
assert (kind = Curried);
125887-
Lam.function_
125888-
~arity:(List.length params) ~params
125889-
~body:(convert_aux body)
125908+
let new_map,body = rename_optional_parameters Map_ident.empty params body in
125909+
if Map_ident.is_empty new_map then
125910+
Lam.function_
125911+
~arity:(List.length params) ~params
125912+
~body:(convert_aux body)
125913+
else
125914+
let params = Ext_list.map params (fun x -> Map_ident.find_default new_map x x) in
125915+
Lam.function_
125916+
~arity:(List.length params) ~params
125917+
~body:(convert_aux body)
125918+
125890125919
| Llet
125891125920
(kind,_value_kind, id,e,body) (*FIXME*)
125892125921
-> convert_let kind id e body

lib/4.06.1/unstable/js_refmt_compiler.ml

+37-8
Original file line numberDiff line numberDiff line change
@@ -351933,9 +351933,9 @@ let matcher_constr cstr = match cstr.cstr_arity with
351933351933
| Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
351934351934
| _ -> raise NoMatch
351935351935

351936-
let is_none_bs_primitve : Lambda.primitive =
351936+
let is_not_none_bs_primitve : Lambda.primitive =
351937351937
Pccall
351938-
(Primitive.simple ~name:"#is_none" ~arity:1 ~alloc:false)
351938+
(Primitive.simple ~name:"#is_not_none" ~arity:1 ~alloc:false)
351939351939

351940351940
let val_from_option_bs_primitive : Lambda.primitive =
351941351941
Pccall
@@ -353014,7 +353014,7 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
353014353014
case *)
353015353015
let arg =
353016353016
if !Config.bs_only && Datarepr.constructor_has_optional_shape cstr then
353017-
Lprim(is_none_bs_primitve , [arg], loc)
353017+
Lprim(is_not_none_bs_primitve , [arg], loc)
353018353018
else arg
353019353019
in
353020353020
Lifthenelse(arg, act2, act1)
@@ -353272,6 +353272,10 @@ let rec lower_bind v arg lam = match lam with
353272353272
bind Alias v arg lam
353273353273
else
353274353274
Llet (Alias, k, vv, lv, lower_bind v arg l)
353275+
353276+
| Lvar u when Ident.same u v && Ident.name u = "*sth*" ->
353277+
arg (* eliminate let *sth* = from_option x in *sth* *)
353278+
353275353279
| _ ->
353276353280
bind Alias v arg lam
353277353281

@@ -404836,7 +404840,24 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
404836404840

404837404841
let may_depend = Lam_module_ident.Hash_set.add
404838404842

404839-
404843+
let rec rename_optional_parameters map params (body : Lambda.lambda) =
404844+
match body with
404845+
| Llet(k,value_kind,id, (Lifthenelse(
404846+
Lprim(p,[Lvar ({name = "*opt*"} as opt)],p_loc),
404847+
Lprim(p1,[Lvar ({name = "*opt*"} as opt2)],x_loc), f)),rest)
404848+
when Ident.same opt opt2 && List.mem opt params
404849+
->
404850+
let map, rest = rename_optional_parameters map params rest in
404851+
let new_id = Ident.create (id.name ^ "Opt") in
404852+
Map_ident.add map opt new_id,
404853+
Lambda.Llet(k,value_kind,id,
404854+
(Lifthenelse(
404855+
Lprim(p,[Lvar new_id],p_loc),
404856+
Lprim(p1,[Lvar new_id],x_loc), f)),rest)
404857+
| _ ->
404858+
map, body
404859+
404860+
404840404861
let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_ident.Hash_set.t =
404841404862
let alias_tbl = Hash_ident.create 64 in
404842404863
let exit_map = Hash_int.create 0 in
@@ -404870,7 +404891,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
404870404891
and convert_js_primitive (p: Primitive_compat.t) (args : Lambda.lambda list) loc =
404871404892
let s = p.prim_name in
404872404893
match () with
404873-
| _ when s = "#is_none" ->
404894+
| _ when s = "#is_not_none" ->
404874404895
prim ~primitive:Pis_not_none ~args:(Ext_list.map args convert_aux ) loc
404875404896
| _ when s = "#val_from_unnest_option"
404876404897
->
@@ -404990,9 +405011,17 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
404990405011
{kind; params; body }
404991405012
->
404992405013
assert (kind = Curried);
404993-
Lam.function_
404994-
~arity:(List.length params) ~params
404995-
~body:(convert_aux body)
405014+
let new_map,body = rename_optional_parameters Map_ident.empty params body in
405015+
if Map_ident.is_empty new_map then
405016+
Lam.function_
405017+
~arity:(List.length params) ~params
405018+
~body:(convert_aux body)
405019+
else
405020+
let params = Ext_list.map params (fun x -> Map_ident.find_default new_map x x) in
405021+
Lam.function_
405022+
~arity:(List.length params) ~params
405023+
~body:(convert_aux body)
405024+
404996405025
| Llet
404997405026
(kind,_value_kind, id,e,body) (*FIXME*)
404998405027
-> convert_let kind id e body

lib/4.06.1/whole_compiler.ml

+37-8
Original file line numberDiff line numberDiff line change
@@ -57428,9 +57428,9 @@ let matcher_constr cstr = match cstr.cstr_arity with
5742857428
| Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
5742957429
| _ -> raise NoMatch
5743057430

57431-
let is_none_bs_primitve : Lambda.primitive =
57431+
let is_not_none_bs_primitve : Lambda.primitive =
5743257432
Pccall
57433-
(Primitive.simple ~name:"#is_none" ~arity:1 ~alloc:false)
57433+
(Primitive.simple ~name:"#is_not_none" ~arity:1 ~alloc:false)
5743457434

5743557435
let val_from_option_bs_primitive : Lambda.primitive =
5743657436
Pccall
@@ -58509,7 +58509,7 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
5850958509
case *)
5851058510
let arg =
5851158511
if true && Datarepr.constructor_has_optional_shape cstr then
58512-
Lprim(is_none_bs_primitve , [arg], loc)
58512+
Lprim(is_not_none_bs_primitve , [arg], loc)
5851358513
else arg
5851458514
in
5851558515
Lifthenelse(arg, act2, act1)
@@ -58767,6 +58767,10 @@ let rec lower_bind v arg lam = match lam with
5876758767
bind Alias v arg lam
5876858768
else
5876958769
Llet (Alias, k, vv, lv, lower_bind v arg l)
58770+
58771+
| Lvar u when Ident.same u v && Ident.name u = "*sth*" ->
58772+
arg (* eliminate let *sth* = from_option x in *sth* *)
58773+
5877058774
| _ ->
5877158775
bind Alias v arg lam
5877258776

@@ -403372,7 +403376,24 @@ let lam_prim ~primitive:( p : Lambda.primitive) ~args loc : Lam.t =
403372403376

403373403377
let may_depend = Lam_module_ident.Hash_set.add
403374403378

403375-
403379+
let rec rename_optional_parameters map params (body : Lambda.lambda) =
403380+
match body with
403381+
| Llet(k,value_kind,id, (Lifthenelse(
403382+
Lprim(p,[Lvar ({name = "*opt*"} as opt)],p_loc),
403383+
Lprim(p1,[Lvar ({name = "*opt*"} as opt2)],x_loc), f)),rest)
403384+
when Ident.same opt opt2 && List.mem opt params
403385+
->
403386+
let map, rest = rename_optional_parameters map params rest in
403387+
let new_id = Ident.create (id.name ^ "Opt") in
403388+
Map_ident.add map opt new_id,
403389+
Lambda.Llet(k,value_kind,id,
403390+
(Lifthenelse(
403391+
Lprim(p,[Lvar new_id],p_loc),
403392+
Lprim(p1,[Lvar new_id],x_loc), f)),rest)
403393+
| _ ->
403394+
map, body
403395+
403396+
403376403397
let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_ident.Hash_set.t =
403377403398
let alias_tbl = Hash_ident.create 64 in
403378403399
let exit_map = Hash_int.create 0 in
@@ -403406,7 +403427,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
403406403427
and convert_js_primitive (p: Primitive_compat.t) (args : Lambda.lambda list) loc =
403407403428
let s = p.prim_name in
403408403429
match () with
403409-
| _ when s = "#is_none" ->
403430+
| _ when s = "#is_not_none" ->
403410403431
prim ~primitive:Pis_not_none ~args:(Ext_list.map args convert_aux ) loc
403411403432
| _ when s = "#val_from_unnest_option"
403412403433
->
@@ -403526,9 +403547,17 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : Lam.t * Lam_module_i
403526403547
{kind; params; body }
403527403548
->
403528403549
assert (kind = Curried);
403529-
Lam.function_
403530-
~arity:(List.length params) ~params
403531-
~body:(convert_aux body)
403550+
let new_map,body = rename_optional_parameters Map_ident.empty params body in
403551+
if Map_ident.is_empty new_map then
403552+
Lam.function_
403553+
~arity:(List.length params) ~params
403554+
~body:(convert_aux body)
403555+
else
403556+
let params = Ext_list.map params (fun x -> Map_ident.find_default new_map x x) in
403557+
Lam.function_
403558+
~arity:(List.length params) ~params
403559+
~body:(convert_aux body)
403560+
403532403561
| Llet
403533403562
(kind,_value_kind, id,e,body) (*FIXME*)
403534403563
-> convert_let kind id e body

ocaml

Submodule ocaml updated from cc80a61 to 98db001

0 commit comments

Comments
 (0)