From 4d4a14a9abe7c494a87a1f80a758ce6b7fedce27 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Wed, 15 Jan 2020 09:41:03 +0100 Subject: [PATCH] GH-196 pattern matching lhs (#210) * Allow block with separate type signature and definition of a function For instance, ``` function add : (int, int) => int add(x, y) = x + y ``` cc #196 * Allow pattern matching in left-hand sides * Changelog * Fix type spec * partial case-on-constructor * Changelog for pattern-matching lets --- CHANGELOG.md | 20 ++++ src/aeso_aci.erl | 2 +- src/aeso_ast_infer_types.erl | 116 +++++++++++++++++------ src/aeso_ast_to_fcode.erl | 67 ++++++++++--- src/aeso_ast_to_icode.erl | 10 +- src/aeso_compiler.erl | 4 +- src/aeso_parser.erl | 31 ++++--- src/aeso_pretty.erl | 8 +- src/aeso_syntax.erl | 4 +- src/aeso_syntax_utils.erl | 1 + test/aeso_compiler_tests.erl | 160 +++++++++++++++++--------------- test/aeso_parser_tests.erl | 2 +- test/contracts/factorial.aes | 8 +- test/contracts/lhs_matching.aes | 22 +++++ test/contracts/stack.aes | 7 +- 15 files changed, 315 insertions(+), 147 deletions(-) create mode 100644 test/contracts/lhs_matching.aes diff --git a/CHANGELOG.md b/CHANGELOG.md index d1e2c3f..a25f704 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,26 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] ### Added +- Allow separate entrypoint/function type signature and definition, and pattern + matching in left-hand sides: + ``` + function + length : list('a) => int + length([]) = 0 + length(x :: xs) = 1 + length(xs) + ``` +- Allow pattern matching in list comprehension generators (filtering out match + failures): + ``` + function somes(xs : list(option('a))) : list('a) = + [ x | Some(x) <- xs ] + ``` +- Allow pattern matching in let-bindings (aborting on match failures): + ``` + function test(m : map(int, int)) = + let Some(x) = Map.lookup(m, 0) + x + ``` ### Changed - FATE code generator improvements. ### Removed diff --git a/src/aeso_aci.erl b/src/aeso_aci.erl index 7f9f7a9..274be69 100644 --- a/src/aeso_aci.erl +++ b/src/aeso_aci.erl @@ -129,7 +129,7 @@ encode_anon_args(Types) -> encode_args(Args) -> [ encode_arg(A) || A <- Args ]. -encode_arg({arg, _, Id, T}) -> +encode_arg({typed, _, Id, T}) -> #{name => encode_type(Id), type => encode_type(T)}. diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 7cf8832..e5fcc68 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -621,12 +621,14 @@ infer_contract_top(Env, Kind, Defs0, _Options) -> %% infer_contract takes a proplist mapping global names to types, and %% a list of definitions. -spec infer_contract(env(), main_contract | contract | namespace, [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. -infer_contract(Env0, What, Defs) -> +infer_contract(Env0, What, Defs0) -> + Defs = process_blocks(Defs0), Env = Env0#env{ what = What }, - Kind = fun({type_def, _, _, _, _}) -> type; - ({letfun, _, _, _, _, _}) -> function; - ({fun_decl, _, _, _}) -> prototype; - (_) -> unexpected + Kind = fun({type_def, _, _, _, _}) -> type; + ({letfun, _, _, _, _, _}) -> function; + ({fun_clauses, _, _, _, _}) -> function; + ({fun_decl, _, _, _}) -> prototype; + (_) -> unexpected end, Get = fun(K) -> [ Def || Def <- Defs, Kind(Def) == K ] end, {Env1, TypeDefs} = check_typedefs(Env, Get(type)), @@ -642,9 +644,11 @@ infer_contract(Env0, What, Defs) -> Env3 = bind_funs(ProtoSigs, Env2), Functions = Get(function), %% Check for duplicates in Functions (we turn it into a map below) - _ = bind_funs([{Fun, {tuple_t, Ann, []}} || {letfun, Ann, {id, _, Fun}, _, _, _} <- Functions], - #env{}), - FunMap = maps:from_list([ {Fun, Def} || Def = {letfun, _, {id, _, Fun}, _, _, _} <- Functions ]), + FunBind = fun({letfun, Ann, {id, _, Fun}, _, _, _}) -> {Fun, {tuple_t, Ann, []}}; + ({fun_clauses, Ann, {id, _, Fun}, _, _}) -> {Fun, {tuple_t, Ann, []}} end, + FunName = fun(Def) -> {Name, _} = FunBind(Def), Name end, + _ = bind_funs(lists:map(FunBind, Functions), #env{}), + FunMap = maps:from_list([ {FunName(Def), Def} || Def <- Functions ]), check_reserved_entrypoints(FunMap), DepGraph = maps:map(fun(_, Def) -> aeso_syntax_utils:used_ids(Def) end, FunMap), SCCs = aeso_utils:scc(DepGraph), @@ -655,6 +659,30 @@ infer_contract(Env0, What, Defs) -> destroy_and_report_type_errors(Env4), {Env4, TypeDefs ++ Decls ++ Defs1}. +%% Restructure blocks into multi-clause fundefs (`fun_clauses`). +-spec process_blocks([aeso_syntax:decl()]) -> [aeso_syntax:decl()]. +process_blocks(Decls) -> + lists:flatmap( + fun({block, Ann, Ds}) -> process_block(Ann, Ds); + (Decl) -> [Decl] end, Decls). + +-spec process_block(aeso_syntax:ann(), [aeso_syntax:decl()]) -> [aeso_syntax:decl()]. +process_block(_, []) -> []; +process_block(_, [Decl]) -> [Decl]; +process_block(Ann, [Decl | Decls]) -> + IsThis = fun(Name) -> fun({letfun, _, {id, _, Name1}, _, _, _}) -> Name == Name1; + (_) -> false end end, + case Decl of + {fun_decl, Ann1, Id = {id, _, Name}, Type} -> + {Clauses, Rest} = lists:splitwith(IsThis(Name), Decls), + [{fun_clauses, Ann1, Id, Type, Clauses} | + process_block(Ann, Rest)]; + {letfun, Ann1, Id = {id, _, Name}, _, _, _} -> + {Clauses, Rest} = lists:splitwith(IsThis(Name), [Decl | Decls]), + [{fun_clauses, Ann1, Id, {id, [{origin, system} | Ann1], "_"}, Clauses} | + process_block(Ann, Rest)] + end. + -spec check_typedefs(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. check_typedefs(Env = #env{ namespace = Ns }, Defs) -> create_type_errors(), @@ -787,9 +815,9 @@ check_type(Env, T) -> check_type(Env, T = {tvar, _, _}, Arity) -> [ type_error({higher_kinded_typevar, T}) || Arity /= 0 ], check_tvar(Env, T); -check_type(_Env, X = {id, _, "_"}, Arity) -> +check_type(_Env, X = {id, Ann, "_"}, Arity) -> ensure_base_type(X, Arity), - X; + fresh_uvar(Ann); check_type(Env, X = {Tag, _, _}, Arity) when Tag == con; Tag == qcon; Tag == id; Tag == qid -> case lookup_type(Env, X) of {Q, {_, Def}} -> @@ -960,8 +988,9 @@ typesig_to_fun_t({type_sig, Ann, _Constr, Named, Args, Res}) -> infer_letrec(Env, Defs) -> create_constraints(), - Funs = [{Name, fresh_uvar(A)} - || {letfun, _, {id, A, Name}, _, _, _} <- Defs], + Funs = lists:map(fun({letfun, _, {id, Ann, Name}, _, _, _}) -> {Name, fresh_uvar(Ann)}; + ({fun_clauses, _, {id, Ann, Name}, _, _}) -> {Name, fresh_uvar(Ann)} + end, Defs), ExtendEnv = bind_funs(Funs, Env), Inferred = [ begin @@ -980,26 +1009,51 @@ infer_letrec(Env, Defs) -> [print_typesig(S) || S <- TypeSigs], {TypeSigs, NewDefs}. -infer_letfun(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, Body}) -> +infer_letfun(Env, {fun_clauses, Ann, Fun = {id, _, Name}, Type, Clauses}) -> + Type1 = check_type(Env, Type), + {NameSigs, Clauses1} = lists:unzip([ infer_letfun1(Env, Clause) || Clause <- Clauses ]), + {_, Sigs = [Sig | _]} = lists:unzip(NameSigs), + _ = [ begin + ClauseT = typesig_to_fun_t(ClauseSig), + unify(Env, ClauseT, Type1, {check_typesig, Name, ClauseT, Type1}) + end || ClauseSig <- Sigs ], + {{Name, Sig}, desugar_clauses(Ann, Fun, Sig, Clauses1)}; +infer_letfun(Env, LetFun = {letfun, Ann, Fun, _, _, _}) -> + {{Name, Sig}, Clause} = infer_letfun1(Env, LetFun), + {{Name, Sig}, desugar_clauses(Ann, Fun, Sig, [Clause])}. + +infer_letfun1(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, Body}) -> Env = Env0#env{ stateful = aeso_syntax:get_ann(stateful, Attrib, false), current_function = Fun }, - check_unique_arg_names(Fun, Args), - ArgTypes = [{ArgName, check_type(Env, arg_type(ArgAnn, T))} || {arg, ArgAnn, ArgName, T} <- Args], + {NewEnv, {typed, _, {tuple, _, TypedArgs}, {tuple_t, _, ArgTypes}}} = infer_pattern(Env, {tuple, [{origin, system} | NameAttrib], Args}), ExpectedType = check_type(Env, arg_type(NameAttrib, What)), - NewBody={typed, _, _, ResultType} = check_expr(bind_vars(ArgTypes, Env), Body, ExpectedType), - NewArgs = [{arg, A1, {id, A2, ArgName}, T} - || {{_, T}, {arg, A1, {id, A2, ArgName}, _}} <- lists:zip(ArgTypes, Args)], + NewBody={typed, _, _, ResultType} = check_expr(NewEnv, Body, ExpectedType), NamedArgs = [], - TypeSig = {type_sig, Attrib, none, NamedArgs, [T || {arg, _, _, T} <- NewArgs], ResultType}, + TypeSig = {type_sig, Attrib, none, NamedArgs, ArgTypes, ResultType}, {{Name, TypeSig}, - {letfun, Attrib, {id, NameAttrib, Name}, NewArgs, ResultType, NewBody}}. + {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewBody}}. -check_unique_arg_names(Fun, Args) -> - Name = fun({arg, _, {id, _, X}, _}) -> X end, - Names = lists:map(Name, Args), - Dups = lists:usort(Names -- lists:usort(Names)), - [ type_error({repeated_arg, Fun, Arg}) || Arg <- Dups ], - ok. +desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) -> + NeedDesugar = + case Clauses of + [{letfun, _, _, As, _, _}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As); + _ -> true + end, + case NeedDesugar of + false -> [Clause] = Clauses, Clause; + true -> + NoAnn = [{origin, system}], + Args = [ {typed, NoAnn, {id, NoAnn, "x#" ++ integer_to_list(I)}, Type} + || {I, Type} <- indexed(1, ArgTypes) ], + Tuple = fun([X]) -> X; + (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}} + end, + {letfun, Ann, Fun, Args, RetType, + {typed, NoAnn, + {switch, NoAnn, Tuple(Args), + [ {'case', AnnC, Tuple(ArgsC), Body} + || {letfun, AnnC, _, ArgsC, _, Body} <- Clauses ]}, RetType}} + end. print_typesig({Name, TypeSig}) -> ?PRINT_TYPES("Inferred ~s : ~s\n", [Name, pp(TypeSig)]). @@ -1092,9 +1146,9 @@ get_call_chains(Graph, Visited, Queue, Stop, Acc) -> end. check_expr(Env, Expr, Type) -> - E = {typed, _, _, Type1} = infer_expr(Env, Expr), + {typed, Ann, Expr1, Type1} = infer_expr(Env, Expr), unify(Env, Type1, Type, {check_expr, Expr, Type1, Type}), - E. + {typed, Ann, Expr1, Type}. %% Keep the user-given type infer_expr(_Env, Body={bool, As, _}) -> {typed, As, Body, {id, As, "bool"}}; @@ -1379,7 +1433,7 @@ infer_pattern(Env, Pattern) -> end, NewEnv = bind_vars([{Var, fresh_uvar(Ann1)} || Var = {id, Ann1, _} <- Vars], Env#env{ in_pattern = true }), NewPattern = infer_expr(NewEnv, Pattern), - {NewEnv, NewPattern}. + {NewEnv#env{ in_pattern = Env#env.in_pattern }, NewPattern}. infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> {NewEnv, NewPattern = {typed, _, _, PatType}} = infer_pattern(Env, Pattern), @@ -2751,3 +2805,7 @@ updates_key(Name, Updates) -> Updates1 = [ Upd || {Upd, false, _} <- Xs ], More = [ Rest || {_, true, Rest} <- Xs ], {More, Updates1}. + +indexed(I, Xs) -> + lists:zip(lists:seq(I, I + length(Xs) - 1), Xs). + diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 4a4955b..eb27e16 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -415,9 +415,12 @@ type_to_fcode(Env, Sub, {fun_t, _, Named, Args, Res}) -> type_to_fcode(_Env, _Sub, Type) -> error({todo, Type}). --spec args_to_fcode(env(), [aeso_syntax:arg()]) -> [{var_name(), ftype()}]. +-spec args_to_fcode(env(), [aeso_syntax:pat()]) -> [{var_name(), ftype()}]. args_to_fcode(Env, Args) -> - [ {Name, type_to_fcode(Env, Type)} || {arg, _, {id, _, Name}, Type} <- Args ]. + [ case Arg of + {id, _, Name} -> {Name, type_to_fcode(Env, Type)}; + _ -> internal_error({bad_arg, Arg}) %% Pattern matching has been moved to the rhs at this point + end || {typed, _, Arg, Type} <- Args ]. -define(make_let(X, Expr, Body), make_let(Expr, fun(X) -> Body end)). @@ -722,7 +725,7 @@ validate_aens_resolve_type(Ann, {app_t, _, _, [Type]}, {variant, [[], [FType]]}) ensure_first_order_entrypoint(Ann, Id = {id, _, Name}, Args, Ret, FArgs, FRet) -> [ ensure_first_order(FT, {invalid_entrypoint, higher_order, Ann1, Id, {argument, X, T}}) - || {{arg, Ann1, X, T}, {_, FT}} <- lists:zip(Args, FArgs) ], + || {{typed, Ann1, X, T}, {_, FT}} <- lists:zip(Args, FArgs) ], [ ensure_first_order(FRet, {invalid_entrypoint, higher_order, Ann, Id, {result, Ret}}) || Name /= "init" ], %% init can return higher-order values, since they're written to the store %% rather than being returned. @@ -968,7 +971,11 @@ stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, Expr} | 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}), + LamArgs = [ case Arg of + {typed, Ann1, Id, T} -> {arg, Ann1, Id, T}; + _ -> internal_error({bad_arg, Arg}) %% pattern matching has been desugared + end || Arg <- Args ], + {'let', X, expr_to_fcode(Env, {lam, Ann, LamArgs, Expr}), stmts_to_fcode(bind_var(Env, X), Stmts)}; stmts_to_fcode(Env, [Expr]) -> expr_to_fcode(Env, Expr); @@ -1326,7 +1333,7 @@ simplify(Env, {proj, {var, X}, I} = Expr) -> end; simplify(Env, {switch, Split}) -> - case simpl_switch(Env, Split) of + case simpl_switch(Env, [], Split) of nomatch -> {builtin, abort, [{lit, {string, <<"Incomplete patterns">>}}]}; stuck -> {switch, Split}; Expr -> Expr @@ -1350,21 +1357,51 @@ simpl_proj(Env, I, Expr) -> _ -> false end. -simpl_switch(_Env, {nosplit, E}) -> E; -simpl_switch(Env, {split, _, X, Alts}) -> - case constructor_form(Env, {var, X}) of - false -> stuck; - E -> simpl_switch(Env, E, Alts) +get_catchalls(Alts) -> + [ C || C = {'case', {var, _}, _} <- Alts ]. + +%% The scode compiler can't handle multiple catch-alls, so we need to nest them +%% inside each other. Instead of +%% _ => switch(x) .. +%% _ => e +%% we do +%% _ => switch(x) +%% .. +%% _ => e +add_catchalls(Alts, []) -> Alts; +add_catchalls(Alts, Catchalls) -> + case lists:splitwith(fun({'case', {var, _}, _}) -> false; (_) -> true end, + Alts) of + {Alts1, [C]} -> Alts1 ++ [nest_catchalls([C | Catchalls])]; + {_, []} -> Alts ++ [nest_catchalls(Catchalls)] + %% NOTE: relies on catchalls always being at the end end. -simpl_switch(_, _, []) -> nomatch; -simpl_switch(Env, E, [{'case', Pat, Body} | Alts]) -> +nest_catchalls([C = {'case', {var, _}, {nosplit, _}} | _]) -> C; +nest_catchalls([{'case', P = {var, _}, {split, Type, X, Alts}} | Catchalls]) -> + {'case', P, {split, Type, X, add_catchalls(Alts, Catchalls)}}. + +simpl_switch(_Env, _, {nosplit, E}) -> E; +simpl_switch(Env, Catchalls, {split, Type, X, Alts}) -> + Alts1 = add_catchalls(Alts, Catchalls), + Stuck = {switch, {split, Type, X, Alts1}}, + case constructor_form(Env, {var, X}) of + false -> Stuck; + E -> + case simpl_case(Env, E, Alts1) of + stuck -> Stuck; + Res -> Res + end + end. + +simpl_case(_, _, []) -> nomatch; +simpl_case(Env, E, [{'case', Pat, Body} | Alts]) -> case match_pat(Pat, E) of - false -> simpl_switch(Env, E, Alts); + false -> simpl_case(Env, E, Alts); Binds -> Env1 = maps:merge(Env, maps:from_list(Binds)), - case simpl_switch(Env1, Body) of - nomatch -> simpl_switch(Env, E, Alts); + case simpl_switch(Env1, get_catchalls(Alts), Body) of + nomatch -> simpl_case(Env, E, Alts); stuck -> stuck; Body1 -> let_bind(Binds, Body1) end diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index 7a47905..48f6b82 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -131,7 +131,7 @@ contract_to_icode([Decl | Code], Icode) -> ast_id({id, _, Id}) -> Id; ast_id({qid, _, Id}) -> Id. -ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) -> +ast_args([{typed, _, Name, Type}|Rest], Acc, Icode) -> ast_args(Rest, [{ast_id(Name), ast_typerep1(Type, Icode)}| Acc], Icode); ast_args([], Acc, _Icode) -> lists:reverse(Acc). @@ -355,7 +355,9 @@ ast_body({block, As, [{letval, _, Pat, E} | 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, {lam, Ann, Args, Expr}} | Rest]}, Icode); + ToArg = fun({typed, Ann1, Id, T}) -> {arg, Ann1, Id, T} end, %% Pattern matching has been desugared + LamArgs = lists:map(ToArg, Args), + ast_body({block, As, [{letval, Ann, F, {lam, Ann, LamArgs, Expr}} | Rest]}, Icode); ast_body({block,_,[]}, _Icode) -> #tuple{cpts=[]}; ast_body({block,_,[E]}, Icode) -> @@ -804,10 +806,10 @@ check_entrypoint_type(Ann, Name, Args, Ret) -> true -> ok end end, [ CheckFirstOrder(T, {invalid_entrypoint, higher_order, Ann1, Name, {argument, X, T}}) - || {arg, Ann1, X, T} <- Args ], + || {typed, Ann1, X, T} <- Args ], CheckFirstOrder(Ret, {invalid_entrypoint, higher_order, Ann, Name, {result, Ret}}), [ CheckMonomorphic(T, {invalid_entrypoint, polymorphic, Ann1, Name, {argument, X, T}}) - || {arg, Ann1, X, T} <- Args ], + || {typed, Ann1, X, T} <- Args ], CheckMonomorphic(Ret, {invalid_entrypoint, polymorphic, Ann, Name, {result, Ret}}). check_oracle_type(Ann, Type = ?oracle_t(QType, RType)) -> diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index 6327f00..c677119 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -389,8 +389,8 @@ decode_calldata(ContractString, FunName, Calldata, Options0) -> #{ typed_ast := TypedAst, type_env := TypeEnv} = Code, {ok, Args, _} = get_decode_type(FunName, TypedAst), - DropArg = fun({arg, _, _, T}) -> T; (T) -> T end, - ArgTypes = lists:map(DropArg, Args), + GetType = fun({typed, _, _, T}) -> T; (T) -> T end, + ArgTypes = lists:map(GetType, Args), Type0 = {tuple_t, [], ArgTypes}, %% user defined data types such as variants needed to match against Type = aeso_ast_infer_types:unfold_types_in_type(TypeEnv, Type0, [unfold_record_types, unfold_variant_types]), diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index c5f90cb..74a329c 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -101,11 +101,19 @@ decl() -> , ?RULE(keyword(datatype), id(), type_vars(), tok('='), typedef(variant), {type_def, _1, _2, _3, _5}) %% Function declarations - , ?RULE(modifiers(), fun_or_entry(), id(), tok(':'), type(), add_modifiers(_1, _2, {fun_decl, get_ann(_2), _3, _5})) - , ?RULE(modifiers(), fun_or_entry(), fundef(), add_modifiers(_1, _2, set_pos(get_pos(get_ann(_2)), _3))) - , ?RULE(keyword('let'), valdef(), set_pos(get_pos(_1), _2)) + , ?RULE(modifiers(), fun_or_entry(), maybe_block(fundef_or_decl()), fun_block(_1, _2, _3)) + , ?RULE(keyword('let'), valdef(),set_pos(get_pos(_1), _2)) ])). +fun_block(Mods, Kind, [Decl]) -> + add_modifiers(Mods, Kind, set_pos(get_pos(Kind), Decl)); +fun_block(Mods, Kind, Decls) -> + {block, get_ann(Kind), [ add_modifiers(Mods, Kind, Decl) || Decl <- Decls ]}. + +fundef_or_decl() -> + choice([?RULE(id(), tok(':'), type(), {fun_decl, get_ann(_1), _1, _3}), + fundef()]). + pragma() -> Op = choice([token(T) || T <- ['<', '=<', '==', '>=', '>']]), ?RULE(tok('@'), id("compiler"), Op, version(), {pragma, get_ann(_1), {compiler, element(1, _3), _4}}). @@ -117,7 +125,7 @@ mk_version({int, _, Maj}, Rest) -> [Maj | [N || {_, {int, _, N}} <- Rest]]. fun_or_entry() -> - choice([?RULE(keyword(function), {function, _1}), + choice([?RULE(keyword(function), {function, _1}), ?RULE(keyword(entrypoint), {entrypoint, _1})]). modifiers() -> @@ -168,14 +176,15 @@ valdef() -> fundef() -> choice( - [ ?RULE(id(), args(), tok('='), body(), {letfun, [], _1, _2, type_wildcard(), _4}) - , ?RULE(id(), args(), tok(':'), type(), tok('='), body(), {letfun, [], _1, _2, _4, _6}) + [ ?RULE(id(), args(), tok('='), body(), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), _4}) + , ?RULE(id(), args(), tok(':'), type(), tok('='), body(), {letfun, get_ann(_1), _1, _2, _4, _6}) ]). -args() -> paren_list(arg()). +args() -> paren_list(pattern()). +lam_args() -> paren_list(arg()). arg() -> choice( - ?RULE(id(), {arg, get_ann(_1), _1, type_wildcard()}), + ?RULE(id(), {arg, get_ann(_1), _1, type_wildcard(get_ann(_1))}), ?RULE(id(), tok(':'), type(), {arg, get_ann(_1), _1, _3})). %% -- Types ------------------------------------------------------------------ @@ -246,7 +255,7 @@ expr100() -> Expr100 = ?LAZY_P(expr100()), Expr200 = ?LAZY_P(expr200()), choice( - [ ?RULE(args(), keyword('=>'), body(), {lam, _2, _1, _3}) %% TODO: better location + [ ?RULE(lam_args(), keyword('=>'), body(), {lam, _2, _1, _3}) %% TODO: better location , {'if', keyword('if'), parens(Expr100), Expr200, right(tok(else), Expr100)} , ?RULE(Expr200, optional(right(tok(':'), type())), case _2 of @@ -492,8 +501,8 @@ infix(L, Op, R) -> set_ann(format, infix, {app, get_ann(L), Op, [L, R]}). prefixes(Ops, E) -> lists:foldr(fun prefix/2, E, Ops). prefix(Op, E) -> set_ann(format, prefix, {app, get_ann(Op), Op, [E]}). -type_wildcard() -> - {id, [{origin, system}], "_"}. +type_wildcard(Ann) -> + {id, [{origin, system} | Ann], "_"}. block_e(Stmts) -> group_ifs(Stmts, []). diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 1979925..bf00107 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -169,7 +169,11 @@ decl(D = {letfun, Attrs, _, _, _, _}) -> false -> "function" end, hsep(lists:map(Mod, Attrs) ++ [letdecl(Fun, D)]); -decl(D = {letval, _, _, _}) -> letdecl("let", D). +decl({fun_clauses, Ann, Name, Type, Clauses}) -> + above([ decl(D) || D <- [{fun_decl, Ann, Name, Type} | Clauses] ]); +decl(D = {letval, _, _, _}) -> letdecl("let", D); +decl({block, _, Ds}) -> + above([ decl(D) || D <- Ds ]). -spec pragma(aeso_syntax:pragma()) -> doc(). pragma({compiler, Op, Ver}) -> @@ -196,7 +200,7 @@ name({typed, _, Name, _}) -> name(Name). 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). + block_expr(0, hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T), text("=")]), E). -spec args([aeso_syntax:arg()]) -> doc(). args(Args) -> diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index 3c7ce56..61011da 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -40,6 +40,8 @@ | {type_decl, ann(), id(), [tvar()]} | {type_def, ann(), id(), [tvar()], typedef()} | {fun_decl, ann(), id(), type()} + | {fun_clauses, ann(), id(), type(), [letbind()]} + | {block, ann(), [decl()]} | letbind(). -type compiler_version() :: [non_neg_integer()]. @@ -48,7 +50,7 @@ -type letbind() :: {letval, ann(), pat(), expr()} - | {letfun, ann(), id(), [arg()], type(), expr()}. + | {letfun, ann(), id(), [pat()], type(), expr()}. -type arg() :: {arg, ann(), id(), type()}. diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index b5618e5..71c7c90 100644 --- a/src/aeso_syntax_utils.erl +++ b/src/aeso_syntax_utils.erl @@ -50,6 +50,7 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) -> {fun_decl, _, _, T} -> Type(T); {letval, _, P, E} -> Scoped(BindExpr(P), Expr(E)); {letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ [E])]); + {fun_clauses, _, _, T, Cs} -> Sum([Type(T) | [Decl(C) || C <- Cs]]); %% typedef() {alias_t, T} -> Type(T); {record_t, Fs} -> Type(Fs); diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 8a36646..c45b9ec 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -164,7 +164,8 @@ compilable_contracts() -> "unapplied_builtins", "underscore_number_literals", "qualified_constructor", - "let_patterns" + "let_patterns", + "lhs_matching" ]. not_yet_compilable(fate) -> []; @@ -299,9 +300,22 @@ failing_contracts() -> "Repeated name x in pattern\n" " x :: x (at line 26, column 7)">>, <>, - <>, + "Repeated names x, y in pattern\n" + " (x : int, y, x : string, y : bool) (at line 44, column 14)">>, + <>, + <>, <>, < <>]) , ?TYPE_ERROR(bad_address_literals, - [<>, - <>, - <>, - <>, - <>, - <>, - <>, - <>, - <>, - < " ak_2gx9MEFxKvY9vMG5YnqnXWv1hCsX7rgnfvBLJS4aQurustR1rt : address\n" "against the expected type\n" " bytes(32)">>, + <>, + <>, + <>, + <>, + <>, + <>, + <>, + <>, + <>, < "Failed to resolve byte array lengths in call to Bytes.split with argument of type\n" " - 'f (at line 12, column 20)\n" "and result types\n" - " - 'e (at line 13, column 5)\n" + " - 'e (at line 12, column 25)\n" " - bytes(20) (at line 12, column 29)">>, < " - 'b (at line 18, column 20)\n" "and result types\n" " - bytes(20) (at line 18, column 25)\n" - " - 'a (at line 19, column 5)">>]) + " - 'a (at line 18, column 37)">>]) , ?TYPE_ERROR(wrong_compiler_version, [< " function id(x) = x\n", ?assertMatch( [{contract, _, {con, _, "Identity"}, - [{letfun, _, {id, _, "id"}, [{arg, _, {id, _, "x"}, {id, _, "_"}}], {id, _, "_"}, + [{letfun, _, {id, _, "id"}, [{id, _, "x"}], {id, _, "_"}, {id, _, "x"}}]}], parse_string(Text)), ok end}, diff --git a/test/contracts/factorial.aes b/test/contracts/factorial.aes index 46ca1a6..88a8869 100644 --- a/test/contracts/factorial.aes +++ b/test/contracts/factorial.aes @@ -11,7 +11,7 @@ contract Factorial = stateful entrypoint set_worker(worker) = put(state{worker = worker}) - entrypoint fac(x : int) : int = - if(x == 0) 1 - else x * state.worker.fac(x - 1) - + entrypoint + fac : int => int + fac(0) = 1 + fac(x) = x * state.worker.fac(x - 1) diff --git a/test/contracts/lhs_matching.aes b/test/contracts/lhs_matching.aes new file mode 100644 index 0000000..2cafa9d --- /dev/null +++ b/test/contracts/lhs_matching.aes @@ -0,0 +1,22 @@ +contract LHSMatching = + + function from_some(Some(x)) = x + + function + length : list('a) => int + length([]) = 0 + length(_ :: xs) = 1 + length(xs) + + function + append([], ys) = ys + append(x :: xs, ys) = x :: append(xs, ys) + + function local_match(xs : list('a)) = + let null([]) = true + let null(_ :: _) = false + !null(xs) + + entrypoint main() = + from_some(Some([0])) + ++ append([length([true]), 2, 3], [4, 5, 6]) + ++ [7 | if (local_match([false]))] diff --git a/test/contracts/stack.aes b/test/contracts/stack.aes index 2372114..15177dd 100644 --- a/test/contracts/stack.aes +++ b/test/contracts/stack.aes @@ -8,10 +8,9 @@ contract Stack = entrypoint init(ss : list(string)) = { stack = ss, size = length(ss) } - function length(xs) = - switch(xs) - [] => 0 - _ :: xs => length(xs) + 1 + function + length([]) = 0 + length(_ :: xs) = length(xs) + 1 stateful entrypoint pop() : string = switch(state.stack)