Skip to content

Commit f10405b

Browse files
authored
Merge pull request #4982 from rescript-lang/let_module
add support for pattern match on modules
2 parents 6364bb5 + c641c36 commit f10405b

File tree

6 files changed

+129
-28
lines changed

6 files changed

+129
-28
lines changed

jscomp/frontend/ast_tuple_pattern_flatten.ml

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,8 +52,8 @@ let flattern_tuple_pattern_vb
5252
let pvb_pat = self.pat self vb.pvb_pat in
5353
let pvb_expr = self.expr self vb.pvb_expr in
5454
let pvb_attributes = self.attributes self vb.pvb_attributes in
55-
match pvb_pat.ppat_desc with
56-
| Ppat_tuple xs when List.for_all is_simple_pattern xs ->
55+
match pvb_pat.ppat_desc, pvb_expr.pexp_desc with
56+
| Ppat_tuple xs, _ when List.for_all is_simple_pattern xs ->
5757
begin match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
5858
| Some (wholes, es, tuple_attributes)
5959
when
@@ -77,6 +77,22 @@ let flattern_tuple_pattern_vb
7777
pvb_loc = vb.pvb_loc;
7878
pvb_attributes} :: acc
7979
end
80+
| Ppat_record (lid_pats,_), Pexp_pack {pmod_desc= Pmod_ident id}
81+
->
82+
Ext_list.map_append lid_pats acc (fun (lid,pat) ->
83+
match lid.txt with
84+
| Lident s ->
85+
{
86+
pvb_pat = pat;
87+
pvb_expr =
88+
Ast_helper.Exp.ident ~loc:lid.loc
89+
({lid with txt = Ldot(id.txt,s)});
90+
pvb_attributes = [];
91+
pvb_loc = pat.ppat_loc;
92+
}
93+
| _ ->
94+
Location.raise_errorf ~loc:lid.loc "Not supported pattern match on modules"
95+
)
8096
| _ ->
8197
{pvb_pat ;
8298
pvb_expr ;

jscomp/frontend/bs_builtin_ppx.ml

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -167,13 +167,17 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
167167
pvb_attributes;
168168
pvb_loc = _}], body)
169169
->
170-
default_expr_mapper self
171-
{e with
172-
pexp_desc = Pexp_match(pvb_expr,
173-
[{pc_lhs = p; pc_guard = None;
174-
pc_rhs = body}]);
175-
pexp_attributes = e.pexp_attributes @ pvb_attributes
176-
}
170+
begin match pvb_expr.pexp_desc with
171+
| Pexp_pack _ -> default_expr_mapper self e
172+
| _ ->
173+
default_expr_mapper self
174+
{e with
175+
pexp_desc = Pexp_match(pvb_expr,
176+
[{pc_lhs = p; pc_guard = None;
177+
pc_rhs = body}]);
178+
pexp_attributes = e.pexp_attributes @ pvb_attributes
179+
}
180+
end
177181
(* let [@warning "a"] {a;b} = c in body
178182
The attribute is attached to value binding,
179183
after the transformation value binding does not exist so we attach

jscomp/test/hello_res.js

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,5 +17,18 @@ var a = b - 1 | 0;
1717

1818
console.log("hello, res");
1919

20+
List.length({
21+
hd: 1,
22+
tl: {
23+
hd: 2,
24+
tl: {
25+
hd: 3,
26+
tl: /* [] */0
27+
}
28+
}
29+
});
30+
31+
console.log(3);
32+
2033
exports.a = a;
2134
/* b Not a pure module */

jscomp/test/hello_res.res

Lines changed: 29 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,4 +14,32 @@ type t = { "x" : int }
1414

1515
let u : t = {"x" : 3 }
1616

17-
let h = u["x"]
17+
let h = u["x"]
18+
19+
%%private(
20+
let {length, cons } = module (List)
21+
)
22+
23+
24+
25+
%%private(let {length, cons} = module(List))
26+
27+
%%private(let (a, b) = (1, 2))
28+
29+
let {length: len, cons: c} = module(List)
30+
31+
module H = {
32+
module H1 = {
33+
let v = 3
34+
}
35+
}
36+
let u = {
37+
let {length: l, cons} = module(List)
38+
cons(l(list{1, 2, 3}), list{})
39+
}
40+
41+
let h = {
42+
let {v} = module(H.H1)
43+
Js.log(v)
44+
}
45+

lib/4.06.1/unstable/js_compiler.ml

Lines changed: 29 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -405768,8 +405768,8 @@ let flattern_tuple_pattern_vb
405768405768
let pvb_pat = self.pat self vb.pvb_pat in
405769405769
let pvb_expr = self.expr self vb.pvb_expr in
405770405770
let pvb_attributes = self.attributes self vb.pvb_attributes in
405771-
match pvb_pat.ppat_desc with
405772-
| Ppat_tuple xs when List.for_all is_simple_pattern xs ->
405771+
match pvb_pat.ppat_desc, pvb_expr.pexp_desc with
405772+
| Ppat_tuple xs, _ when List.for_all is_simple_pattern xs ->
405773405773
begin match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
405774405774
| Some (wholes, es, tuple_attributes)
405775405775
when
@@ -405793,6 +405793,22 @@ let flattern_tuple_pattern_vb
405793405793
pvb_loc = vb.pvb_loc;
405794405794
pvb_attributes} :: acc
405795405795
end
405796+
| Ppat_record (lid_pats,_), Pexp_pack {pmod_desc= Pmod_ident id}
405797+
->
405798+
Ext_list.map_append lid_pats acc (fun (lid,pat) ->
405799+
match lid.txt with
405800+
| Lident s ->
405801+
{
405802+
pvb_pat = pat;
405803+
pvb_expr =
405804+
Ast_helper.Exp.ident ~loc:lid.loc
405805+
({lid with txt = Ldot(id.txt,s)});
405806+
pvb_attributes = [];
405807+
pvb_loc = pat.ppat_loc;
405808+
}
405809+
| _ ->
405810+
Location.raise_errorf ~loc:lid.loc "Not supported pattern match on modules"
405811+
)
405796405812
| _ ->
405797405813
{pvb_pat ;
405798405814
pvb_expr ;
@@ -406048,13 +406064,17 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
406048406064
pvb_attributes;
406049406065
pvb_loc = _}], body)
406050406066
->
406051-
default_expr_mapper self
406052-
{e with
406053-
pexp_desc = Pexp_match(pvb_expr,
406054-
[{pc_lhs = p; pc_guard = None;
406055-
pc_rhs = body}]);
406056-
pexp_attributes = e.pexp_attributes @ pvb_attributes
406057-
}
406067+
begin match pvb_expr.pexp_desc with
406068+
| Pexp_pack _ -> default_expr_mapper self e
406069+
| _ ->
406070+
default_expr_mapper self
406071+
{e with
406072+
pexp_desc = Pexp_match(pvb_expr,
406073+
[{pc_lhs = p; pc_guard = None;
406074+
pc_rhs = body}]);
406075+
pexp_attributes = e.pexp_attributes @ pvb_attributes
406076+
}
406077+
end
406058406078
(* let [@warning "a"] {a;b} = c in body
406059406079
The attribute is attached to value binding,
406060406080
after the transformation value binding does not exist so we attach

lib/4.06.1/whole_compiler.ml

Lines changed: 29 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -408810,8 +408810,8 @@ let flattern_tuple_pattern_vb
408810408810
let pvb_pat = self.pat self vb.pvb_pat in
408811408811
let pvb_expr = self.expr self vb.pvb_expr in
408812408812
let pvb_attributes = self.attributes self vb.pvb_attributes in
408813-
match pvb_pat.ppat_desc with
408814-
| Ppat_tuple xs when List.for_all is_simple_pattern xs ->
408813+
match pvb_pat.ppat_desc, pvb_expr.pexp_desc with
408814+
| Ppat_tuple xs, _ when List.for_all is_simple_pattern xs ->
408815408815
begin match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
408816408816
| Some (wholes, es, tuple_attributes)
408817408817
when
@@ -408835,6 +408835,22 @@ let flattern_tuple_pattern_vb
408835408835
pvb_loc = vb.pvb_loc;
408836408836
pvb_attributes} :: acc
408837408837
end
408838+
| Ppat_record (lid_pats,_), Pexp_pack {pmod_desc= Pmod_ident id}
408839+
->
408840+
Ext_list.map_append lid_pats acc (fun (lid,pat) ->
408841+
match lid.txt with
408842+
| Lident s ->
408843+
{
408844+
pvb_pat = pat;
408845+
pvb_expr =
408846+
Ast_helper.Exp.ident ~loc:lid.loc
408847+
({lid with txt = Ldot(id.txt,s)});
408848+
pvb_attributes = [];
408849+
pvb_loc = pat.ppat_loc;
408850+
}
408851+
| _ ->
408852+
Location.raise_errorf ~loc:lid.loc "Not supported pattern match on modules"
408853+
)
408838408854
| _ ->
408839408855
{pvb_pat ;
408840408856
pvb_expr ;
@@ -409090,13 +409106,17 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
409090409106
pvb_attributes;
409091409107
pvb_loc = _}], body)
409092409108
->
409093-
default_expr_mapper self
409094-
{e with
409095-
pexp_desc = Pexp_match(pvb_expr,
409096-
[{pc_lhs = p; pc_guard = None;
409097-
pc_rhs = body}]);
409098-
pexp_attributes = e.pexp_attributes @ pvb_attributes
409099-
}
409109+
begin match pvb_expr.pexp_desc with
409110+
| Pexp_pack _ -> default_expr_mapper self e
409111+
| _ ->
409112+
default_expr_mapper self
409113+
{e with
409114+
pexp_desc = Pexp_match(pvb_expr,
409115+
[{pc_lhs = p; pc_guard = None;
409116+
pc_rhs = body}]);
409117+
pexp_attributes = e.pexp_attributes @ pvb_attributes
409118+
}
409119+
end
409100409120
(* let [@warning "a"] {a;b} = c in body
409101409121
The attribute is attached to value binding,
409102409122
after the transformation value binding does not exist so we attach

0 commit comments

Comments
 (0)