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

Implement multiple exprs in the same guard

Browse Source
This commit is contained in:
Gaith Hallak 2021-10-06 13:17:33 +03:00
parent c6acb94921
commit c30201cdba
10 changed files with 108 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/aeso_aci.erl
View File

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

100
src/aeso_ast_infer_types.erl
View File

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

29
src/aeso_ast_to_fcode.erl
View File

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

8
src/aeso_compiler.erl
View File

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

38
src/aeso_parser.erl
View File

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

8
src/aeso_pretty.erl
View File

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

7
src/aeso_syntax.erl
View File

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

7
src/aeso_syntax_utils.erl
View File

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

2
test/aeso_calldata_tests.erl
View File

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

4
test/aeso_parser_tests.erl
View File

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