diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 7cf8832..dd9f657 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}], "_"}, 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(), @@ -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,6 +1009,15 @@ infer_letrec(Env, Defs) -> [print_typesig(S) || S <- TypeSigs], {TypeSigs, NewDefs}. +infer_letfun(Env, {fun_clauses, Ann, Fun = {id, _, Name}, Type, Clauses}) -> + Type1 = check_type(Env, Type), + {NameSigs, Clauses1} = lists:unzip([ infer_letfun(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(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, Body}) -> Env = Env0#env{ stateful = aeso_syntax:get_ann(stateful, Attrib, false), current_function = Fun }, @@ -994,6 +1032,17 @@ infer_letfun(Env0, {letfun, Attrib, Fun = {id, NameAttrib, Name}, Args, What, Bo {{Name, TypeSig}, {letfun, Attrib, {id, NameAttrib, Name}, NewArgs, ResultType, NewBody}}. +desugar_clauses(Ann, Fun, {type_sig, _, _, _, ArgTypes, RetType}, Clauses) -> + NoAnn = [{origin, system}], + Args = [ {arg, NoAnn, {id, NoAnn, "x#" ++ integer_to_list(I)}, Type} + || {I, Type} <- indexed(1, ArgTypes) ], + ArgTuple = {tuple, NoAnn, [X || {arg, _, X, _} <- Args]}, + ArgType = {tuple_t, NoAnn, ArgTypes}, + {letfun, Ann, Fun, Args, RetType, + {switch, NoAnn, {typed, NoAnn, ArgTuple, ArgType}, + [ {'case', AnnC, {tuple, AnnC, [ {typed, AnnA, Pat, PatT} || {arg, AnnA, Pat, PatT} <- ArgsC ]}, Body} + || {letfun, AnnC, _, ArgsC, _, Body} <- Clauses ]}}. + check_unique_arg_names(Fun, Args) -> Name = fun({arg, _, {id, _, X}, _}) -> X end, Names = lists:map(Name, Args), @@ -2751,3 +2800,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_parser.erl b/src/aeso_parser.erl index c5f90cb..0ffce9a 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,8 +176,8 @@ 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(), _4}) + , ?RULE(id(), args(), tok(':'), type(), tok('='), body(), {letfun, get_ann(_1), _1, _2, _4, _6}) ]). args() -> paren_list(arg()). diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 1979925..f5eb688 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}) -> diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index 3c7ce56..514781c 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()]. diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index b5618e5..a7b5988 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(Cs)]); %% typedef() {alias_t, T} -> Type(T); {record_t, Fs} -> Type(Fs);