Skip to content

Commit 9a2b2da

Browse files
bobzhangbobzhang
authored
Merge pull request #4550 from BuckleScript/new_poly_var_compiling_scheme
add new polyvar compilation scheme (default off)
2 parents 63be0b6 + 6137ceb commit 9a2b2da

File tree

6 files changed

+180
-52
lines changed

6 files changed

+180
-52
lines changed

‎jscomp/core/bs_conditional_initial.ml

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,11 @@ let setup_env () =
3030
Translcore.wrap_single_field_record := Transl_single_field_record.wrap_single_field_record;
3131
Translmod.eval_rec_bindings := Compile_rec_module.eval_rec_bindings;
3232
Typemod.should_hide := Typemod_hide.should_hide;
33+
#if 0 then
34+
Matching.make_test_sequence_variant_constant := Polyvar_pattern_match.make_test_sequence_variant_constant;
35+
Matching.call_switcher_variant_constant := Polyvar_pattern_match.call_switcher_variant_constant;
36+
Matching.call_switcher_variant_constr := Polyvar_pattern_match.call_switcher_variant_constr;
37+
#end
3338
Clflags.no_std_include := true;
3439
Warnings.parse_options false Bsc_warnings.defaults_w;
3540
Warnings.parse_options true Bsc_warnings.defaults_warn_error;

‎jscomp/core/polyvar_pattern_match.ml

Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
(* Copyright (C) 2020- Authors of BuckleScript
2+
*
3+
* This program is free software: you can redistribute it and/or modify
4+
* it under the terms of the GNU Lesser General Public License as published by
5+
* the Free Software Foundation, either version 3 of the License, or
6+
* (at your option) any later version.
7+
*
8+
* In addition to the permissions granted to you by the LGPL, you may combine
9+
* or link a "work that uses the Library" with a publicly distributed version
10+
* of this file to produce a combined library or application, then distribute
11+
* that combined work under the terms of your choosing, with no requirement
12+
* to comply with the obligations normally placed on you by section 4 of the
13+
* LGPL version 3 (or the corresponding section of a later version of the LGPL
14+
* should you choose to use a later version).
15+
*
16+
* This program is distributed in the hope that it will be useful,
17+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
* GNU Lesser General Public License for more details.
20+
*
21+
* You should have received a copy of the GNU Lesser General Public License
22+
* along with this program; if not, write to the Free Software
23+
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
24+
25+
26+
27+
let make_test_sequence_variant_constant
28+
(fail : Lambda.lambda option) (arg : Lambda.lambda)
29+
(int_lambda_list : (int * (string * Lambda.lambda) ) list) : Lambda.lambda=
30+
match int_lambda_list, fail with
31+
| (_, (_,act)) :: rest, None ->
32+
Ext_list.fold_right rest act (fun (hash1,(name,act1)) acc ->
33+
Lifthenelse (Lprim(Pintcomp Ceq,
34+
[arg; Lconst ((Const_pointer (hash1, Pt_variant{name})))], Location.none),
35+
act1, acc
36+
)
37+
)
38+
| _, Some fail ->
39+
Ext_list.fold_right int_lambda_list fail (fun (hash1,(name,act1)) acc ->
40+
Lifthenelse (Lprim(Pintcomp Ceq,
41+
[arg; Lconst (Const_pointer(hash1, Pt_variant{name}))], Location.none),
42+
act1, acc
43+
)
44+
)
45+
| [], None -> assert false
46+
47+
let call_switcher_variant_constant
48+
(_loc : Location.t)
49+
(fail : Lambda.lambda option)
50+
(arg : Lambda.lambda)
51+
(int_lambda_list : (int * (string * Lambda.lambda)) list)
52+
(_names : Lambda.switch_names option) =
53+
Ext_log.dwarn ~__POS__ "%a@." Ext_obj.pp_any _names;
54+
match int_lambda_list, fail with
55+
| (_, (_,act)) :: rest, None ->
56+
Ext_list.fold_right rest act (fun (hash1,(name,act1)) acc ->
57+
Lifthenelse (Lprim(Pintcomp Ceq,
58+
[arg; Lconst (Const_pointer(hash1, Pt_variant{name}))], Location.none),
59+
act1, acc
60+
)
61+
)
62+
| _, Some fail ->
63+
Ext_list.fold_right int_lambda_list fail (fun (hash1,(name,act1)) acc ->
64+
Lifthenelse (Lprim(Pintcomp Ceq,
65+
[arg; Lconst (Const_pointer(hash1, Pt_variant{name}))], Location.none),
66+
act1, acc
67+
)
68+
)
69+
| [], None -> assert false
70+
71+
72+
let call_switcher_variant_constr
73+
(loc : Location.t)
74+
(fail : Lambda.lambda option)
75+
(arg : Lambda.lambda)
76+
int_lambda_list
77+
(names : Lambda.switch_names option) : Lambda.lambda =
78+
let v = Ident.create "variant" in
79+
Llet(Alias, Pgenval, v, Lprim(Pfield (0, Fld_poly_var_tag), [arg], loc),
80+
call_switcher_variant_constant
81+
loc fail (Lvar v) int_lambda_list names)

‎lib/4.06.1/unstable/js_compiler.ml

Lines changed: 31 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -65169,7 +65169,7 @@ val call_switcher_variant_constant :
6516965169
(Location.t ->
6517065170
Lambda.lambda option ->
6517165171
Lambda.lambda ->
65172-
(int * Lambda.lambda) list ->
65172+
(int * (string * Lambda.lambda)) list ->
6517365173
Lambda.switch_names option ->
6517465174
Lambda.lambda)
6517565175
ref
@@ -65178,15 +65178,15 @@ val call_switcher_variant_constr :
6517865178
(Location.t ->
6517965179
Lambda.lambda option ->
6518065180
Lambda.lambda ->
65181-
(int * Lambda.lambda) list ->
65181+
(int * (string * Lambda.lambda)) list ->
6518265182
Lambda.switch_names option ->
6518365183
Lambda.lambda)
6518465184
ref
6518565185

6518665186
val make_test_sequence_variant_constant :
6518765187
(Lambda.lambda option ->
6518865188
Lambda.lambda ->
65189-
(int * Lambda.lambda) list ->
65189+
(int * (string * Lambda.lambda)) list ->
6519065190
Lambda.lambda)
6519165191
ref
6519265192

@@ -66650,10 +66650,10 @@ let divide_variant row ctx {cases = cl; args = al; default=def} =
6665066650
match pato with
6665166651
None ->
6665266652
add (make_variant_matching_constant p lab def ctx) variants
66653-
(=) (Cstr_constant tag) (patl, action) al
66653+
(=) (lab,Cstr_constant tag) (patl, action) al
6665466654
| Some pat ->
6665566655
add (make_variant_matching_nonconst p lab def ctx) variants
66656-
(=) (Cstr_block tag) (pat :: patl, action) al
66656+
(=) (lab,Cstr_block tag) (pat :: patl, action) al
6665766657
end
6665866658
| _ -> []
6665966659
in
@@ -67541,6 +67541,21 @@ let split_cases tag_lambda_list =
6754167541
let const, nonconst = split_rec tag_lambda_list in
6754267542
sort_int_lambda_list const,
6754367543
sort_int_lambda_list nonconst
67544+
67545+
(* refine [split_cases] and [split_variant_cases] *)
67546+
let split_variant_cases tag_lambda_list =
67547+
let rec split_rec = function
67548+
[] -> ([], [])
67549+
| ((name,cstr), act) :: rem ->
67550+
let (consts, nonconsts) = split_rec rem in
67551+
match cstr with
67552+
Cstr_constant n -> ((n, (name, act)) :: consts, nonconsts)
67553+
| Cstr_block n -> (consts, (n, (name, act)) :: nonconsts)
67554+
| Cstr_unboxed -> assert false
67555+
| Cstr_extension _ -> assert false in
67556+
let const, nonconst = split_rec tag_lambda_list in
67557+
sort_int_lambda_list const,
67558+
sort_int_lambda_list nonconst
6754467559

6754567560
let split_extension_cases tag_lambda_list =
6754667561
let rec split_rec = function
@@ -67668,33 +67683,33 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
6766867683

6766967684
let make_test_sequence_variant_constant fail arg int_lambda_list =
6767067685
let _, (cases, actions) =
67671-
as_interval fail min_int max_int int_lambda_list in
67686+
as_interval fail min_int max_int (List.map (fun (a,(_,c)) -> (a,c)) int_lambda_list) in
6767267687
Switcher.test_sequence arg cases actions
6767367688

6767467689
let call_switcher_variant_constant loc fail arg int_lambda_list names =
67675-
call_switcher loc fail arg min_int max_int int_lambda_list names
67690+
call_switcher loc fail arg min_int max_int (List.map (fun (a,(_,c)) -> (a,c)) int_lambda_list) names
6767667691

6767767692

6767867693
let call_switcher_variant_constr loc fail arg int_lambda_list names =
6767967694
let v = Ident.create "variant" in
6768067695
Llet(Alias, Pgenval, v, Lprim(Pfield (0, Fld_poly_var_tag), [arg], loc),
6768167696
call_switcher loc
67682-
fail (Lvar v) min_int max_int int_lambda_list names)
67697+
fail (Lvar v) min_int max_int (List.map (fun (a,(_,c)) -> (a,c)) int_lambda_list) names)
6768367698

6768467699
let call_switcher_variant_constant :
6768567700
(Location.t ->
6768667701
Lambda.lambda option ->
6768767702
Lambda.lambda ->
67688-
(int * Lambda.lambda) list ->
67703+
(int * (string * Lambda.lambda)) list ->
6768967704
Lambda.switch_names option ->
6769067705
Lambda.lambda)
6769167706
ref= ref call_switcher_variant_constant
67692-
67707+
6769367708
let call_switcher_variant_constr :
6769467709
(Location.t ->
6769567710
Lambda.lambda option ->
6769667711
Lambda.lambda ->
67697-
(int * Lambda.lambda) list ->
67712+
(int * (string * Lambda.lambda)) list ->
6769867713
Lambda.switch_names option ->
6769967714
Lambda.lambda)
6770067715
ref
@@ -67703,7 +67718,7 @@ let call_switcher_variant_constr :
6770367718
let make_test_sequence_variant_constant :
6770467719
(Lambda.lambda option ->
6770567720
Lambda.lambda ->
67706-
(int * Lambda.lambda) list ->
67721+
(int * (string * Lambda.lambda)) list ->
6770767722
Lambda.lambda)
6770867723
ref
6770967724
= ref make_test_sequence_variant_constant
@@ -67732,12 +67747,12 @@ let combine_variant names loc row arg partial ctx def
6773267747
None, jumps_empty
6773367748
else
6773467749
mk_failaction_neg partial ctx def in
67735-
let (consts, nonconsts) = split_cases tag_lambda_list in
67750+
let (consts, nonconsts) = split_variant_cases tag_lambda_list in
6773667751
let lambda1 = match fail, one_action with
6773767752
| None, Some act -> act
6773867753
| _,_ ->
6773967754
match (consts, nonconsts) with
67740-
| ([_, act1], [_, act2]) when fail=None ->
67755+
| ([_, (_,act1)], [_, (_,act2)]) when fail=None ->
6774167756
test_int_or_block arg act1 act2
6774267757
| (_, []) -> (* One can compare integers and pointers *)
6774367758
!make_test_sequence_variant_constant fail arg consts
@@ -68053,9 +68068,7 @@ and do_compile_matching repr partial ctx arg pmh = match pmh with
6805368068
(combine_constant names pat.pat_loc arg cst partial)
6805468069
ctx pm
6805568070
| Tpat_construct (_, cstr, _) ->
68056-
let sw_names = if !Config.bs_only
68057-
then !names_from_construct_pattern pat
68058-
else None in
68071+
let sw_names = !names_from_construct_pattern pat in
6805968072
compile_test
6806068073
(compile_match repr partial) partial
6806168074
divide_constructor
@@ -81133,6 +81146,7 @@ let setup_env () =
8113381146
Translcore.wrap_single_field_record := Transl_single_field_record.wrap_single_field_record;
8113481147
Translmod.eval_rec_bindings := Compile_rec_module.eval_rec_bindings;
8113581148
Typemod.should_hide := Typemod_hide.should_hide;
81149+
8113681150
Clflags.no_std_include := true;
8113781151
Warnings.parse_options false Bsc_warnings.defaults_w;
8113881152
Warnings.parse_options true Bsc_warnings.defaults_warn_error;

‎lib/4.06.1/unstable/js_refmt_compiler.ml

Lines changed: 31 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -65169,7 +65169,7 @@ val call_switcher_variant_constant :
6516965169
(Location.t ->
6517065170
Lambda.lambda option ->
6517165171
Lambda.lambda ->
65172-
(int * Lambda.lambda) list ->
65172+
(int * (string * Lambda.lambda)) list ->
6517365173
Lambda.switch_names option ->
6517465174
Lambda.lambda)
6517565175
ref
@@ -65178,15 +65178,15 @@ val call_switcher_variant_constr :
6517865178
(Location.t ->
6517965179
Lambda.lambda option ->
6518065180
Lambda.lambda ->
65181-
(int * Lambda.lambda) list ->
65181+
(int * (string * Lambda.lambda)) list ->
6518265182
Lambda.switch_names option ->
6518365183
Lambda.lambda)
6518465184
ref
6518565185

6518665186
val make_test_sequence_variant_constant :
6518765187
(Lambda.lambda option ->
6518865188
Lambda.lambda ->
65189-
(int * Lambda.lambda) list ->
65189+
(int * (string * Lambda.lambda)) list ->
6519065190
Lambda.lambda)
6519165191
ref
6519265192

@@ -66650,10 +66650,10 @@ let divide_variant row ctx {cases = cl; args = al; default=def} =
6665066650
match pato with
6665166651
None ->
6665266652
add (make_variant_matching_constant p lab def ctx) variants
66653-
(=) (Cstr_constant tag) (patl, action) al
66653+
(=) (lab,Cstr_constant tag) (patl, action) al
6665466654
| Some pat ->
6665566655
add (make_variant_matching_nonconst p lab def ctx) variants
66656-
(=) (Cstr_block tag) (pat :: patl, action) al
66656+
(=) (lab,Cstr_block tag) (pat :: patl, action) al
6665766657
end
6665866658
| _ -> []
6665966659
in
@@ -67541,6 +67541,21 @@ let split_cases tag_lambda_list =
6754167541
let const, nonconst = split_rec tag_lambda_list in
6754267542
sort_int_lambda_list const,
6754367543
sort_int_lambda_list nonconst
67544+
67545+
(* refine [split_cases] and [split_variant_cases] *)
67546+
let split_variant_cases tag_lambda_list =
67547+
let rec split_rec = function
67548+
[] -> ([], [])
67549+
| ((name,cstr), act) :: rem ->
67550+
let (consts, nonconsts) = split_rec rem in
67551+
match cstr with
67552+
Cstr_constant n -> ((n, (name, act)) :: consts, nonconsts)
67553+
| Cstr_block n -> (consts, (n, (name, act)) :: nonconsts)
67554+
| Cstr_unboxed -> assert false
67555+
| Cstr_extension _ -> assert false in
67556+
let const, nonconst = split_rec tag_lambda_list in
67557+
sort_int_lambda_list const,
67558+
sort_int_lambda_list nonconst
6754467559

6754567560
let split_extension_cases tag_lambda_list =
6754667561
let rec split_rec = function
@@ -67668,33 +67683,33 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
6766867683

6766967684
let make_test_sequence_variant_constant fail arg int_lambda_list =
6767067685
let _, (cases, actions) =
67671-
as_interval fail min_int max_int int_lambda_list in
67686+
as_interval fail min_int max_int (List.map (fun (a,(_,c)) -> (a,c)) int_lambda_list) in
6767267687
Switcher.test_sequence arg cases actions
6767367688

6767467689
let call_switcher_variant_constant loc fail arg int_lambda_list names =
67675-
call_switcher loc fail arg min_int max_int int_lambda_list names
67690+
call_switcher loc fail arg min_int max_int (List.map (fun (a,(_,c)) -> (a,c)) int_lambda_list) names
6767667691

6767767692

6767867693
let call_switcher_variant_constr loc fail arg int_lambda_list names =
6767967694
let v = Ident.create "variant" in
6768067695
Llet(Alias, Pgenval, v, Lprim(Pfield (0, Fld_poly_var_tag), [arg], loc),
6768167696
call_switcher loc
67682-
fail (Lvar v) min_int max_int int_lambda_list names)
67697+
fail (Lvar v) min_int max_int (List.map (fun (a,(_,c)) -> (a,c)) int_lambda_list) names)
6768367698

6768467699
let call_switcher_variant_constant :
6768567700
(Location.t ->
6768667701
Lambda.lambda option ->
6768767702
Lambda.lambda ->
67688-
(int * Lambda.lambda) list ->
67703+
(int * (string * Lambda.lambda)) list ->
6768967704
Lambda.switch_names option ->
6769067705
Lambda.lambda)
6769167706
ref= ref call_switcher_variant_constant
67692-
67707+
6769367708
let call_switcher_variant_constr :
6769467709
(Location.t ->
6769567710
Lambda.lambda option ->
6769667711
Lambda.lambda ->
67697-
(int * Lambda.lambda) list ->
67712+
(int * (string * Lambda.lambda)) list ->
6769867713
Lambda.switch_names option ->
6769967714
Lambda.lambda)
6770067715
ref
@@ -67703,7 +67718,7 @@ let call_switcher_variant_constr :
6770367718
let make_test_sequence_variant_constant :
6770467719
(Lambda.lambda option ->
6770567720
Lambda.lambda ->
67706-
(int * Lambda.lambda) list ->
67721+
(int * (string * Lambda.lambda)) list ->
6770767722
Lambda.lambda)
6770867723
ref
6770967724
= ref make_test_sequence_variant_constant
@@ -67732,12 +67747,12 @@ let combine_variant names loc row arg partial ctx def
6773267747
None, jumps_empty
6773367748
else
6773467749
mk_failaction_neg partial ctx def in
67735-
let (consts, nonconsts) = split_cases tag_lambda_list in
67750+
let (consts, nonconsts) = split_variant_cases tag_lambda_list in
6773667751
let lambda1 = match fail, one_action with
6773767752
| None, Some act -> act
6773867753
| _,_ ->
6773967754
match (consts, nonconsts) with
67740-
| ([_, act1], [_, act2]) when fail=None ->
67755+
| ([_, (_,act1)], [_, (_,act2)]) when fail=None ->
6774167756
test_int_or_block arg act1 act2
6774267757
| (_, []) -> (* One can compare integers and pointers *)
6774367758
!make_test_sequence_variant_constant fail arg consts
@@ -68053,9 +68068,7 @@ and do_compile_matching repr partial ctx arg pmh = match pmh with
6805368068
(combine_constant names pat.pat_loc arg cst partial)
6805468069
ctx pm
6805568070
| Tpat_construct (_, cstr, _) ->
68056-
let sw_names = if !Config.bs_only
68057-
then !names_from_construct_pattern pat
68058-
else None in
68071+
let sw_names = !names_from_construct_pattern pat in
6805968072
compile_test
6806068073
(compile_match repr partial) partial
6806168074
divide_constructor
@@ -81133,6 +81146,7 @@ let setup_env () =
8113381146
Translcore.wrap_single_field_record := Transl_single_field_record.wrap_single_field_record;
8113481147
Translmod.eval_rec_bindings := Compile_rec_module.eval_rec_bindings;
8113581148
Typemod.should_hide := Typemod_hide.should_hide;
81149+
8113681150
Clflags.no_std_include := true;
8113781151
Warnings.parse_options false Bsc_warnings.defaults_w;
8113881152
Warnings.parse_options true Bsc_warnings.defaults_warn_error;

0 commit comments

Comments
 (0)