From b51a79b5e119abe82d44dfab6b32efebbe6ac9d5 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 10 Dec 2019 16:12:08 +0100 Subject: [PATCH] Allow patterns in lets and list comprehension binds --- src/aeso_ast_infer_types.erl | 35 ++++++++++++++++++--------------- src/aeso_ast_to_fcode.erl | 13 ++++++++---- src/aeso_ast_to_icode.erl | 16 +++++++++------ src/aeso_parser.erl | 10 +++++----- src/aeso_pretty.erl | 10 +++++----- src/aeso_syntax.erl | 5 +++-- src/aeso_syntax_utils.erl | 6 +++--- test/aeso_compiler_tests.erl | 3 ++- test/aeso_parser_tests.erl | 2 +- test/contracts/let_patterns.aes | 13 ++++++++++++ 10 files changed, 70 insertions(+), 43 deletions(-) create mode 100644 test/contracts/let_patterns.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 5afe2e3..7cf8832 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -1140,19 +1140,18 @@ infer_expr(Env, {list, As, Elems}) -> infer_expr(Env, {list_comp, As, Yield, []}) -> {typed, _, _, Type} = TypedYield = infer_expr(Env, Yield), {typed, As, {list_comp, As, TypedYield, []}, {app_t, As, {id, As, "list"}, [Type]}}; -infer_expr(Env, {list_comp, As, Yield, [{comprehension_bind, Arg, BExpr}|Rest]}) -> - BindVarType = fresh_uvar(As), +infer_expr(Env, {list_comp, As, Yield, [{comprehension_bind, Pat, BExpr}|Rest]}) -> TypedBind = {typed, As2, _, TypeBExpr} = infer_expr(Env, BExpr), + {NewE, TypedPat = {typed, _, _, PatType}} = infer_pattern(Env, Pat), unify( Env , TypeBExpr - , {app_t, As, {id, As, "list"}, [BindVarType]} - , {list_comp, TypedBind, TypeBExpr, {app_t, As2, {id, As, "list"}, [BindVarType]}}), - NewE = bind_var(Arg, BindVarType, Env), + , {app_t, As, {id, As, "list"}, [PatType]} + , {list_comp, TypedBind, TypeBExpr, {app_t, As2, {id, As, "list"}, [PatType]}}), {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} = infer_expr(NewE, {list_comp, As, Yield, Rest}), { typed , As - , {list_comp, As, TypedYield, [{comprehension_bind, {typed, Arg, BindVarType}, TypedBind}|TypedRest]} + , {list_comp, As, TypedYield, [{comprehension_bind, TypedPat, TypedBind}|TypedRest]} , ResType}; infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Rest]}) -> NewCond = check_expr(Env, Cond, {id, AttrsIF, "bool"}), @@ -1162,8 +1161,8 @@ infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Re , AttrsL , {list_comp, AttrsL, TypedYield, [{comprehension_if, AttrsIF, NewCond}|TypedRest]} , ResType}; -infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, Type, E}|Rest]}) -> - NewE = {typed, _, _, PatType} = infer_expr(Env, {typed, AsLV, E, arg_type(AsLV, Type)}), +infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, E}|Rest]}) -> + NewE = {typed, _, _, PatType} = infer_expr(Env, E), BlockType = fresh_uvar(AsLV), {'case', _, NewPattern, NewRest} = infer_case( Env @@ -1175,7 +1174,7 @@ infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, Type, E}|Rest] {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} = NewRest, { typed , AsLC - , {list_comp, AsLC, TypedYield, [{letval, AsLV, NewPattern, Type, NewE}|TypedRest]} + , {list_comp, AsLC, TypedYield, [{letval, AsLV, NewPattern, NewE}|TypedRest]} , ResType }; infer_expr(Env, {list_comp, AsLC, Yield, [Def={letfun, AsLF, _, _, _, _}|Rest]}) -> @@ -1308,7 +1307,7 @@ infer_expr(Env, {lam, Attrs, Args, Body}) -> infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, Body, ResultType), NewArgs = [{arg, As, NewPat, NewT} || {typed, As, NewPat, NewT} <- NewArgPatterns], {typed, Attrs, {lam, Attrs, NewArgs, NewBody}, {fun_t, Attrs, [], ArgTypes, ResultType}}; -infer_expr(Env, Let = {letval, Attrs, _, _, _}) -> +infer_expr(Env, Let = {letval, Attrs, _, _}) -> type_error({missing_body_for_let, Attrs}), infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]}); infer_expr(Env, Let = {letfun, Attrs, _, _, _, _}) -> @@ -1371,15 +1370,19 @@ infer_op(Env, As, Op, Args, InferOp) -> unify(Env, ArgTypes, OperandTypes, {infer_app, Op, Args, Inferred, ArgTypes}), {typed, As, {app, As, Op, TypedArgs}, ResultType}. -infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> +infer_pattern(Env, Pattern) -> Vars = free_vars(Pattern), Names = [N || {id, _, N} <- Vars, N /= "_"], case Names -- lists:usort(Names) of [] -> ok; Nonlinear -> type_error({non_linear_pattern, Pattern, lists:usort(Nonlinear)}) end, - NewEnv = bind_vars([{Var, fresh_uvar(Ann)} || Var = {id, Ann, _} <- Vars], Env#env{ in_pattern = true }), - NewPattern = {typed, _, _, PatType} = infer_expr(NewEnv, Pattern), + NewEnv = bind_vars([{Var, fresh_uvar(Ann1)} || Var = {id, Ann1, _} <- Vars], Env#env{ in_pattern = true }), + NewPattern = infer_expr(NewEnv, Pattern), + {NewEnv, NewPattern}. + +infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> + {NewEnv, NewPattern = {typed, _, _, PatType}} = infer_pattern(Env, Pattern), NewBranch = check_expr(NewEnv#env{ in_pattern = false }, Branch, SwitchType), unify(Env, PatType, ExprType, {case_pat, Pattern, PatType, ExprType}), {'case', Attrs, NewPattern, NewBranch}. @@ -1394,11 +1397,11 @@ infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) -> FunT = typesig_to_fun_t(TypeSig), NewE = bind_var({id, Ann, Name}, FunT, Env), [LetFun|infer_block(NewE, Attrs, Rest, BlockType)]; -infer_block(Env, _, [{letval, Attrs, Pattern, Type, E}|Rest], BlockType) -> - NewE = {typed, _, _, PatType} = infer_expr(Env, {typed, Attrs, E, arg_type(aeso_syntax:get_ann(Pattern), Type)}), +infer_block(Env, _, [{letval, Attrs, Pattern, E}|Rest], BlockType) -> + NewE = {typed, _, _, PatType} = infer_expr(Env, E), {'case', _, NewPattern, {typed, _, {block, _, NewRest}, _}} = infer_case(Env, Attrs, Pattern, PatType, {block, Attrs, Rest}, BlockType), - [{letval, Attrs, NewPattern, Type, NewE}|NewRest]; + [{letval, Attrs, NewPattern, NewE}|NewRest]; infer_block(Env, Attrs, [E|Rest], BlockType) -> [infer_expr(Env, E)|infer_block(Env, Attrs, Rest, BlockType)]. diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index a8c3224..4a4955b 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -564,9 +564,12 @@ expr_to_fcode(Env, _Type, {app, _, {'..', _}, [A, B]}) -> expr_to_fcode(Env, _Type, {list_comp, _, Yield, []}) -> {op, '::', [expr_to_fcode(Env, Yield), nil]}; -expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, {typed, {id, _, Arg}, _}, BindExpr}|Rest]}) -> +expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {typed, _, _, PatType}, BindExpr}|Rest]}) -> + Arg = fresh_name(), Env1 = bind_var(Env, Arg), - Bind = {lam, [Arg], expr_to_fcode(Env1, {list_comp, As, Yield, Rest})}, + Bind = {lam, [Arg], expr_to_fcode(Env1, {switch, As, {typed, As, {id, As, Arg}, PatType}, + [{'case', As, Pat, {list_comp, As, Yield, Rest}}, + {'case', As, {id, As, "_"}, {list, As, []}}]})}, {def_u, FlatMap, _} = resolve_fun(Env, ["ListInternal", "flat_map"]), {def, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]}; expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) -> @@ -574,7 +577,7 @@ expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Res expr_to_fcode(Env, Type, {list_comp, As, Yield, Rest}), nil ); -expr_to_fcode(Env, Type, {list_comp, As, Yield, [LV = {letval, _, _, _, _}|Rest]}) -> +expr_to_fcode(Env, Type, {list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}) -> expr_to_fcode(Env, Type, {block, As, [LV, {list_comp, As, Yield, Rest}]}); expr_to_fcode(Env, Type, {list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}) -> expr_to_fcode(Env, Type, {block, As, [LF, {list_comp, As, Yield, Rest}]}); @@ -960,8 +963,10 @@ decision_tree_to_fcode({'if', A, Then, Else}) -> %% -- Statements -- -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). -stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> +stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, Expr} | Stmts]) -> {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)}; +stmts_to_fcode(Env, [{letval, Ann, Pat, Expr} | Stmts]) -> + expr_to_fcode(Env, {switch, Ann, Expr, [{'case', Ann, Pat, {block, Ann, Stmts}}]}); stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, Expr} | Stmts]) -> {'let', X, expr_to_fcode(Env, {lam, Ann, Args, Expr}), stmts_to_fcode(bind_var(Env, X), Stmts)}; diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index acf68ea..7a47905 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -318,19 +318,23 @@ ast_body({app, As, Fun, Args}, Icode) -> end; ast_body({list_comp, _, Yield, []}, Icode) -> #list{elems = [ast_body(Yield, Icode)]}; -ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, Arg, ArgType}, BindExpr}|Rest]}, Icode) -> +ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, _, Pat, ArgType}, BindExpr}|Rest]}, Icode) -> + Arg = "%lc", + Body = {switch, As, {typed, As, {id, As, Arg}, ArgType}, + [{'case', As, Pat, {list_comp, As, Yield, Rest}}, + {'case', As, {id, As, "_"}, {list, As, []}}]}, #funcall { function = #var_ref{ name = ["ListInternal", "flat_map"] } , args = - [ #lambda{ args=[#arg{name = ast_id(Arg), type = ast_type(ArgType, Icode)}] - , body = ast_body({list_comp, As, Yield, Rest}, Icode) + [ #lambda{ args=[#arg{name = Arg, type = ast_type(ArgType, Icode)}] + , body = ast_body(Body, Icode) } , ast_body(BindExpr, Icode) ] }; ast_body({list_comp, As, Yield, [{comprehension_if, AsIF, Cond}|Rest]}, Icode) -> ast_body({'if', AsIF, Cond, {list_comp, As, Yield, Rest}, {list, As, []}}, Icode); -ast_body({list_comp, As, Yield, [LV = {letval, _, _, _, _}|Rest]}, Icode) -> +ast_body({list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}, Icode) -> ast_body({block, As, [LV, {list_comp, As, Yield, Rest}]}, Icode); ast_body({list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}, Icode) -> ast_body({block, As, [LF, {list_comp, As, Yield, Rest}]}, Icode); @@ -344,14 +348,14 @@ ast_body({switch,_,A,Cases}, Icode) -> #switch{expr=ast_body(A, Icode), cases=[{ast_body(Pat, Icode),ast_body(Body, Icode)} || {'case',_,Pat,Body} <- Cases]}; -ast_body({block, As, [{letval, _, Pat, _, E} | Rest]}, Icode) -> +ast_body({block, As, [{letval, _, Pat, E} | Rest]}, Icode) -> E1 = ast_body(E, Icode), Pat1 = ast_body(Pat, Icode), Rest1 = ast_body({block, As, Rest}, Icode), #switch{expr = E1, cases = [{Pat1, Rest1}]}; ast_body({block, As, [{letfun, Ann, F, Args, _Type, Expr} | Rest]}, Icode) -> - ast_body({block, As, [{letval, Ann, F, unused, {lam, Ann, Args, Expr}} | Rest]}, Icode); + ast_body({block, As, [{letval, Ann, F, {lam, Ann, Args, Expr}} | Rest]}, Icode); ast_body({block,_,[]}, _Icode) -> #tuple{cpts=[]}; ast_body({block,_,[E]}, Icode) -> diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index de9dcc6..7109a46 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -164,9 +164,7 @@ letdecl() -> letdef() -> choice(valdef(), fundef()). valdef() -> - choice( - ?RULE(id(), tok('='), body(), {letval, [], _1, type_wildcard(), _3}), - ?RULE(id(), tok(':'), type(), tok('='), body(), {letval, [], _1, _3, _5})). + ?RULE(pattern(), tok('='), body(), {letval, [], _1, _3}). fundef() -> choice( @@ -238,7 +236,7 @@ branch() -> ?RULE(pattern(), keyword('=>'), body(), {'case', _2, _1, _3}). pattern() -> - ?LET_P(E, expr500(), parse_pattern(E)). + ?LET_P(E, expr(), parse_pattern(E)). %% -- Expressions ------------------------------------------------------------ @@ -297,7 +295,7 @@ comprehension_if() -> ?RULE(keyword('if'), parens(expr()), {comprehension_if, _1, _2}). comprehension_bind() -> - ?RULE(id(), tok('<-'), expr(), {comprehension_bind, _1, _3}). + ?RULE(pattern(), tok('<-'), expr(), {comprehension_bind, _1, _3}). arg_expr() -> ?LAZY_P( @@ -553,6 +551,8 @@ parse_pattern({list, Ann, Es}) -> {list, Ann, lists:map(fun parse_pattern/1, Es)}; parse_pattern({record, Ann, Fs}) -> {record, Ann, lists:map(fun parse_field_pattern/1, Fs)}; +parse_pattern({typed, Ann, E, Type}) -> + {typed, Ann, parse_pattern(E), Type}; parse_pattern(E = {con, _, _}) -> E; parse_pattern(E = {qcon, _, _}) -> E; parse_pattern(E = {id, _, _}) -> E; diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 6a362de..1979925 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -169,7 +169,7 @@ decl(D = {letfun, Attrs, _, _, _, _}) -> false -> "function" end, hsep(lists:map(Mod, Attrs) ++ [letdecl(Fun, D)]); -decl(D = {letval, _, _, _, _}) -> letdecl("let", D). +decl(D = {letval, _, _, _}) -> letdecl("let", D). -spec pragma(aeso_syntax:pragma()) -> doc(). pragma({compiler, Op, Ver}) -> @@ -193,8 +193,8 @@ name({tvar, _, Name}) -> text(Name); name({typed, _, Name, _}) -> name(Name). -spec letdecl(string(), aeso_syntax:letbind()) -> doc(). -letdecl(Let, {letval, _, F, T, E}) -> - block_expr(0, hsep([text(Let), typed(name(F), T), text("=")]), E); +letdecl(Let, {letval, _, P, E}) -> + block_expr(0, hsep([text(Let), expr(P), text("=")]), E); letdecl(Let, {letfun, _, F, Args, T, E}) -> block_expr(0, hsep([text(Let), typed(beside(name(F), args(Args)), T), text("=")]), E). @@ -459,7 +459,7 @@ elim1(Get={map_get, _, _}) -> elim(Get); elim1(Get={map_get, _, _, _}) -> elim(Get). alt({'case', _, Pat, Body}) -> - block_expr(0, hsep(expr_p(500, Pat), text("=>")), Body). + block_expr(0, hsep(expr(Pat), text("=>")), Body). block_expr(_, Header, {block, _, Ss}) -> block(Header, statements(Ss)); @@ -469,7 +469,7 @@ block_expr(P, Header, E) -> statements(Stmts) -> above([ statement(S) || S <- Stmts ]). -statement(S = {letval, _, _, _, _}) -> letdecl("let", S); +statement(S = {letval, _, _, _}) -> letdecl("let", S); statement(S = {letfun, _, _, _, _, _}) -> letdecl("let", S); statement(E) -> expr(E). diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index 66104b2..3c7ce56 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -47,7 +47,7 @@ -type pragma() :: {compiler, '==' | '<' | '>' | '=<' | '>=', compiler_version()}. -type letbind() - :: {letval, ann(), id(), type(), expr()} + :: {letval, ann(), pat(), expr()} | {letfun, ann(), id(), [arg()], type(), expr()}. -type arg() :: {arg, ann(), id(), type()}. @@ -112,7 +112,7 @@ -type record_or_map() :: record | map | record_or_map_error. --type comprehension_exp() :: [ {comprehension_bind, id(), expr()} +-type comprehension_exp() :: [ {comprehension_bind, pat(), expr()} | {comprehension_if, ann(), expr()} | letbind() ]. @@ -140,6 +140,7 @@ -type pat() :: {app, ann(), con() | op(), [pat()]} | {tuple, ann(), [pat()]} | {list, ann(), [pat()]} + | {typed, ann(), pat(), type()} | {record, ann(), [field(pat())]} | constant() | con() diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index 5aa43e9..b5618e5 100644 --- a/src/aeso_syntax_utils.erl +++ b/src/aeso_syntax_utils.erl @@ -48,7 +48,7 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) -> {type_decl, _, I, _} -> BindType(I); {type_def, _, I, _, D} -> Plus(BindType(I), Decl(D)); {fun_decl, _, _, T} -> Type(T); - {letval, _, F, T, E} -> Sum([BindExpr(F), Type(T), Expr(E)]); + {letval, _, P, E} -> Scoped(BindExpr(P), Expr(E)); {letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ [E])]); %% typedef() {alias_t, T} -> Type(T); @@ -76,8 +76,8 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) -> Plus(Expr(E), Scoped(BindExpr(I), Expr({list_comp, A, Y, R}))); {list_comp, A, Y, [{comprehension_if, _, E}|R]} -> Plus(Expr(E), Expr({list_comp, A, Y, R})); - {list_comp, A, Y, [D = {letval, _, F, _, _} | R]} -> - Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R}))); + {list_comp, A, Y, [D = {letval, _, Pat, _} | R]} -> + Plus(Decl(D), Scoped(BindExpr(Pat), Expr({list_comp, A, Y, R}))); {list_comp, A, Y, [D = {letfun, _, F, _, _, _} | R]} -> Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R}))); {typed, _, E, T} -> Plus(Expr(E), Type(T)); diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 3ddca8c..8a36646 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -163,7 +163,8 @@ compilable_contracts() -> "payable", "unapplied_builtins", "underscore_number_literals", - "qualified_constructor" + "qualified_constructor", + "let_patterns" ]. not_yet_compilable(fate) -> []; diff --git a/test/aeso_parser_tests.erl b/test/aeso_parser_tests.erl index ab585f3..09c4c3f 100644 --- a/test/aeso_parser_tests.erl +++ b/test/aeso_parser_tests.erl @@ -78,7 +78,7 @@ parse_string(Text, Opts) -> aeso_parser:string(Text, Opts). parse_expr(Text) -> - [{letval, _, _, _, Expr}] = + [{letval, _, _, Expr}] = parse_string("let _ = " ++ Text), Expr. diff --git a/test/contracts/let_patterns.aes b/test/contracts/let_patterns.aes new file mode 100644 index 0000000..3a2590e --- /dev/null +++ b/test/contracts/let_patterns.aes @@ -0,0 +1,13 @@ +contract LetPatterns = + + record r = {x : int, y : int, b : bool} + + entrypoint test() = foo([1, 0], (2, 3), Some(4), {x = 5, y = 6, b = false}) + + entrypoint foo(xs : list(int), p : int * int, some : option(int), r : r) = + let x :: _ = xs + let (a, b) = p + let Some(n) = some + let {x = i, y = j} = r + x + a + b + n + i + j +