QPQ-AG/sophia
10
0
Fork 0
Code Issues 41 Pull Requests 5 Actions Packages Projects Releases 16 Wiki Activity

Allow patterns in lets and list comprehension binds

Browse Source
This commit is contained in:
Ulf Norell 2019-12-10 16:12:08 +01:00
parent d844c4d276
commit b51a79b5e1
10 changed files with 70 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/aeso_ast_infer_types.erl
View File

@ -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)].

13
src/aeso_ast_to_fcode.erl
View File

@ -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)};

16
src/aeso_ast_to_icode.erl
View File

@ -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) ->

10
src/aeso_parser.erl
View File

@ -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;

10
src/aeso_pretty.erl
View File

@ -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).

5
src/aeso_syntax.erl
View File

@ -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()

6
src/aeso_syntax_utils.erl
View File

@ -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));

3
test/aeso_compiler_tests.erl
View File

@ -163,7 +163,8 @@ compilable_contracts() ->
"payable",
"unapplied_builtins",
"underscore_number_literals",
"qualified_constructor"
"qualified_constructor",
"let_patterns"
].
not_yet_compilable(fate) -> [];

2
test/aeso_parser_tests.erl
View File

@ -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.

13
test/contracts/let_patterns.aes Normal file
View File

@ -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