Skip to content

add support for pattern match on modules #4982

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Mar 3, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 18 additions & 2 deletions jscomp/frontend/ast_tuple_pattern_flatten.ml
Original file line number Diff line number Diff line change
Expand Up @@ -52,8 +52,8 @@ let flattern_tuple_pattern_vb
let pvb_pat = self.pat self vb.pvb_pat in
let pvb_expr = self.expr self vb.pvb_expr in
let pvb_attributes = self.attributes self vb.pvb_attributes in
match pvb_pat.ppat_desc with
| Ppat_tuple xs when List.for_all is_simple_pattern xs ->
match pvb_pat.ppat_desc, pvb_expr.pexp_desc with
| Ppat_tuple xs, _ when List.for_all is_simple_pattern xs ->
begin match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
| Some (wholes, es, tuple_attributes)
when
Expand All @@ -77,6 +77,22 @@ let flattern_tuple_pattern_vb
pvb_loc = vb.pvb_loc;
pvb_attributes} :: acc
end
| Ppat_record (lid_pats,_), Pexp_pack {pmod_desc= Pmod_ident id}
->
Ext_list.map_append lid_pats acc (fun (lid,pat) ->
match lid.txt with
| Lident s ->
{
pvb_pat = pat;
pvb_expr =
Ast_helper.Exp.ident ~loc:lid.loc
({lid with txt = Ldot(id.txt,s)});
pvb_attributes = [];
pvb_loc = pat.ppat_loc;
}
| _ ->
Location.raise_errorf ~loc:lid.loc "Not supported pattern match on modules"
)
| _ ->
{pvb_pat ;
pvb_expr ;
Expand Down
18 changes: 11 additions & 7 deletions jscomp/frontend/bs_builtin_ppx.ml
Original file line number Diff line number Diff line change
Expand Up @@ -167,13 +167,17 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
pvb_attributes;
pvb_loc = _}], body)
->
default_expr_mapper self
{e with
pexp_desc = Pexp_match(pvb_expr,
[{pc_lhs = p; pc_guard = None;
pc_rhs = body}]);
pexp_attributes = e.pexp_attributes @ pvb_attributes
}
begin match pvb_expr.pexp_desc with
| Pexp_pack _ -> default_expr_mapper self e
| _ ->
default_expr_mapper self
{e with
pexp_desc = Pexp_match(pvb_expr,
[{pc_lhs = p; pc_guard = None;
pc_rhs = body}]);
pexp_attributes = e.pexp_attributes @ pvb_attributes
}
end
(* let [@warning "a"] {a;b} = c in body
The attribute is attached to value binding,
after the transformation value binding does not exist so we attach
Expand Down
13 changes: 13 additions & 0 deletions jscomp/test/hello_res.js
Original file line number Diff line number Diff line change
Expand Up @@ -17,5 +17,18 @@ var a = b - 1 | 0;

console.log("hello, res");

List.length({
hd: 1,
tl: {
hd: 2,
tl: {
hd: 3,
tl: /* [] */0
}
}
});

console.log(3);

exports.a = a;
/* b Not a pure module */
30 changes: 29 additions & 1 deletion jscomp/test/hello_res.res
Original file line number Diff line number Diff line change
Expand Up @@ -14,4 +14,32 @@ type t = { "x" : int }

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

let h = u["x"]
let h = u["x"]

%%private(
let {length, cons } = module (List)
)



%%private(let {length, cons} = module(List))

%%private(let (a, b) = (1, 2))

let {length: len, cons: c} = module(List)

module H = {
module H1 = {
let v = 3
}
}
let u = {
let {length: l, cons} = module(List)
cons(l(list{1, 2, 3}), list{})
}

let h = {
let {v} = module(H.H1)
Js.log(v)
}

38 changes: 29 additions & 9 deletions lib/4.06.1/unstable/js_compiler.ml
Original file line number Diff line number Diff line change
Expand Up @@ -405768,8 +405768,8 @@ let flattern_tuple_pattern_vb
let pvb_pat = self.pat self vb.pvb_pat in
let pvb_expr = self.expr self vb.pvb_expr in
let pvb_attributes = self.attributes self vb.pvb_attributes in
match pvb_pat.ppat_desc with
| Ppat_tuple xs when List.for_all is_simple_pattern xs ->
match pvb_pat.ppat_desc, pvb_expr.pexp_desc with
| Ppat_tuple xs, _ when List.for_all is_simple_pattern xs ->
begin match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
| Some (wholes, es, tuple_attributes)
when
Expand All @@ -405793,6 +405793,22 @@ let flattern_tuple_pattern_vb
pvb_loc = vb.pvb_loc;
pvb_attributes} :: acc
end
| Ppat_record (lid_pats,_), Pexp_pack {pmod_desc= Pmod_ident id}
->
Ext_list.map_append lid_pats acc (fun (lid,pat) ->
match lid.txt with
| Lident s ->
{
pvb_pat = pat;
pvb_expr =
Ast_helper.Exp.ident ~loc:lid.loc
({lid with txt = Ldot(id.txt,s)});
pvb_attributes = [];
pvb_loc = pat.ppat_loc;
}
| _ ->
Location.raise_errorf ~loc:lid.loc "Not supported pattern match on modules"
)
| _ ->
{pvb_pat ;
pvb_expr ;
Expand Down Expand Up @@ -406048,13 +406064,17 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
pvb_attributes;
pvb_loc = _}], body)
->
default_expr_mapper self
{e with
pexp_desc = Pexp_match(pvb_expr,
[{pc_lhs = p; pc_guard = None;
pc_rhs = body}]);
pexp_attributes = e.pexp_attributes @ pvb_attributes
}
begin match pvb_expr.pexp_desc with
| Pexp_pack _ -> default_expr_mapper self e
| _ ->
default_expr_mapper self
{e with
pexp_desc = Pexp_match(pvb_expr,
[{pc_lhs = p; pc_guard = None;
pc_rhs = body}]);
pexp_attributes = e.pexp_attributes @ pvb_attributes
}
end
(* let [@warning "a"] {a;b} = c in body
The attribute is attached to value binding,
after the transformation value binding does not exist so we attach
Expand Down
38 changes: 29 additions & 9 deletions lib/4.06.1/whole_compiler.ml
Original file line number Diff line number Diff line change
Expand Up @@ -408810,8 +408810,8 @@ let flattern_tuple_pattern_vb
let pvb_pat = self.pat self vb.pvb_pat in
let pvb_expr = self.expr self vb.pvb_expr in
let pvb_attributes = self.attributes self vb.pvb_attributes in
match pvb_pat.ppat_desc with
| Ppat_tuple xs when List.for_all is_simple_pattern xs ->
match pvb_pat.ppat_desc, pvb_expr.pexp_desc with
| Ppat_tuple xs, _ when List.for_all is_simple_pattern xs ->
begin match Ast_open_cxt.destruct_open_tuple pvb_expr [] with
| Some (wholes, es, tuple_attributes)
when
Expand All @@ -408835,6 +408835,22 @@ let flattern_tuple_pattern_vb
pvb_loc = vb.pvb_loc;
pvb_attributes} :: acc
end
| Ppat_record (lid_pats,_), Pexp_pack {pmod_desc= Pmod_ident id}
->
Ext_list.map_append lid_pats acc (fun (lid,pat) ->
match lid.txt with
| Lident s ->
{
pvb_pat = pat;
pvb_expr =
Ast_helper.Exp.ident ~loc:lid.loc
({lid with txt = Ldot(id.txt,s)});
pvb_attributes = [];
pvb_loc = pat.ppat_loc;
}
| _ ->
Location.raise_errorf ~loc:lid.loc "Not supported pattern match on modules"
)
| _ ->
{pvb_pat ;
pvb_expr ;
Expand Down Expand Up @@ -409090,13 +409106,17 @@ let expr_mapper (self : mapper) (e : Parsetree.expression) =
pvb_attributes;
pvb_loc = _}], body)
->
default_expr_mapper self
{e with
pexp_desc = Pexp_match(pvb_expr,
[{pc_lhs = p; pc_guard = None;
pc_rhs = body}]);
pexp_attributes = e.pexp_attributes @ pvb_attributes
}
begin match pvb_expr.pexp_desc with
| Pexp_pack _ -> default_expr_mapper self e
| _ ->
default_expr_mapper self
{e with
pexp_desc = Pexp_match(pvb_expr,
[{pc_lhs = p; pc_guard = None;
pc_rhs = body}]);
pexp_attributes = e.pexp_attributes @ pvb_attributes
}
end
(* let [@warning "a"] {a;b} = c in body
The attribute is attached to value binding,
after the transformation value binding does not exist so we attach
Expand Down