From c30201cdba50174c823b293fb070d590d1aa995b Mon Sep 17 00:00:00 2001 From: Gaith Hallak Date: Wed, 6 Oct 2021 13:17:33 +0300 Subject: [PATCH] Implement multiple exprs in the same guard --- src/aeso_aci.erl | 8 +-- src/aeso_ast_infer_types.erl | 100 +++++++++++++++++++---------------- src/aeso_ast_to_fcode.erl | 29 +++++----- src/aeso_compiler.erl | 8 +-- src/aeso_parser.erl | 38 +++++-------- src/aeso_pretty.erl | 8 +-- src/aeso_syntax.erl | 7 ++- src/aeso_syntax_utils.erl | 7 +-- test/aeso_calldata_tests.erl | 2 +- test/aeso_parser_tests.erl | 4 +- 10 files changed, 108 insertions(+), 103 deletions(-) diff --git a/src/aeso_aci.erl b/src/aeso_aci.erl index ceac831..0382593 100644 --- a/src/aeso_aci.erl +++ b/src/aeso_aci.erl @@ -115,7 +115,7 @@ encode_contract(Namespace = {namespace, _, {con, _, Name}, _}) -> %% Encode a function definition. Currently we are only interested in %% the interface and type. -encode_function(FDef = {letfun, _, {id, _, Name}, Args, Type, _, _}) -> +encode_function(FDef = {letfun, _, {id, _, Name}, Args, Type, _}) -> #{name => encode_name(Name), arguments => encode_args(Args), returns => encode_type(Type), @@ -347,9 +347,9 @@ contract_funcs({C, _, _, Decls}) when ?IS_CONTRACT_HEAD(C); C == namespace -> contract_types({C, _, _, Decls}) when ?IS_CONTRACT_HEAD(C); C == namespace -> [ D || D <- Decls, is_type(D) ]. -is_fun({letfun, _, _, _, _, _, _}) -> true; -is_fun({fun_decl, _, _, _}) -> true; -is_fun(_) -> false. +is_fun({letfun, _, _, _, _, _}) -> true; +is_fun({fun_decl, _, _, _}) -> true; +is_fun(_) -> false. is_type({type_def, _, _, _, _}) -> true; is_type(_) -> false. diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index bc9e87e..a0772c4 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -285,7 +285,7 @@ bind_contract({Contract, Ann, Id, Contents}, Env) contract_call_type( {fun_t, AnnF, [], [ArgT || {typed, _, _, ArgT} <- Args], RetT}) } - || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, [], [{typed, _, _, RetT}]} <- Contents, + || {letfun, AnnF, Entrypoint = {id, _, Name}, Args, _Type, [{guarded, _, [], {typed, _, _, RetT}}]} <- Contents, Name =/= "init" ] ++ %% Predefined fields @@ -293,7 +293,7 @@ bind_contract({Contract, Ann, Id, Contents}, Env) [ {field_t, Sys, {id, Sys, ?CONSTRUCTOR_MOCK_NAME}, contract_call_type( case [ [ArgT || {typed, _, _, ArgT} <- Args] - || {letfun, AnnF, {id, _, "init"}, Args, _, _, _} <- Contents, + || {letfun, AnnF, {id, _, "init"}, Args, _, _} <- Contents, aeso_syntax:get_ann(entrypoint, AnnF, false)] ++ [ Args || {fun_decl, AnnF, {id, _, "init"}, {fun_t, _, _, Args, _}} <- Contents, @@ -896,12 +896,12 @@ infer_contract(Env0, What, Defs0, Options) -> end, destroy_and_report_type_errors(Env0), Env = Env0#env{ what = What }, - Kind = fun({type_def, _, _, _, _}) -> type; - ({letfun, _, _, _, _, _, _}) -> function; - ({fun_clauses, _, _, _, _}) -> function; - ({fun_decl, _, _, _}) -> prototype; - ({using, _, _, _, _}) -> using; - (_) -> unexpected + Kind = fun({type_def, _, _, _, _}) -> type; + ({letfun, _, _, _, _, _}) -> function; + ({fun_clauses, _, _, _, _}) -> function; + ({fun_decl, _, _, _}) -> prototype; + ({using, _, _, _, _}) -> using; + (_) -> unexpected end, Get = fun(K, In) -> [ Def || Def <- In, Kind(Def) == K ] end, OldUsedNamespaces = Env#env.used_namespaces, @@ -919,8 +919,8 @@ infer_contract(Env0, What, Defs0, Options) -> Env3 = bind_funs(ProtoSigs, Env2), Functions = Get(function, Defs), %% Check for duplicates in Functions (we turn it into a map below) - FunBind = fun({letfun, Ann, {id, _, Fun}, _, _, _, _}) -> {Fun, {tuple_t, Ann, []}}; - ({fun_clauses, Ann, {id, _, Fun}, _, _}) -> {Fun, {tuple_t, Ann, []}} end, + 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 ]), @@ -947,14 +947,14 @@ process_blocks(Decls) -> process_block(_, []) -> []; process_block(_, [Decl]) -> [Decl]; process_block(_Ann, [Decl | Decls]) -> - IsThis = fun(Name) -> fun({letfun, _, {id, _, Name1}, _, _, _, _}) -> Name == Name1; + 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), [type_error({mismatched_decl_in_funblock, Name, D1}) || D1 <- Rest], [{fun_clauses, Ann1, Id, Type, Clauses}]; - {letfun, Ann1, Id = {id, _, Name}, _, _, _, _} -> + {letfun, Ann1, Id = {id, _, Name}, _, _, _} -> {Clauses, Rest} = lists:splitwith(IsThis(Name), [Decl | Decls]), [type_error({mismatched_decl_in_funblock, Name, D1}) || D1 <- Rest], [{fun_clauses, Ann1, Id, {id, [{origin, system} | Ann1], "_"}, Clauses}] @@ -1087,7 +1087,7 @@ check_modifiers_(Env, [{Contract, _, Con, Decls} | Rest]) [ D || D <- Decls, aeso_syntax:get_ann(entrypoint, D, false) ]} of {true, []} -> type_error({contract_has_no_entrypoints, Con}); _ when IsInterface -> - case [ {AnnF, Id} || {letfun, AnnF, Id, _, _, _, _} <- Decls ] of + case [ {AnnF, Id} || {letfun, AnnF, Id, _, _, _} <- Decls ] of [{AnnF, Id} | _] -> type_error({definition_in_contract_interface, AnnF, Id}); [] -> ok end; @@ -1324,8 +1324,8 @@ typesig_to_fun_t({type_sig, Ann, _Constr, Named, Args, Res}) -> infer_letrec(Env, Defs) -> create_constraints(), - Funs = lists:map(fun({letfun, _, {id, Ann, Name}, _, _, _, _}) -> {Name, fresh_uvar(Ann)}; - ({fun_clauses, _, {id, Ann, Name}, _, _}) -> {Name, fresh_uvar(Ann)} + 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 = @@ -1354,26 +1354,32 @@ infer_letfun(Env, {fun_clauses, Ann, Fun = {id, _, Name}, Type, Clauses}) -> 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, _, _, _, _}) -> +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, Guards, Bodies}) -> +infer_letfun1(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, GuardedBodies}) -> Env = Env0#env{ stateful = aeso_syntax:get_ann(stateful, Attrib, false), current_function = Fun }, {NewEnv, {typed, _, {tuple, _, TypedArgs}, {tuple_t, _, ArgTypes}}} = infer_pattern(Env, {tuple, [{origin, system} | NameAttrib], Args}), - NewGuards = lists:map(fun(Guard) -> check_expr(NewEnv#env{ in_guard = true }, Guard, {id, Attrib, "bool"}) end, Guards), ExpectedType = check_type(Env, arg_type(NameAttrib, What)), - NewBodies = [{typed, _, _, ResultType} | _] = lists:map(fun(Body) -> check_expr(NewEnv, Body, ExpectedType) end, Bodies), + InferGuardedBodies = fun({guarded, Ann, Guards, Body}) -> + NewGuards = lists:map(fun(Guard) -> + check_expr(NewEnv#env{ in_guard = true }, Guard, {id, Attrib, "bool"}) + end, Guards), + NewBody = check_expr(NewEnv, Body, ExpectedType), + {guarded, Ann, NewGuards, NewBody} + end, + NewGuardedBodies = [{guarded, _, _, {typed, _, _, ResultType}} | _] = lists:map(InferGuardedBodies, GuardedBodies), NamedArgs = [], TypeSig = {type_sig, Attrib, none, NamedArgs, ArgTypes, ResultType}, {{Name, TypeSig}, - {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewGuards, NewBodies}}. + {letfun, Attrib, {id, NameAttrib, Name}, TypedArgs, ResultType, NewGuardedBodies}}. 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 + [{letfun, _, _, As, _, _}] -> lists:any(fun({typed, _, {id, _, _}, _}) -> false; (_) -> true end, As); + _ -> true end, case NeedDesugar of false -> [Clause] = Clauses, Clause; @@ -1384,11 +1390,10 @@ desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) -> Tuple = fun([X]) -> X; (As) -> {typed, NoAnn, {tuple, NoAnn, As}, {tuple_t, NoAnn, ArgTypes}} end, - {letfun, Ann, Fun, Args, RetType, [], - [{typed, NoAnn, + {letfun, Ann, Fun, Args, RetType, [{guarded, NoAnn, [], {typed, NoAnn, {switch, NoAnn, Tuple(Args), - [ {'case', AnnC, Tuple(ArgsC), Guards, Bodies} - || {letfun, AnnC, _, ArgsC, _, Guards, Bodies} <- Clauses ]}, RetType}]} + [ {'case', AnnC, Tuple(ArgsC), GuardedBodies} + || {letfun, AnnC, _, ArgsC, _, GuardedBodies} <- Clauses ]}, RetType}}]} end. print_typesig({Name, TypeSig}) -> @@ -1456,7 +1461,7 @@ check_state_dependencies(Env, Defs) -> SetState = Top ++ ["put"], Init = Top ++ ["init"], UsedNames = fun(X) -> [{Xs, Ann} || {{term, Xs}, Ann} <- aeso_syntax_utils:used(X)] end, - Funs = [ {Top ++ [Name], Fun} || Fun = {letfun, _, {id, _, Name}, _Args, _Type, [], _Bodies} <- Defs ], + Funs = [ {Top ++ [Name], Fun} || Fun = {letfun, _, {id, _, Name}, _Args, _Type, _GuardedBodies} <- Defs ], Deps = maps:from_list([{Name, UsedNames(Def)} || {Name, Def} <- Funs]), case maps:get(Init, Deps, false) of false -> ok; %% No init, so nothing to check @@ -1560,13 +1565,12 @@ infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Re 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]} = + {'case', _, NewPattern, [{guarded, _, [], NewRest}]} = infer_case( Env , AsLC , Pattern - , [] , PatType - , [{list_comp, AsLC, Yield, Rest}] + , [{guarded, AsLC, [], {list_comp, AsLC, Yield, Rest}}] , BlockType), {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} = NewRest, { typed @@ -1574,7 +1578,7 @@ infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, E}|Rest]}) -> , {list_comp, AsLC, TypedYield, [{letval, AsLV, NewPattern, NewE}|TypedRest]} , ResType }; -infer_expr(Env, {list_comp, AsLC, Yield, [Def={letfun, AsLF, _, _, _, _, _}|Rest]}) -> +infer_expr(Env, {list_comp, AsLC, Yield, [Def={letfun, AsLF, _, _, _, _}|Rest]}) -> {{Name, TypeSig}, LetFun} = infer_letfun(Env, Def), FunT = typesig_to_fun_t(TypeSig), NewE = bind_var({id, AsLF, Name}, FunT, Env), @@ -1624,8 +1628,8 @@ infer_expr(Env, {'if', Attrs, Cond, Then, Else}) -> infer_expr(Env, {switch, Attrs, Expr, Cases}) -> NewExpr = {typed, _, _, ExprType} = infer_expr(Env, Expr), SwitchType = fresh_uvar(Attrs), - NewCases = [infer_case(Env, As, Pattern, Guards, ExprType, Branches, SwitchType) - || {'case', As, Pattern, Guards, Branches} <- Cases], + NewCases = [infer_case(Env, As, Pattern, ExprType, GuardedBranches, SwitchType) + || {'case', As, Pattern, GuardedBranches} <- Cases], {typed, Attrs, {switch, Attrs, NewExpr, NewCases}, SwitchType}; infer_expr(Env, {record, Attrs, Fields}) -> RecordType = fresh_uvar(Attrs), @@ -1707,8 +1711,8 @@ infer_expr(Env, {lam, Attrs, Args, Body}) -> ArgTypes = [fresh_uvar(As) || {arg, As, _, _} <- Args], ArgPatterns = [{typed, As, Pat, check_type(Env, T)} || {arg, As, Pat, T} <- Args], ResultType = fresh_uvar(Attrs), - {'case', _, {typed, _, {tuple, _, NewArgPatterns}, _}, _, [NewBody]} = - infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, [], {tuple_t, Attrs, ArgTypes}, [Body], ResultType), + {'case', _, {typed, _, {tuple, _, NewArgPatterns}, _}, [{guarded, _, [], NewBody}]} = + infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, [{guarded, Attrs, [], 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, {letpat, Attrs, Id, Pattern}) -> @@ -1717,7 +1721,7 @@ infer_expr(Env, {letpat, Attrs, Id, Pattern}) -> 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, _, _, _, _, _}) -> +infer_expr(Env, Let = {letfun, Attrs, _, _, _, _}) -> type_error({missing_body_for_let, Attrs}), infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]}). @@ -1844,27 +1848,33 @@ infer_pattern(Env, Pattern) -> NewPattern = infer_expr(NewEnv, Pattern), {NewEnv#env{ in_pattern = Env#env.in_pattern }, NewPattern}. -infer_case(Env, Attrs, Pattern, Guards, ExprType, Branches, SwitchType) -> +infer_case(Env, Attrs, Pattern, ExprType, GuardedBranches, SwitchType) -> {NewEnv, NewPattern = {typed, _, _, PatType}} = infer_pattern(Env, Pattern), - NewGuards = lists:map(fun(Guard) -> check_expr(NewEnv#env{ in_guard = true }, Guard, {id, Attrs, "bool"}) end, Guards), - NewBranches = lists:map(fun(Branch) -> check_expr(NewEnv#env{ in_pattern = false }, Branch, SwitchType) end, Branches), + InferGuardedBranches = fun({guarded, Ann, Guards, Branch}) -> + NewGuards = lists:map(fun(Guard) -> + check_expr(NewEnv#env{ in_guard = true }, Guard, {id, Attrs, "bool"}) + end, Guards), + NewBranch = check_expr(NewEnv#env{ in_pattern = false }, Branch, SwitchType), + {guarded, Ann, NewGuards, NewBranch} + end, + NewGuardedBranches = lists:map(InferGuardedBranches, GuardedBranches), unify(Env, PatType, ExprType, {case_pat, Pattern, PatType, ExprType}), - {'case', Attrs, NewPattern, NewGuards, NewBranches}. + {'case', Attrs, NewPattern, NewGuardedBranches}. %% NewStmts = infer_block(Env, Attrs, Stmts, BlockType) infer_block(_Env, Attrs, [], BlockType) -> error({impossible, empty_block, Attrs, BlockType}); infer_block(Env, _, [E], BlockType) -> [check_expr(Env, E, BlockType)]; -infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _, _}|Rest], BlockType) -> +infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) -> {{Name, TypeSig}, LetFun} = infer_letfun(Env, Def), 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, 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), + {'case', _, NewPattern, [{guarded, _, [], {typed, _, {block, _, NewRest}, _}}]} = + infer_case(Env, Attrs, Pattern, PatType, [{guarded, Attrs, [], {block, Attrs, Rest}}], BlockType), [{letval, Attrs, NewPattern, NewE}|NewRest]; infer_block(Env, Attrs, [Using = {using, _, _, _, _} | Rest], BlockType) -> infer_block(check_usings(Env, Using), Attrs, Rest, BlockType); @@ -2433,8 +2443,8 @@ unfold_types(Env, {type_def, Ann, Name, Args, Def}, Options) -> {type_def, Ann, Name, Args, unfold_types_in_type(Env, Def, Options)}; unfold_types(Env, {fun_decl, Ann, Name, Type}, Options) -> {fun_decl, Ann, Name, unfold_types(Env, Type, Options)}; -unfold_types(Env, {letfun, Ann, Name, Args, Type, [], [Body]}, Options) -> - {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), [], [unfold_types(Env, Body, Options)]}; +unfold_types(Env, {letfun, Ann, Name, Args, Type, [{guarded, AnnG, [], Body}]}, Options) -> + {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), [{guarded, AnnG, [], unfold_types(Env, Body, Options)}]}; unfold_types(Env, T, Options) when is_tuple(T) -> list_to_tuple(unfold_types(Env, tuple_to_list(T), Options)); unfold_types(Env, [H|T], Options) -> diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index fa8ae0f..45358bc 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -385,7 +385,7 @@ decl_to_fcode(Env = #{context := {contract_def, _}}, {fun_decl, _, Id, _}) -> decl_to_fcode(Env, {fun_decl, _, _, _}) -> Env; decl_to_fcode(Env, {type_def, _Ann, Name, Args, Def}) -> typedef_to_fcode(Env, Name, Args, Def); -decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, Id = {id, _, Name}, Args, Ret, [], [Body]}) -> +decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, Id = {id, _, Name}, Args, Ret, [{guarded, _, [], Body}]}) -> Attrs = get_attributes(Ann), FName = lookup_fun(Env, qname(Env, Name)), FArgs = args_to_fcode(Env, Args), @@ -662,8 +662,8 @@ expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {ty Arg = fresh_name(), Env1 = bind_var(Env, Arg), 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, []}]}]})}, + [{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]}, + {'case', As, {id, As, "_"}, [{guarded, 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]}) -> @@ -673,7 +673,7 @@ expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Res ); 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, {list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}) -> expr_to_fcode(Env, Type, {block, As, [LF, {list_comp, As, Yield, Rest}]}); %% Conditionals @@ -888,15 +888,18 @@ alts_to_fcode(Env, Type, X, Alts, Switch) -> remove_guards(_Env, [], _Switch) -> []; -remove_guards(Env, [Alt = {'case', _, _, [], [_Expr]} | Rest], Switch) -> +remove_guards(Env, [Alt = {'case', _, _, [{guarded, _, [], _Expr}]} | Rest], Switch) -> [alt_to_fcode(Env, Alt) | remove_guards(Env, Rest, Switch)]; -remove_guards(Env, [{'case', AnnC, Pat, [Guard | Guards], [Body | Bodies]} | Rest], {switch, Ann, Expr, _}) -> +remove_guards(Env, [{'case', AnnC, Pat, [{guarded, AnnG, [Guard | Guards], Body} | GuardedBodies]} | Rest], {switch, Ann, Expr, _}) -> FPat = pat_to_fcode(Env, Pat), FGuard = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Guard), FBody = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Body), - R = case {Guards, Bodies} of - {[], []} -> Rest; - _ -> [{'case', AnnC, Pat, Guards, Bodies} | Rest] + R = case Guards of + [] -> case GuardedBodies of + [] -> Rest; + _ -> [{'case', AnnC, Pat, GuardedBodies} | Rest] + end; + _ -> [{'case', AnnC, Pat, [{guarded, AnnG, Guards, Body} | GuardedBodies]} | Rest] end, case R of [] -> @@ -1032,7 +1035,7 @@ next_split(Pats) -> end. -spec alt_to_fcode(env(), aeso_syntax:alt()) -> falt(). -alt_to_fcode(Env, {'case', _, Pat, _, [Expr]}) -> +alt_to_fcode(Env, {'case', _, Pat, [{guarded, _, [], Expr}]}) -> FPat = pat_to_fcode(Env, Pat), FExpr = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Expr), {'case', [FPat], FExpr}. @@ -1110,8 +1113,8 @@ decision_tree_to_fcode({'if', A, Then, Else}) -> 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]) -> + expr_to_fcode(Env, {switch, Ann, Expr, [{'case', Ann, Pat, [{guarded, Ann, [], {block, Ann, Stmts}}]}]}); +stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, [{guarded, _, [], Expr}]} | Stmts]) -> LamArgs = [ case Arg of {typed, Ann1, Id, T} -> {arg, Ann1, Id, T}; _ -> internal_error({bad_arg, Arg}) %% pattern matching has been desugared @@ -1706,7 +1709,7 @@ add_child_con(Env = #{child_con_env := CEnv}, Name, Fcode) -> -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env(). add_fun_env(Env = #{ context := {abstract_contract, _} }, _) -> Env; %% no functions from abstract contracts add_fun_env(Env = #{ fun_env := FunEnv }, Decls) -> - Entry = fun({letfun, Ann, {id, _, Name}, Args, _, _, _}) -> + Entry = fun({letfun, Ann, {id, _, Name}, Args, _, _}) -> [{qname(Env, Name), {make_fun_name(Env, Ann, Name), length(Args)}}]; ({fun_decl, Ann, {id, _, Name}, {fun_t, _, _, ArgTypes, _}}) -> [{qname(Env, Name), {make_fun_name(Env, Ann, Name), length(ArgTypes)}}]; diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index 1f06759..28ee133 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -474,10 +474,10 @@ error_missing_call_function() -> get_call_type([{Contract, _, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) -> case [ {lists:last(QFunName), FunType} - || {letfun, _, {id, _, ?CALL_NAME}, [], _Ret, [], - [{typed, _, + || {letfun, _, {id, _, ?CALL_NAME}, [], _Ret, + [{guarded, _, [], {typed, _, {app, _, - {typed, _, {qid, _, QFunName}, FunType}, _}, _}]} <- Defs ] of + {typed, _, {qid, _, QFunName}, FunType}, _}, _}}]} <- Defs ] of [Call] -> {ok, Call}; [] -> error_missing_call_function() end; @@ -487,7 +487,7 @@ get_call_type([_ | Contracts]) -> -dialyzer({nowarn_function, get_decode_type/2}). get_decode_type(FunName, [{Contract, Ann, _, Defs}]) when ?IS_CONTRACT_HEAD(Contract) -> - GetType = fun({letfun, _, {id, _, Name}, Args, Ret, _, _}) when Name == FunName -> [{Args, Ret}]; + GetType = fun({letfun, _, {id, _, Name}, Args, Ret, _}) when Name == FunName -> [{Args, Ret}]; ({fun_decl, _, {id, _, Name}, {fun_t, _, _, Args, Ret}}) when Name == FunName -> [{Args, Ret}]; (_) -> [] end, case lists:flatmap(GetType, Defs) of diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index e3e1bef..3d388c2 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -211,23 +211,16 @@ letdef() -> choice(valdef(), fundef()). valdef() -> ?RULE(pattern(), tok('='), body(), {letval, [], _1, _3}). -fundef() -> choice(unguarded_fundef(), guarded_fundef()). - -unguarded_fundef() -> +guarded_fundefs() -> choice( - [ ?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]}) + [ ?RULE(keyword('='), body(), [{guarded, _1, [], _2}]) + , maybe_block(?RULE(keyword('|'), comma_sep(expr()), tok('='), body(), {guarded, _1, _2, _4})) ]). -fundef_guard() -> - ?RULE(tok('|'), expr(), tok('='), body(), {_2, _4}). - -guarded_fundef() -> - GetGuards = fun(Xs) -> lists:map(fun({Guard, _}) -> Guard end, Xs) end, - GetBodies = fun(Xs) -> lists:map(fun({_, Body}) -> Body end, Xs) end, +fundef() -> choice( - [ ?RULE(id(), args(), maybe_block(fundef_guard()), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), GetGuards(_3), GetBodies(_3)}) - , ?RULE(id(), args(), tok(':'), type(), maybe_block(fundef_guard()), {letfun, get_ann(_1), _1, _2, _4, GetGuards(_5), GetBodies(_5)}) + [ ?RULE(id(), args(), guarded_fundefs(), {letfun, get_ann(_1), _1, _2, type_wildcard(get_ann(_1)), _3}) + , ?RULE(id(), args(), tok(':'), type(), guarded_fundefs(), {letfun, get_ann(_1), _1, _2, _4, _5}) ]). args() -> paren_list(pattern()). @@ -295,19 +288,14 @@ stmt() -> , {else, keyword(else), body()} ])). -branch() -> choice(unguarded_branch(), guarded_branch()). +branch() -> + ?RULE(pattern(), guarded_branches(), {'case', get_ann(lists:nth(1, _2)), _1, _2}). -unguarded_branch() -> - ?RULE(pattern(), keyword('=>'), body(), {'case', _2, _1, [], [_3]}). - -branch_guard() -> - ?RULE(tok('|'), expr(), keyword('=>'), body(), {_3, _2, _4}). - -guarded_branch() -> - GetFirstAnn = fun([{Ann, _, _} | _]) -> Ann end, - GetGuards = fun(Xs) -> lists:map(fun({_, Guard, _}) -> Guard end, Xs) end, - GetBodies = fun(Xs) -> lists:map(fun({_, _, Body}) -> Body end, Xs) end, - ?RULE(pattern(), maybe_block(branch_guard()), {'case', GetFirstAnn(_2), _1, GetGuards(_2), GetBodies(_2)}). +guarded_branches() -> + choice( + [ ?RULE(keyword('=>'), body(), [{guarded, _1, [], _2}]) + , maybe_block(?RULE(tok('|'), comma_sep(expr()), keyword('=>'), body(), {guarded, _3, _2, _4})) + ]). pattern() -> ?LET_P(E, expr(), parse_pattern(E)). diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index e3121bd..56330b3 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -173,7 +173,7 @@ decl({fun_decl, Ann, F, T}) -> false -> text("function") end, hsep(lists:map(Mod, Ann) ++ [Fun, typed(name(F), T)]); -decl(D = {letfun, Attrs, _, _, _, _, _}) -> +decl(D = {letfun, Attrs, _, _, _, _}) -> Mod = fun({Mod, true}) when Mod == private; Mod == stateful; Mod == payable -> text(atom_to_list(Mod)); (_) -> empty() end, @@ -212,7 +212,7 @@ name({typed, _, Name, _}) -> name(Name). -spec letdecl(string(), aeso_syntax:letbind()) -> doc(). letdecl(Let, {letval, _, P, E}) -> block_expr(0, hsep([text(Let), expr(P), text("=")]), E); -letdecl(Let, {letfun, _, F, Args, T, _, [E | _]}) -> +letdecl(Let, {letfun, _, F, Args, T, [{guarded, _, _Guards, E} | _]}) -> block_expr(0, hsep([text(Let), typed(beside(name(F), expr({tuple, [], Args})), T), text("=")]), E). -spec args([aeso_syntax:arg()]) -> doc(). @@ -482,7 +482,7 @@ elim1(Proj={proj, _, _}) -> beside(text("."), elim(Proj)); elim1(Get={map_get, _, _}) -> elim(Get); elim1(Get={map_get, _, _, _}) -> elim(Get). -alt({'case', _, Pat, _, [Body | _]}) -> +alt({'case', _, Pat, [{guarded, _, _Guards, Body} | _]}) -> block_expr(0, hsep(expr(Pat), text("=>")), Body). block_expr(_, Header, {block, _, Ss}) -> @@ -494,7 +494,7 @@ statements(Stmts) -> above([ statement(S) || S <- Stmts ]). statement(S = {letval, _, _, _}) -> letdecl("let", S); -statement(S = {letfun, _, _, _, _, _, _}) -> letdecl("let", S); +statement(S = {letfun, _, _, _, _, _}) -> letdecl("let", S); statement(E) -> expr(E). get_elifs(Expr) -> get_elifs(Expr, []). diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index a1085b2..1e01153 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -56,8 +56,11 @@ -type pragma() :: {compiler, '==' | '<' | '>' | '=<' | '>=', compiler_version()}. +-type guard() :: expr(). +-type guarded_expr() :: {guarded, ann(), [guard()], expr()}. + -type letval() :: {letval, ann(), pat(), expr()}. --type letfun() :: {letfun, ann(), id(), [pat()], type(), [expr()], [expr()]}. +-type letfun() :: {letfun, ann(), id(), [pat()], type(), [guarded_expr(),...]}. -type letpat() :: {letpat, ann(), id(), pat()}. -type fundecl() :: {fun_decl, ann(), id(), type()}. @@ -145,7 +148,7 @@ -type stmt() :: letbind() | expr(). --type alt() :: {'case', ann(), pat(), [expr()], [expr()]}. +-type alt() :: {'case', ann(), pat(), [guarded_expr(),...]}. -type lvalue() :: nonempty_list(elim()). diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index a1f4b13..e50f2d4 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_def, _, I, _, D} -> Plus(BindType(I), Decl(D)); {fun_decl, _, _, T} -> Type(T); {letval, _, P, E} -> Scoped(BindExpr(P), Expr(E)); - {letfun, _, F, Xs, T, Gs, Es} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ Gs ++ Es)]); + {letfun, _, F, Xs, T, GEs} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ GEs)]); {fun_clauses, _, _, T, Cs} -> Sum([Type(T) | [Decl(C) || C <- Cs]]); %% typedef() {alias_t, T} -> Type(T); @@ -78,7 +78,7 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) -> Plus(Expr(E), 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]} -> + {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)); {record, _, Fs} -> Expr(Fs); @@ -89,13 +89,14 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) -> {map_get, _, A, B, C} -> Expr([A, B, C]); {block, _, Ss} -> Expr(Ss); {letpat, _, X, P} -> Plus(BindExpr(X), Expr(P)); + {guarded, _, Gs, E} -> Expr([E | Gs]); %% field() {field, _, LV, E} -> Expr([LV, E]); {field, _, LV, _, E} -> Expr([LV, E]); %% arg() {arg, _, Y, T} -> Plus(BindExpr(Y), Type(T)); %% alt() - {'case', _, P, Gs, Es} -> Scoped(BindExpr(P), Expr(Gs ++ Es)); + {'case', _, P, GEs} -> Scoped(BindExpr(P), Expr(GEs)); %% elim() {proj, _, _} -> Zero; {map_get, _, E} -> Expr(E); diff --git a/test/aeso_calldata_tests.erl b/test/aeso_calldata_tests.erl index 1c1878c..a01fb7f 100644 --- a/test/aeso_calldata_tests.erl +++ b/test/aeso_calldata_tests.erl @@ -47,7 +47,7 @@ calldata_aci_test_() -> end} || {ContractName, Fun, Args} <- compilable_contracts()]. parse_args(Fun, Args) -> - [{contract_main, _, _, [{letfun, _, _, _, _, _, [{app, _, _, AST}]}]}] = + [{contract_main, _, _, [{letfun, _, _, _, _, [{guarded, _, [], {app, _, _, AST}}]}]}] = aeso_parser:string("main contract Temp = function foo() = " ++ Fun ++ "(" ++ string:join(Args, ", ") ++ ")"), strip_ann(AST). diff --git a/test/aeso_parser_tests.erl b/test/aeso_parser_tests.erl index 4d16aea..6c577c8 100644 --- a/test/aeso_parser_tests.erl +++ b/test/aeso_parser_tests.erl @@ -16,8 +16,8 @@ simple_contracts_test_() -> " function id(x) = x\n", ?assertMatch( [{contract_main, _, {con, _, "Identity"}, - [{letfun, _, {id, _, "id"}, [{id, _, "x"}], {id, _, "_"}, [], - [{id, _, "x"}]}]}], parse_string(Text)), + [{letfun, _, {id, _, "id"}, [{id, _, "x"}], {id, _, "_"}, + [{guarded, _, [], {id, _, "x"}}]}]}], parse_string(Text)), ok end}, {"Operator precedence test.",