From 5465b74ac9279a9bc112cfa24b6d39455835e2dd Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 30 Aug 2019 16:39:51 +0200 Subject: [PATCH 01/27] Allow specifying store register in FATE backend --- src/aeso_fcode_to_fate.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 49b199f..5aeb195 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -41,8 +41,8 @@ -define(TODO(What), error({todo, ?FILE, ?LINE, ?FUNCTION_NAME, What})). -define(i(X), {immediate, X}). --define(a, {stack, 0}). --define(s, {store, 1}). +-define(a, {stack, 0}). +-define(s(N), {var, -N}). -define(void, {var, 9999}). -record(env, { contract, vars = [], locals = [], current_function, tailpos = true }). @@ -421,9 +421,9 @@ call_to_scode(Env, CallCode, Args) -> CallCode]. builtin_to_scode(_Env, get_state, []) -> - [push(?s)]; + [push(?s(1))]; builtin_to_scode(Env, set_state, [_] = Args) -> - call_to_scode(Env, [{'STORE', ?s, ?a}, + call_to_scode(Env, [aeb_fate_ops:store(?s(1), ?a), tuple(0)], Args); builtin_to_scode(Env, chain_event, Args) -> call_to_scode(Env, [erlang:apply(aeb_fate_ops, log, lists:duplicate(length(Args), ?a)), From 499e2f8200519bbe12096fd80d789c7e8f86c511 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 30 Aug 2019 16:40:17 +0200 Subject: [PATCH 02/27] Handle records and type aliases correctly in fcode --- src/aeso_ast_to_fcode.erl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 35d5d06..0cf9968 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -304,14 +304,15 @@ typedef_to_fcode(Env, Id = {id, _, Name}, Xs, Def) -> FDef = fun(Args) when length(Args) == length(Xs) -> Sub = maps:from_list(lists:zip([X || {tvar, _, X} <- Xs], Args)), case Def of - {record_t, Fields} -> {todo, Xs, Args, record_t, Fields}; + {record_t, Fields} -> + {tuple, [type_to_fcode(Env, Sub, T) || {field_t, _, _, T} <- Fields]}; {variant_t, Cons} -> FCons = [ begin {constr_t, _, _, Ts} = Con, [type_to_fcode(Env, Sub, T) || T <- Ts] end || Con <- Cons ], {variant, FCons}; - {alias_t, Type} -> {todo, Xs, Args, alias_t, Type} + {alias_t, Type} -> type_to_fcode(Env, Sub, Type) end; (Args) -> internal_error({type_arity_mismatch, Name, length(Args), length(Xs)}) end, From e645a8d034c0d6c34cd71b217b2a9b7dc25cae74 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 2 Sep 2019 11:17:13 +0200 Subject: [PATCH 03/27] Optimize before lambda lifting (lambdas are either in dead code or not dead, so dead code elimination won't be affected) --- src/aeso_ast_to_fcode.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 0cf9968..7e49f8d 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -151,10 +151,10 @@ ast_to_fcode(Code, Options) -> Verbose = lists:member(pp_fcode, Options), FCode1 = to_fcode(init_env(Options), Code), [io:format("-- Before lambda lifting --\n~s\n\n", [format_fcode(FCode1)]) || Verbose], - FCode2 = lambda_lift(FCode1), - [ io:format("-- After lambda lifting --\n~s\n\n", [format_fcode(FCode2)]) || Verbose, FCode2 /= FCode1 ], - FCode3 = optimize_fcode(FCode2), - [ io:format("-- After optimization --\n~s\n\n", [format_fcode(FCode3)]) || Verbose, FCode3 /= FCode2 ], + FCode2 = optimize_fcode(FCode1), + [ io:format("-- After optimization --\n~s\n\n", [format_fcode(FCode2)]) || Verbose, FCode2 /= FCode1 ], + FCode3 = lambda_lift(FCode2), + [ io:format("-- After lambda lifting --\n~s\n\n", [format_fcode(FCode3)]) || Verbose, FCode3 /= FCode2 ], FCode3. %% -- Environment ------------------------------------------------------------ From 99ecda4b7bfa0fca09edbcc1557a0b2db35911e3 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 23 Sep 2019 12:17:22 +0200 Subject: [PATCH 04/27] Fix warnings in test suites --- test/aeso_aci_tests.erl | 10 +++++----- test/aeso_parser_tests.erl | 5 +++-- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/test/aeso_aci_tests.erl b/test/aeso_aci_tests.erl index ec6737c..d5010e3 100644 --- a/test/aeso_aci_tests.erl +++ b/test/aeso_aci_tests.erl @@ -106,7 +106,7 @@ aci_test_contract(Name) -> ok. check_stub(Stub, Options) -> - case aeso_parser:string(binary_to_list(Stub), Options) of + try aeso_parser:string(binary_to_list(Stub), Options) of Ast -> try %% io:format("AST: ~120p\n", [Ast]), @@ -117,9 +117,9 @@ check_stub(Stub, Options) -> _:R -> io:format("Error: ~p\n", [R]), error(R) - end; - {error, E} -> - io:format("Error: ~p\n", [E]), - error({parse_error, E}) + end + catch throw:{error, Errs} -> + _ = [ io:format("~s\n", [aeso_errors:pp(E)]) || E <- Errs ], + error({parse_errors, Errs}) end. diff --git a/test/aeso_parser_tests.erl b/test/aeso_parser_tests.erl index 6b2fc5c..ab585f3 100644 --- a/test/aeso_parser_tests.erl +++ b/test/aeso_parser_tests.erl @@ -4,6 +4,8 @@ -include_lib("eunit/include/eunit.hrl"). +id(X) -> X. + simple_contracts_test_() -> {foreach, fun() -> ok end, @@ -30,7 +32,7 @@ simple_contracts_test_() -> end, Parse = fun(S) -> try remove_line_numbers(parse_expr(S)) - catch _:_ -> ?assertMatch(ok, {parse_fail, S}) end + catch _:_ -> ?assertMatch(ok, id({parse_fail, S})) end end, CheckParens = fun(Expr) -> ?assertEqual(Parse(NoPar(Expr)), Parse(Par(Expr))) @@ -38,7 +40,6 @@ simple_contracts_test_() -> LeftAssoc = fun(Op) -> CheckParens({{a, Op, b}, Op, c}) end, RightAssoc = fun(Op) -> CheckParens({a, Op, {b, Op, c}}) end, NonAssoc = fun(Op) -> - OpAtom = list_to_atom(Op), ?assertThrow({error, [_]}, parse_expr(NoPar({a, Op, {b, Op, c}}))) end, Stronger = fun(Op1, Op2) -> From d0fdd06d66fe608a9ae600930d817713d7f12650 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 23 Sep 2019 14:51:15 +0200 Subject: [PATCH 05/27] Change get_state and set_state fcode primitives to take a register --- src/aeso_ast_to_fcode.erl | 24 ++++++++++++++++++++++-- src/aeso_fcode_to_fate.erl | 11 ++++++----- 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 7e49f8d..52fdf4d 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -24,6 +24,8 @@ -type var_name() :: string(). -type sophia_name() :: [string()]. +-type state_reg() :: pos_integer(). + -type builtin() :: atom(). -type op() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' | @@ -61,6 +63,8 @@ | {funcall, fexpr(), [fexpr()]} %% Call to unknown function | {closure, fun_name(), fexpr()} | {switch, fsplit()} + | {set_state, state_reg(), fexpr()} + | {get_state, state_reg()} %% The following (unapplied top-level functions/builtins and %% lambdas) are generated by the fcode compiler, but translated %% to closures by the lambda lifter. @@ -910,6 +914,10 @@ op_builtins() -> crypto_ecverify_secp256k1, crypto_ecrecover_secp256k1 ]. +builtin_to_fcode(set_state, [Val]) -> + {set_state, 1, Val}; +builtin_to_fcode(get_state, []) -> + {get_state, 1}; builtin_to_fcode(require, [Cond, Msg]) -> make_if(Cond, {tuple, []}, {builtin, abort, [Msg]}); builtin_to_fcode(chain_event, [Event]) -> @@ -942,7 +950,7 @@ add_init_function(Env, Main, StateType, Funs0) -> InitName = {entrypoint, <<"init">>}, InitFun = #{ body := InitBody} = maps:get(InitName, Funs), Funs#{ InitName => InitFun#{ return => {tuple, []}, - body => {builtin, set_state, [InitBody]} } } + body => builtin_to_fcode(set_state, [InitBody]) } } end. add_default_init_function(_Env, Main, StateType, Funs) -> @@ -1072,6 +1080,8 @@ lambda_lift_expr(Expr) -> {op, Op, As} -> {op, Op, lambda_lift_exprs(As)}; {'let', X, A, B} -> {'let', X, lambda_lift_expr(A), lambda_lift_expr(B)}; {funcall, A, Bs} -> {funcall, lambda_lift_expr(A), lambda_lift_exprs(Bs)}; + {set_state, R, A} -> {set_state, R, lambda_lift_expr(A)}; + {get_state, _} -> Expr; {switch, S} -> {switch, lambda_lift_expr(S)}; {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Alts)}; {nosplit, A} -> {nosplit, lambda_lift_expr(A)}; @@ -1236,7 +1246,7 @@ resolve_var(Env, Q) -> resolve_fun(Env, Q). resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) -> case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of {not_found, not_found} -> internal_error({unbound_variable, Q}); - {_, {B, none}} -> {builtin, B, []}; + {_, {B, none}} -> builtin_to_fcode(B, []); {_, {B, Ar}} -> {builtin_u, B, Ar}; {{Fun, Ar}, _} -> {def_u, Fun, Ar} end. @@ -1301,6 +1311,8 @@ free_vars(Expr) -> {op, _, As} -> free_vars(As); {'let', X, A, B} -> free_vars([A, {lam, [X], B}]); {funcall, A, Bs} -> free_vars([A | Bs]); + {set_state, _, A} -> free_vars(A); + {get_state, _} -> []; {lam, Xs, B} -> free_vars(B) -- lists:sort(Xs); {closure, _, A} -> free_vars(A); {switch, A} -> free_vars(A); @@ -1330,6 +1342,8 @@ used_defs(Expr) -> {op, _, As} -> used_defs(As); {'let', _, A, B} -> used_defs([A, B]); {funcall, A, Bs} -> used_defs([A | Bs]); + {set_state, _, A} -> used_defs(A); + {get_state, _} -> []; {lam, _, B} -> used_defs(B); {closure, F, A} -> lists:umerge([F], used_defs(A)); {switch, A} -> used_defs(A); @@ -1372,6 +1386,8 @@ rename(Ren, Expr) -> {set_proj, R, I, E} -> {set_proj, rename(Ren, R), I, rename(Ren, E)}; {op, Op, Es} -> {op, Op, [rename(Ren, E) || E <- Es]}; {funcall, Fun, Es} -> {funcall, rename(Ren, Fun), [rename(Ren, E) || E <- Es]}; + {set_state, R, E} -> {set_state, R, rename(Ren, E)}; + {get_state, _} -> Expr; {closure, F, Env} -> {closure, F, rename(Ren, Env)}; {switch, Split} -> {switch, rename_split(Ren, Split)}; {lam, Xs, B} -> @@ -1595,6 +1611,10 @@ pp_fexpr({remote, ArgsT, RetT, Ct, Fun, As}) -> pp_call(pp_parens(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun), pp_text(" : "), pp_ftype({function, ArgsT, RetT})])), As); pp_fexpr({funcall, Fun, As}) -> pp_call(pp_fexpr(Fun), As); +pp_fexpr({set_state, R, A}) -> + pp_call(pp_text("set_state"), [{lit, {int, R}}, A]); +pp_fexpr({get_state, R}) -> + pp_call(pp_text("get_state"), [{lit, {int, R}}]); pp_fexpr({switch, Split}) -> pp_split(Split). pp_call(Fun, Args) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 5aeb195..35f1807 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -298,6 +298,12 @@ to_scode(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value | Args]}) -> call_to_scode(Env, Call, [Ct, Value, Gas | Args]) end; +to_scode(_Env, {get_state, Reg}) -> + [push(?s(Reg))]; +to_scode(Env, {set_state, Reg, Val}) -> + call_to_scode(Env, [aeb_fate_ops:store(?s(Reg), ?a), + tuple(0)], [Val]); + to_scode(Env, {closure, Fun, FVs}) -> to_scode(Env, {tuple, [{lit, {string, make_function_id(Fun)}}, FVs]}); @@ -420,11 +426,6 @@ call_to_scode(Env, CallCode, Args) -> [[to_scode(notail(Env), A) || A <- lists:reverse(Args)], CallCode]. -builtin_to_scode(_Env, get_state, []) -> - [push(?s(1))]; -builtin_to_scode(Env, set_state, [_] = Args) -> - call_to_scode(Env, [aeb_fate_ops:store(?s(1), ?a), - tuple(0)], Args); builtin_to_scode(Env, chain_event, Args) -> call_to_scode(Env, [erlang:apply(aeb_fate_ops, log, lists:duplicate(length(Args), ?a)), tuple(0)], Args); From a8119f12193905f10ce038055627499af26d05dd Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 23 Sep 2019 15:56:40 +0200 Subject: [PATCH 06/27] Track state layout ... but only default layout still. --- src/aeso_ast_to_fcode.erl | 121 +++++++++++++++++++++----------------- 1 file changed, 67 insertions(+), 54 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 52fdf4d..7e56839 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -134,15 +134,18 @@ | {namespace, string()} | {abstract_contract, string()}. --type env() :: #{ type_env := type_env(), - fun_env := fun_env(), - con_env := con_env(), - event_type => aeso_syntax:typedef(), - builtins := builtins(), - options := [option()], - context => context(), - vars => [var_name()], - functions := #{ fun_name() => fun_def() } }. +-type state_layout() :: default_layout. + +-type env() :: #{ type_env := type_env(), + fun_env := fun_env(), + con_env := con_env(), + event_type => aeso_syntax:typedef(), + builtins := builtins(), + options := [option()], + state_layout => state_layout(), + context => context(), + vars => [var_name()], + functions := #{ fun_name() => fun_def() } }. -define(HASH_BYTES, 32). @@ -210,6 +213,8 @@ builtins() -> || {NS, Funs} <- Scopes, {Fun, Arity} <- Funs ]). +state_layout(Env) -> maps:get(state_layout, Env, undefined). + -define(type(T), fun([]) -> T end). -define(type(X, T), fun([X]) -> T end). -define(type(X, Y, T), fun([X, Y]) -> T end). @@ -246,11 +251,13 @@ to_fcode(Env, [{contract, Attrs, MainCon = {con, _, Main}, Decls}]) -> [Main, "Chain", "event"] => {chain_event, 1}} }, #{ functions := Funs } = Env1 = decls_to_fcode(MainEnv, Decls), - StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}), - EventType = lookup_type(Env1, [Main, "event"], [], none), - Payable = proplists:get_value(payable, Attrs, false), + StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}), + EventType = lookup_type(Env1, [Main, "event"], [], none), + StateLayout = maps:get(state_layout, Env1, default_layout), + Payable = proplists:get_value(payable, Attrs, false), #{ contract_name => Main, state_type => StateType, + state_layout => StateLayout, event_type => EventType, payable => Payable, functions => add_init_function(Env1, MainCon, StateType, @@ -338,7 +345,13 @@ typedef_to_fcode(Env, Id = {id, _, Name}, Xs, Def) -> "event" -> Env1#{ event_type => Def }; _ -> Env1 end, - bind_type(Env2, Q, FDef). + Env3 = compute_state_layout(Env2, Name, FDef), + bind_type(Env3, Q, FDef). + +compute_state_layout(Env = #{ context := {main_contract, _} }, "state", _Type) -> + Layout = default_layout, + Env#{ state_layout => Layout }; +compute_state_layout(Env, _, _) -> Env. check_state_and_event_types(#{ context := {main_contract, _} }, Id, [_ | _]) -> case Id of @@ -561,8 +574,8 @@ expr_to_fcode(Env, _Type, {app, _, Fun = {typed, _, _, {fun_t, _, NamedArgsT, _, Args1 = get_named_args(NamedArgsT, Args), FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1], case expr_to_fcode(Env, Fun) of - {builtin_u, B, _Ar, TypeArgs} -> builtin_to_fcode(B, FArgs ++ TypeArgs); - {builtin_u, B, _Ar} -> builtin_to_fcode(B, FArgs); + {builtin_u, B, _Ar, TypeArgs} -> builtin_to_fcode(state_layout(Env), B, FArgs ++ TypeArgs); + {builtin_u, B, _Ar} -> builtin_to_fcode(state_layout(Env), B, FArgs); {def_u, F, _Ar} -> {def, F, FArgs}; {remote_u, ArgsT, RetT, Ct, RFun} -> {remote, ArgsT, RetT, Ct, RFun, FArgs}; FFun -> @@ -914,27 +927,27 @@ op_builtins() -> crypto_ecverify_secp256k1, crypto_ecrecover_secp256k1 ]. -builtin_to_fcode(set_state, [Val]) -> +builtin_to_fcode(default_layout, set_state, [Val]) -> {set_state, 1, Val}; -builtin_to_fcode(get_state, []) -> +builtin_to_fcode(default_layout, get_state, []) -> {get_state, 1}; -builtin_to_fcode(require, [Cond, Msg]) -> +builtin_to_fcode(_Layout, require, [Cond, Msg]) -> make_if(Cond, {tuple, []}, {builtin, abort, [Msg]}); -builtin_to_fcode(chain_event, [Event]) -> +builtin_to_fcode(_Layout, chain_event, [Event]) -> {def, event, [Event]}; -builtin_to_fcode(map_delete, [Key, Map]) -> +builtin_to_fcode(_Layout, map_delete, [Key, Map]) -> {op, map_delete, [Map, Key]}; -builtin_to_fcode(map_member, [Key, Map]) -> +builtin_to_fcode(_Layout, map_member, [Key, Map]) -> {op, map_member, [Map, Key]}; -builtin_to_fcode(map_lookup, [Key0, Map0]) -> +builtin_to_fcode(_Layout, map_lookup, [Key0, Map0]) -> ?make_let(Key, Key0, ?make_let(Map, Map0, make_if({op, map_member, [Map, Key]}, {con, [0, 1], 1, [{op, map_get, [Map, Key]}]}, {con, [0, 1], 0, []}))); -builtin_to_fcode(map_lookup_default, [Key, Map, Def]) -> +builtin_to_fcode(_Layout, map_lookup_default, [Key, Map, Def]) -> {op, map_get_d, [Map, Key, Def]}; -builtin_to_fcode(Builtin, Args) -> +builtin_to_fcode(_Layout, Builtin, Args) -> case lists:member(Builtin, op_builtins()) of true -> {op, Builtin, Args}; false -> {builtin, Builtin, Args} @@ -950,7 +963,7 @@ add_init_function(Env, Main, StateType, Funs0) -> InitName = {entrypoint, <<"init">>}, InitFun = #{ body := InitBody} = maps:get(InitName, Funs), Funs#{ InitName => InitFun#{ return => {tuple, []}, - body => builtin_to_fcode(set_state, [InitBody]) } } + body => builtin_to_fcode(state_layout(Env), set_state, [InitBody]) } } end. add_default_init_function(_Env, Main, StateType, Funs) -> @@ -1001,10 +1014,10 @@ event_function(_Env = #{event_type := {variant_t, EventCons}}, EventType = {vari %% the top-level and replace it with a closure. -spec lambda_lift(fcode()) -> fcode(). -lambda_lift(FCode = #{ functions := Funs }) -> +lambda_lift(FCode = #{ functions := Funs, state_layout := StateLayout }) -> init_fresh_names(), init_lambda_funs(), - Funs1 = maps:map(fun lambda_lift_fun/2, Funs), + Funs1 = maps:map(fun(_, Body) -> lambda_lift_fun(StateLayout, Body) end, Funs), NewFuns = get_lambda_funs(), clear_fresh_names(), FCode#{ functions := maps:merge(Funs1, NewFuns) }. @@ -1019,8 +1032,8 @@ add_lambda_fun(Def) -> put(?lambda_key, Funs#{ Name => Def }), Name. -lambda_lift_fun(_, Def = #{ body := Body }) -> - Def#{ body := lambda_lift_expr(Body) }. +lambda_lift_fun(Layout, Def = #{ body := Body }) -> + Def#{ body := lambda_lift_expr(Layout, Body) }. lifted_fun([Z], Xs, Body) -> #{ attrs => [private], @@ -1041,10 +1054,10 @@ make_closure(FVs, Xs, Body) -> Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end, {closure, Fun, Tup([{var, Y} || Y <- FVs])}. -lambda_lift_expr({lam, Xs, Body}) -> +lambda_lift_expr(Layout, {lam, Xs, Body}) -> FVs = free_vars({lam, Xs, Body}), - make_closure(FVs, Xs, lambda_lift_expr(Body)); -lambda_lift_expr(UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u -> + make_closure(FVs, Xs, lambda_lift_expr(Layout, Body)); +lambda_lift_expr(Layout, UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u -> [Tag, F, Ar | _] = tuple_to_list(UExpr), ExtraArgs = case UExpr of {builtin_u, _, _, TypeArgs} -> TypeArgs; @@ -1053,42 +1066,42 @@ lambda_lift_expr(UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == bu Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ], Args = [{var, X} || X <- Xs] ++ ExtraArgs, Body = case Tag of - builtin_u -> builtin_to_fcode(F, Args); + builtin_u -> builtin_to_fcode(Layout, F, Args); def_u -> {def, F, Args} end, make_closure([], Xs, Body); -lambda_lift_expr({remote_u, ArgsT, RetT, Ct, F}) -> +lambda_lift_expr(Layout, {remote_u, ArgsT, RetT, Ct, F}) -> FVs = free_vars(Ct), - Ct1 = lambda_lift_expr(Ct), + Ct1 = lambda_lift_expr(Layout, Ct), GasAndValueArgs = 2, Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, length(ArgsT) + GasAndValueArgs) ], Args = [{var, X} || X <- Xs], make_closure(FVs, Xs, {remote, ArgsT, RetT, Ct1, F, Args}); -lambda_lift_expr(Expr) -> +lambda_lift_expr(Layout, Expr) -> case Expr of {lit, _} -> Expr; nil -> Expr; {var, _} -> Expr; {closure, _, _} -> Expr; - {def, D, As} -> {def, D, lambda_lift_exprs(As)}; - {builtin, B, As} -> {builtin, B, lambda_lift_exprs(As)}; - {remote, ArgsT, RetT, Ct, F, As} -> {remote, ArgsT, RetT, lambda_lift_expr(Ct), F, lambda_lift_exprs(As)}; - {con, Ar, C, As} -> {con, Ar, C, lambda_lift_exprs(As)}; - {tuple, As} -> {tuple, lambda_lift_exprs(As)}; - {proj, A, I} -> {proj, lambda_lift_expr(A), I}; - {set_proj, A, I, B} -> {set_proj, lambda_lift_expr(A), I, lambda_lift_expr(B)}; - {op, Op, As} -> {op, Op, lambda_lift_exprs(As)}; - {'let', X, A, B} -> {'let', X, lambda_lift_expr(A), lambda_lift_expr(B)}; - {funcall, A, Bs} -> {funcall, lambda_lift_expr(A), lambda_lift_exprs(Bs)}; - {set_state, R, A} -> {set_state, R, lambda_lift_expr(A)}; + {def, D, As} -> {def, D, lambda_lift_exprs(Layout, As)}; + {builtin, B, As} -> {builtin, B, lambda_lift_exprs(Layout, As)}; + {remote, ArgsT, RetT, Ct, F, As} -> {remote, ArgsT, RetT, lambda_lift_expr(Layout, Ct), F, lambda_lift_exprs(Layout, As)}; + {con, Ar, C, As} -> {con, Ar, C, lambda_lift_exprs(Layout, As)}; + {tuple, As} -> {tuple, lambda_lift_exprs(Layout, As)}; + {proj, A, I} -> {proj, lambda_lift_expr(Layout, A), I}; + {set_proj, A, I, B} -> {set_proj, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)}; + {op, Op, As} -> {op, Op, lambda_lift_exprs(Layout, As)}; + {'let', X, A, B} -> {'let', X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)}; + {funcall, A, Bs} -> {funcall, lambda_lift_expr(Layout, A), lambda_lift_exprs(Layout, Bs)}; + {set_state, R, A} -> {set_state, R, lambda_lift_expr(Layout, A)}; {get_state, _} -> Expr; - {switch, S} -> {switch, lambda_lift_expr(S)}; - {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Alts)}; - {nosplit, A} -> {nosplit, lambda_lift_expr(A)}; - {'case', P, S} -> {'case', P, lambda_lift_expr(S)} + {switch, S} -> {switch, lambda_lift_expr(Layout, S)}; + {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Layout, Alts)}; + {nosplit, A} -> {nosplit, lambda_lift_expr(Layout, A)}; + {'case', P, S} -> {'case', P, lambda_lift_expr(Layout, S)} end. -lambda_lift_exprs(As) -> [lambda_lift_expr(A) || A <- As]. +lambda_lift_exprs(Layout, As) -> [lambda_lift_expr(Layout, A) || A <- As]. %% -- Optimisations ---------------------------------------------------------- @@ -1243,10 +1256,10 @@ resolve_var(#{ vars := Vars } = Env, [X]) -> end; resolve_var(Env, Q) -> resolve_fun(Env, Q). -resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) -> +resolve_fun(#{ fun_env := Funs, builtins := Builtin } = Env, Q) -> case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of {not_found, not_found} -> internal_error({unbound_variable, Q}); - {_, {B, none}} -> builtin_to_fcode(B, []); + {_, {B, none}} -> builtin_to_fcode(state_layout(Env), B, []); {_, {B, Ar}} -> {builtin_u, B, Ar}; {{Fun, Ar}, _} -> {def_u, Fun, Ar} end. From 8d7c6372418641952a6d95d56c67d0928f2331d2 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 23 Sep 2019 16:49:48 +0200 Subject: [PATCH 07/27] Don't confuse variables and store registers in fate asm generation --- src/aeso_fcode_to_fate.erl | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 35f1807..7968b8c 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -42,7 +42,7 @@ -define(i(X), {immediate, X}). -define(a, {stack, 0}). --define(s(N), {var, -N}). +-define(s(N), {store, N}). -define(void, {var, 9999}). -record(env, { contract, vars = [], locals = [], current_function, tailpos = true }). @@ -646,11 +646,11 @@ pp_op(loop) -> "LOOP"; pp_op(I) -> aeb_fate_pp:format_op(I, #{}). -pp_arg(?i(I)) -> io_lib:format("~w", [I]); -pp_arg({arg, N}) -> io_lib:format("arg~p", [N]); -pp_arg({store, N}) -> io_lib:format("store~p", [N]); -pp_arg({var, N}) -> io_lib:format("var~p", [N]); -pp_arg(?a) -> "a". +pp_arg(?i(I)) -> io_lib:format("~w", [I]); +pp_arg({arg, N}) -> io_lib:format("arg~p", [N]); +pp_arg(?s(N)) -> io_lib:format("store~p", [-N]); +pp_arg({var, N}) -> io_lib:format("var~p", [N]); +pp_arg(?a) -> "a". %% -- Analysis -- @@ -1369,7 +1369,7 @@ desugar_args(I) when is_tuple(I) -> list_to_tuple([Op | lists:map(fun desugar_arg/1, Args)]); desugar_args(I) -> I. -desugar_arg({store, N}) -> {var, -N}; +desugar_arg(?s(N)) -> {var, -N}; desugar_arg(A) -> A. %% -- Phase III -------------------------------------------------------------- From 6c3932b10ca1c5ece2b9fa18500917a806a6936f Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 23 Sep 2019 21:57:08 +0200 Subject: [PATCH 08/27] Flattened state layout ... with necessary optimizations. --- src/aeso_ast_to_fcode.erl | 288 +++++++++++++++++++++++++++++++++++--- 1 file changed, 267 insertions(+), 21 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 7e56839..8fefc60 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -134,7 +134,7 @@ | {namespace, string()} | {abstract_contract, string()}. --type state_layout() :: default_layout. +-type state_layout() :: {tuple, [state_layout()]} | {reg, state_reg()}. -type env() :: #{ type_env := type_env(), fun_env := fun_env(), @@ -156,12 +156,14 @@ -spec ast_to_fcode(aeso_syntax:ast(), [option()]) -> fcode(). ast_to_fcode(Code, Options) -> Verbose = lists:member(pp_fcode, Options), + init_fresh_names(), FCode1 = to_fcode(init_env(Options), Code), [io:format("-- Before lambda lifting --\n~s\n\n", [format_fcode(FCode1)]) || Verbose], FCode2 = optimize_fcode(FCode1), [ io:format("-- After optimization --\n~s\n\n", [format_fcode(FCode2)]) || Verbose, FCode2 /= FCode1 ], FCode3 = lambda_lift(FCode2), [ io:format("-- After lambda lifting --\n~s\n\n", [format_fcode(FCode3)]) || Verbose, FCode3 /= FCode2 ], + clear_fresh_names(), FCode3. %% -- Environment ------------------------------------------------------------ @@ -213,7 +215,7 @@ builtins() -> || {NS, Funs} <- Scopes, {Fun, Arity} <- Funs ]). -state_layout(Env) -> maps:get(state_layout, Env, undefined). +state_layout(Env) -> maps:get(state_layout, Env, {reg, 1}). -define(type(T), fun([]) -> T end). -define(type(X, T), fun([X]) -> T end). @@ -230,7 +232,7 @@ init_type_env() -> ["hash"] => ?type(hash), ["signature"] => ?type(signature), ["oracle"] => ?type(Q, R, {oracle, Q, R}), - ["oracle_query"] => ?type(_, _, oracle_query), %% TODO: not in Fate + ["oracle_query"] => ?type(_, _, oracle_query), ["list"] => ?type(T, {list, T}), ["map"] => ?type(K, V, {map, K, V}), ["option"] => ?type(T, {variant, [[], [T]]}), @@ -238,7 +240,13 @@ init_type_env() -> }. is_no_code(Env) -> - proplists:get_value(no_code, maps:get(options, Env, []), false). + get_option(no_code, Env). + +get_option(Opt, Env) -> + get_option(Opt, Env, false). + +get_option(Opt, Env, Default) -> + proplists:get_value(Opt, maps:get(options, Env, []), Default). %% -- Compilation ------------------------------------------------------------ @@ -253,7 +261,7 @@ to_fcode(Env, [{contract, Attrs, MainCon = {con, _, Main}, Decls}]) -> decls_to_fcode(MainEnv, Decls), StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}), EventType = lookup_type(Env1, [Main, "event"], [], none), - StateLayout = maps:get(state_layout, Env1, default_layout), + StateLayout = state_layout(Env1), Payable = proplists:get_value(payable, Attrs, false), #{ contract_name => Main, state_type => StateType, @@ -277,9 +285,7 @@ decls_to_fcode(Env, Decls) -> %% environment. Env1 = add_fun_env(Env, Decls), lists:foldl(fun(D, E) -> - init_fresh_names(), R = decl_to_fcode(E, D), - clear_fresh_names(), R end, Env1, Decls). @@ -348,11 +354,30 @@ typedef_to_fcode(Env, Id = {id, _, Name}, Xs, Def) -> Env3 = compute_state_layout(Env2, Name, FDef), bind_type(Env3, Q, FDef). -compute_state_layout(Env = #{ context := {main_contract, _} }, "state", _Type) -> - Layout = default_layout, +compute_state_layout(Env = #{ context := {main_contract, _} }, "state", Type) -> + NoLayout = get_option(no_flatten_state, Env), + Layout = + case Type([]) of + _ when NoLayout -> {reg, 1}; + T -> + {_, L} = compute_state_layout(1, T), + L + end, Env#{ state_layout => Layout }; compute_state_layout(Env, _, _) -> Env. +compute_state_layout(R, {tuple, Ts}) -> + {R1, Ls} = compute_state_layout(R, Ts), + {R1, {tuple, Ls}}; +compute_state_layout(R, []) -> + {R, []}; +compute_state_layout(R, [H | T]) -> + {R1, H1} = compute_state_layout(R, H), + {R2, T1} = compute_state_layout(R1, T), + {R2, [H1 | T1]}; +compute_state_layout(R, _) -> + {R + 1, {reg, R}}. + check_state_and_event_types(#{ context := {main_contract, _} }, Id, [_ | _]) -> case Id of {id, _, "state"} -> fcode_error({parameterized_state, Id}); @@ -927,10 +952,23 @@ op_builtins() -> crypto_ecverify_secp256k1, crypto_ecrecover_secp256k1 ]. -builtin_to_fcode(default_layout, set_state, [Val]) -> - {set_state, 1, Val}; -builtin_to_fcode(default_layout, get_state, []) -> - {get_state, 1}; +set_state({reg, R}, Val) -> + {set_state, R, Val}; +set_state({tuple, Ls}, Val) -> + ?make_let(X, Val, + lists:foldr(fun({I, L}, Code) -> + {'let', "_", set_state(L, {proj, X, I - 1}), Code} + end, {tuple, []}, indexed(Ls))). + +get_state({reg, R}) -> + {get_state, R}; +get_state({tuple, Ls}) -> + {tuple, [get_state(L) || L <- Ls]}. + +builtin_to_fcode(Layout, set_state, [Val]) -> + set_state(Layout, Val); +builtin_to_fcode(Layout, get_state, []) -> + get_state(Layout); builtin_to_fcode(_Layout, require, [Cond, Msg]) -> make_if(Cond, {tuple, []}, {builtin, abort, [Msg]}); builtin_to_fcode(_Layout, chain_event, [Event]) -> @@ -962,8 +1000,9 @@ add_init_function(Env, Main, StateType, Funs0) -> Funs = add_default_init_function(Env, Main, StateType, Funs0), InitName = {entrypoint, <<"init">>}, InitFun = #{ body := InitBody} = maps:get(InitName, Funs), - Funs#{ InitName => InitFun#{ return => {tuple, []}, - body => builtin_to_fcode(state_layout(Env), set_state, [InitBody]) } } + Funs1 = Funs#{ InitName => InitFun#{ return => {tuple, []}, + body => builtin_to_fcode(state_layout(Env), set_state, [InitBody]) } }, + Funs1 end. add_default_init_function(_Env, Main, StateType, Funs) -> @@ -1015,11 +1054,9 @@ event_function(_Env = #{event_type := {variant_t, EventCons}}, EventType = {vari -spec lambda_lift(fcode()) -> fcode(). lambda_lift(FCode = #{ functions := Funs, state_layout := StateLayout }) -> - init_fresh_names(), init_lambda_funs(), Funs1 = maps:map(fun(_, Body) -> lambda_lift_fun(StateLayout, Body) end, Funs), NewFuns = get_lambda_funs(), - clear_fresh_names(), FCode#{ functions := maps:merge(Funs1, NewFuns) }. -define(lambda_key, '%lambdalifted'). @@ -1119,7 +1156,11 @@ optimize_fcode(Code = #{ functions := Funs }) -> -spec optimize_fun(fcode(), fun_name(), fun_def()) -> fun_def(). optimize_fun(Fcode, Fun, Def = #{ body := Body }) -> %% io:format("Optimizing ~p =\n~s\n", [_Fun, prettypr:format(pp_fexpr(_Body))]), - Def#{ body := inliner(Fcode, Fun, Body) }. + Def#{ body := drop_unused_lets( + simplifier( + let_floating( + bind_subexpressions( + inliner(Fcode, Fun, Body))))) }. %% --- Inlining --- @@ -1135,6 +1176,168 @@ should_inline(_Fcode, _Fun1) -> false == list_to_atom("true"). %% Dialyzer inline(_Fcode, Fun, Args) -> {def, Fun, Args}. %% TODO +%% --- Bind subexpressions --- + +-define(make_lets(Xs, Es, Body), make_lets(Es, fun(Xs) -> Body end)). + +bind_subexpressions(Expr) -> + bottom_up(fun bind_subexpressions/2, Expr). + +bind_subexpressions(_, {tuple, Es}) -> + ?make_lets(Xs, Es, {tuple, Xs}); +bind_subexpressions(_, {set_proj, A, I, B}) -> + ?make_lets([X, Y], [A, B], {set_proj, X, I, Y}); +bind_subexpressions(_, E) -> E. + +make_lets(Es, Body) -> make_lets(Es, [], Body). + +make_lets([], Xs, Body) -> Body(lists:reverse(Xs)); +make_lets([{var, _} = E | Es], Xs, Body) -> + make_lets(Es, [E | Xs], Body); +make_lets([{lit, _} = E | Es], Xs, Body) -> + make_lets(Es, [E | Xs], Body); +make_lets([E | Es], Xs, Body) -> + ?make_let(X, E, make_lets(Es, [X | Xs], Body)). + +%% --- Let-floating --- + +let_floating(Expr) -> bottom_up(fun let_float/2, Expr). + +let_float(_, {'let', X, E, Body}) -> + pull_out_let({'let', X, {here, E}, Body}); +let_float(_, {proj, E, I}) -> + pull_out_let({proj, {here, E}, I}); +let_float(_, {set_proj, E, I, V}) -> + pull_out_let({set_proj, {here, E}, I, {here, V}}); +let_float(_, E) -> E. + +pull_out_let(Expr) when is_tuple(Expr) -> + {Lets, Es} = pull_out_let(tuple_to_list(Expr)), + Inner = list_to_tuple(Es), + lists:foldr(fun({Y, E2}, E3) -> {'let', Y, E2, E3} end, + Inner, Lets); +pull_out_let(Es) when is_list(Es) -> + case lists:splitwith(fun({here, _}) -> false; (_) -> true end, Es) of + {Es0, [{here, E} | Es1]} -> + case let_view(E) of + {[], _} -> + {Lets, Es2} = pull_out_let(Es1), + {Lets, Es0 ++ [E] ++ Es2}; + {Lets, E1} -> + {Lets1, Es2} = pull_out_let(Es1), + {Lets ++ Lets1, Es0 ++ [E1] ++ Es2} + end; + {_, []} -> {[], Es} + end. + +%% Also renames the variables to fresh names +let_view(E) -> let_view(E, [], []). + +let_view({'let', X, E, Rest}, Ren, Lets) -> + Z = fresh_name(), + let_view(Rest, [{X, Z} | Ren], [{Z, rename(Ren, E)} | Lets]); +let_view(E, Ren, Lets) -> + {lists:reverse(Lets), rename(Ren, E)}. + +%% --- Simplification --- + +-spec simplifier(fexpr()) -> fexpr(). +simplifier(Expr) -> + bottom_up(fun simplify/2, Expr). + +-spec simplify(#{var_name() => fexpr()}, fexpr()) -> fexpr(). + +%% (e₀, .., en).i -> +%% let _ = e₀ in .. let x = ei in .. let _ = en in x +simplify(_Env, {proj, {tuple, Es}, I}) -> + It = lists:nth(I + 1, Es), + X = fresh_name(), + Dup = safe_to_duplicate(It), + Val = if Dup -> It; true -> {var, X} end, + lists:foldr( + fun({J, E}, Rest) when I == J -> + case Dup of + true -> Rest; + false -> {'let', X, E, Rest} + end; + ({_, E}, Rest) -> + case read_only(E) of + true -> Rest; + false -> {'let', "_", E, Rest} + end + end, Val, indexed(Es)); + +simplify(Env, {proj, {var, X}, I} = Expr) -> + case simpl_proj(Env, I, {var, X}) of + false -> Expr; + E -> E + end; +simplify(_, E) -> + E. + +simpl_proj(Env, I, Expr) -> + IfSafe = fun(E) -> case safe_to_duplicate(E) of + true -> E; + false -> false + end end, + case Expr of + false -> false; + {var, X} -> simpl_proj(Env, I, maps:get(X, Env, false)); + {tuple, Es} -> IfSafe(lists:nth(I + 1, Es)); + {set_proj, _, I, Val} -> IfSafe(Val); + {set_proj, E, _, _} -> simpl_proj(Env, I, E); + {proj, E, J} -> simpl_proj(Env, I, simpl_proj(Env, J, E)); + _ -> false + end. + +%% --- Drop unused lets --- + +drop_unused_lets(Expr) -> bottom_up(fun drop_unused_lets/2, Expr). + +drop_unused_lets(_, {'let', X, E, Body} = Expr) -> + case {read_only(E), not lists:member(X, free_vars(Body))} of + {true, true} -> Body; + {false, true} -> {'let', "_", E, Body}; + _ -> Expr + end; +drop_unused_lets(_, Expr) -> Expr. + +%% -- Static analysis -------------------------------------------------------- + +safe_to_duplicate({lit, _}) -> true; +safe_to_duplicate({var, _}) -> true; +safe_to_duplicate(nil) -> true; +safe_to_duplicate({tuple, []}) -> true; +safe_to_duplicate(_) -> false. + +-spec read_only(fexpr() | fsplit() | fcase() | [fexpr()] | [fcase()]) -> boolean(). +read_only({lit, _}) -> true; +read_only({var, _}) -> true; +read_only(nil) -> true; +read_only({con, _, _, Es}) -> read_only(Es); +read_only({tuple, Es}) -> read_only(Es); +read_only({proj, E, _}) -> read_only(E); +read_only({set_proj, A, _, B}) -> read_only([A, B]); +read_only({op, _, Es}) -> read_only(Es); +read_only({get_state, _}) -> true; +read_only({set_state, _, _}) -> false; +read_only({def_u, _, _}) -> true; +read_only({remote_u, _, _, _, _}) -> true; +read_only({builtin_u, _, _}) -> true; +read_only({builtin_u, _, _, _}) -> true; +read_only({lam, _, _}) -> true; +read_only({def, _, _}) -> false; %% TODO: purity analysis +read_only({remote, _, _, _, _, _}) -> false; +read_only({builtin, _, _}) -> false; %% TODO: some builtins are +read_only({switch, Split}) -> read_only(Split); +read_only({split, _, _, Cases}) -> read_only(Cases); +read_only({nosplit, E}) -> read_only(E); +read_only({'case', _, Split}) -> read_only(Split); +read_only({'let', _, A, B}) -> read_only([A, B]); +read_only({funcall, _, _}) -> false; +read_only({closure, _, _}) -> internal_error(no_closures_here); +read_only(Es) when is_list(Es) -> lists:all(fun read_only/1, Es). + %% --- Deadcode elimination --- -spec eliminate_dead_code(fcode()) -> fcode(). @@ -1365,6 +1568,40 @@ used_defs(Expr) -> {'case', _, A} -> used_defs(A) end. +bottom_up(F, Expr) -> bottom_up(F, #{}, Expr). + +bottom_up(F, Env, Expr) -> + F(Env, case Expr of + {lit, _} -> Expr; + nil -> Expr; + {var, _} -> Expr; + {def, D, Es} -> {def, D, [bottom_up(F, Env, E) || E <- Es]}; + {def_u, _, _} -> Expr; + {builtin, B, Es} -> {builtin, B, [bottom_up(F, Env, E) || E <- Es]}; + {builtin_u, _, _} -> Expr; + {builtin_u, _, _, _} -> Expr; + {remote, ArgsT, RetT, Ct, F, Es} -> {remote, ArgsT, RetT, bottom_up(F, Env, Ct), F, [bottom_up(F, Env, E) || E <- Es]}; + {remote_u, ArgsT, RetT, Ct, F} -> {remote_u, ArgsT, RetT, bottom_up(F, Env, Ct), F}; + {con, Ar, I, Es} -> {con, Ar, I, [bottom_up(F, Env, E) || E <- Es]}; + {tuple, Es} -> {tuple, [bottom_up(F, Env, E) || E <- Es]}; + {proj, E, I} -> {proj, bottom_up(F, Env, E), I}; + {set_proj, R, I, E} -> {set_proj, bottom_up(F, Env, R), I, bottom_up(F, Env, E)}; + {op, Op, Es} -> {op, Op, [bottom_up(F, Env, E) || E <- Es]}; + {funcall, Fun, Es} -> {funcall, bottom_up(F, Env, Fun), [bottom_up(F, Env, E) || E <- Es]}; + {set_state, R, E} -> {set_state, R, bottom_up(F, Env, E)}; + {get_state, _} -> Expr; + {closure, F, Env} -> {closure, F, bottom_up(F, Env, Env)}; + {switch, Split} -> {switch, bottom_up(F, Env, Split)}; + {lam, Xs, B} -> {lam, Xs, bottom_up(F, Env, B)}; + {'let', X, E, Body} -> + E1 = bottom_up(F, Env, E), + Env1 = Env#{ X => E1 }, + {'let', X, E1, bottom_up(F, Env1, Body)}; + {split, Type, X, Cases} -> {split, Type, X, [bottom_up(F, Env, Case) || Case <- Cases]}; + {nosplit, E} -> {nosplit, bottom_up(F, Env, E)}; + {'case', Pat, Split} -> {'case', Pat, bottom_up(F, Env, Split)} + end). + get_named_args(NamedArgsT, Args) -> IsNamed = fun({named_arg, _, _, _}) -> true; (_) -> false end, @@ -1609,9 +1846,18 @@ pp_fexpr({op, Op, [A] = Args}) -> end; pp_fexpr({op, Op, As}) -> pp_beside(pp_text(Op), pp_fexpr({tuple, As})); -pp_fexpr({'let', X, A, B}) -> - pp_par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), - pp_fexpr(B)]); +pp_fexpr({'let', _, _, _} = Expr) -> + Lets = fun Lets({'let', Y, C, D}) -> + {Ls, E} = Lets(D), + {[{Y, C} | Ls], E}; + Lets(E) -> {[], E} end, + {Ls, Body} = Lets(Expr), + pp_parens( + pp_par( + [ pp_beside([ pp_text("let "), + pp_above([ pp_par([pp_text(X), pp_text("="), pp_fexpr(A)]) || {X, A} <- Ls ]), + pp_text(" in ") ]), + pp_fexpr(Body) ])); pp_fexpr({builtin_u, B, N}) -> pp_beside([pp_text(B), pp_text("/"), pp_text(N)]); pp_fexpr({builtin_u, B, N, TypeArgs}) -> From ad88797cef268e0b2c5d9cc793f39e38ccbbfdda Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 24 Sep 2019 10:29:08 +0200 Subject: [PATCH 09/27] Proper handling of lets in term_to_fate --- src/aeso_fcode_to_fate.erl | 45 ++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 7968b8c..7cab268 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -179,42 +179,45 @@ lit_to_fate(L) -> {typerep, T} -> aeb_fate_data:make_typerep(type_to_scode(T)) end. -term_to_fate({lit, L}) -> +term_to_fate(E) -> term_to_fate(#{}, E). + +term_to_fate(_Env, {lit, L}) -> lit_to_fate(L); %% negative literals are parsed as 0 - N -term_to_fate({op, '-', [{lit, {int, 0}}, {lit, {int, N}}]}) -> +term_to_fate(_Env, {op, '-', [{lit, {int, 0}}, {lit, {int, N}}]}) -> aeb_fate_data:make_integer(-N); -term_to_fate(nil) -> +term_to_fate(_Env, nil) -> aeb_fate_data:make_list([]); -term_to_fate({op, '::', [Hd, Tl]}) -> +term_to_fate(Env, {op, '::', [Hd, Tl]}) -> %% The Tl will translate into a list, because FATE lists are just lists - [term_to_fate(Hd) | term_to_fate(Tl)]; -term_to_fate({tuple, As}) -> - aeb_fate_data:make_tuple(list_to_tuple([ term_to_fate(A) || A<-As])); -term_to_fate({con, Ar, I, As}) -> - FateAs = [ term_to_fate(A) || A <- As ], + [term_to_fate(Env, Hd) | term_to_fate(Env, Tl)]; +term_to_fate(Env, {tuple, As}) -> + aeb_fate_data:make_tuple(list_to_tuple([ term_to_fate(Env, A) || A<-As])); +term_to_fate(Env, {con, Ar, I, As}) -> + FateAs = [ term_to_fate(Env, A) || A <- As ], aeb_fate_data:make_variant(Ar, I, list_to_tuple(FateAs)); -term_to_fate({builtin, bits_all, []}) -> +term_to_fate(_Env, {builtin, bits_all, []}) -> aeb_fate_data:make_bits(-1); -term_to_fate({builtin, bits_none, []}) -> +term_to_fate(_Env, {builtin, bits_none, []}) -> aeb_fate_data:make_bits(0); -term_to_fate({op, bits_set, [B, I]}) -> +term_to_fate(_Env, {op, bits_set, [B, I]}) -> {bits, N} = term_to_fate(B), J = term_to_fate(I), {bits, N bor (1 bsl J)}; -term_to_fate({op, bits_clear, [B, I]}) -> +term_to_fate(_Env, {op, bits_clear, [B, I]}) -> {bits, N} = term_to_fate(B), J = term_to_fate(I), {bits, N band bnot (1 bsl J)}; -term_to_fate({builtin, map_empty, []}) -> +term_to_fate(Env, {'let', X, E, Body}) -> + Env1 = Env#{ X => term_to_fate(Env, E) }, + term_to_fate(Env1, Body); +term_to_fate(Env, {var, X}) -> + maps:get(X, Env); +term_to_fate(_Env, {builtin, map_empty, []}) -> aeb_fate_data:make_map(#{}); -term_to_fate({'let', _, {builtin, map_empty, []}, Set}) -> - aeb_fate_data:make_map(map_to_fate(Set)). - -map_to_fate({op, map_set, [{var, _}, K, V]}) -> - #{term_to_fate(K) => term_to_fate(V)}; -map_to_fate({op, map_set, [Set, K, V]}) -> - Map = map_to_fate(Set), Map#{term_to_fate(K) => term_to_fate(V)}. +term_to_fate(Env, {op, map_set, [M, K, V]}) -> + Map = term_to_fate(Env, M), + Map#{term_to_fate(Env, K) => term_to_fate(Env, V)}. to_scode(_Env, {lit, L}) -> [push(?i(lit_to_fate(L)))]; From c84064da7f07d7972fe4727f2f4858ec48c0b202 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 24 Sep 2019 10:29:36 +0200 Subject: [PATCH 10/27] Inline local functions and simplify case-on-constructor --- src/aeso_ast_to_fcode.erl | 98 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 92 insertions(+), 6 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 8fefc60..e5a0997 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -429,6 +429,13 @@ make_let(Expr, Body) -> {'let', X, Expr, Body({var, X})} end. +let_bind(X, {var, Y}, Body) -> rename([{X, Y}], Body); +let_bind(X, Expr, Body) -> {'let', X, Expr, Body}. + +let_bind(Binds, Body) -> + lists:foldr(fun({X, E}, Rest) -> let_bind(X, E, Rest) end, + Body, Binds). + -spec expr_to_fcode(env(), aeso_syntax:expr()) -> fexpr(). expr_to_fcode(Env, {typed, _, Expr, Type}) -> expr_to_fcode(Env, Type, Expr); @@ -1160,7 +1167,8 @@ optimize_fun(Fcode, Fun, Def = #{ body := Body }) -> simplifier( let_floating( bind_subexpressions( - inliner(Fcode, Fun, Body))))) }. + inline_local_functions( + inliner(Fcode, Fun, Body)))))) }. %% --- Inlining --- @@ -1199,6 +1207,19 @@ make_lets([{lit, _} = E | Es], Xs, Body) -> make_lets([E | Es], Xs, Body) -> ?make_let(X, E, make_lets(Es, [X | Xs], Body)). +%% --- Inline local functions --- + +inline_local_functions(Expr) -> + bottom_up(fun inline_local_functions/2, Expr). + +inline_local_functions(Env, {funcall, {proj, {var, Y}, 0}, [{proj, {var, Y}, 1} | Args]} = Expr) -> + %% TODO: Don't always inline local funs? + case maps:get(Y, Env, free) of + {lam, Xs, Body} -> let_bind(lists:zip(Xs, Args), Body); + _ -> Expr + end; +inline_local_functions(_, Expr) -> Expr. + %% --- Let-floating --- let_floating(Expr) -> bottom_up(fun let_float/2, Expr). @@ -1214,8 +1235,7 @@ let_float(_, E) -> E. pull_out_let(Expr) when is_tuple(Expr) -> {Lets, Es} = pull_out_let(tuple_to_list(Expr)), Inner = list_to_tuple(Es), - lists:foldr(fun({Y, E2}, E3) -> {'let', Y, E2, E3} end, - Inner, Lets); + let_bind(Lets, Inner); pull_out_let(Es) when is_list(Es) -> case lists:splitwith(fun({here, _}) -> false; (_) -> true end, Es) of {Es0, [{here, E} | Es1]} -> @@ -1267,11 +1287,23 @@ simplify(_Env, {proj, {tuple, Es}, I}) -> end end, Val, indexed(Es)); +%% let x = e in .. x.i .. simplify(Env, {proj, {var, X}, I} = Expr) -> case simpl_proj(Env, I, {var, X}) of false -> Expr; E -> E end; + +simplify(Env, {switch, {split, _, X, Alts}} = Expr) -> + case constructor_form(Env, {var, X}) of + false -> Expr; + E -> + case simpl_switch(Env, E, Alts) of + false -> Expr; + Expr1 -> Expr1 + end + end; + simplify(_, E) -> E. @@ -1290,6 +1322,56 @@ 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 -> false; + E -> simpl_switch(Env, E, Alts) + end. + +simpl_switch(_, _, []) -> false; +simpl_switch(Env, E, [{'case', Pat, Body} | Alts]) -> + case match_pat(Pat, E) of + false -> simpl_switch(Env, E, Alts); + Binds -> + Env1 = maps:merge(Env, maps:from_list(Binds)), + case simpl_switch(Env1, Body) of + false -> false; + Body1 -> let_bind(Binds, Body1) + end + end. + +match_pat({tuple, Xs}, {tuple, Es}) -> lists:zip(Xs, Es); +match_pat({con, _, C, Xs}, {con, _, C, Es}) -> lists:zip(Xs, Es); +match_pat(L, {lit, L}) -> []; +match_pat(nil, nil) -> []; +match_pat({'::', X, Y}, {op, '::', [A, B]}) -> [{X, A}, {Y, B}]; +match_pat({var, X}, E) -> [{X, E}]; +match_pat(_, _) -> false. + +constructor_form(Env, Expr) -> + case Expr of + {var, X} -> + case maps:get(X, Env, free) of + free -> false; + E -> constructor_form(Env, E) %% TODO: shadowing? + end; + {set_proj, E, I, V} -> + case constructor_form(Env, E) of + {tuple, Es} -> {tuple, setnth(I + 1, V, Es)}; + _ -> false + end; + {proj, E, I} -> + case constructor_form(Env, E) of + {tuple, Es} -> constructor_form(Env, lists:nth(I + 1, Es)); + _ -> false + end; + {con, _, _, _} -> Expr; + {tuple, _} -> Expr; + {lit, _} -> Expr; + _ -> false + end. + %% --- Drop unused lets --- drop_unused_lets(Expr) -> bottom_up(fun drop_unused_lets/2, Expr). @@ -1580,8 +1662,8 @@ bottom_up(F, Env, Expr) -> {builtin, B, Es} -> {builtin, B, [bottom_up(F, Env, E) || E <- Es]}; {builtin_u, _, _} -> Expr; {builtin_u, _, _, _} -> Expr; - {remote, ArgsT, RetT, Ct, F, Es} -> {remote, ArgsT, RetT, bottom_up(F, Env, Ct), F, [bottom_up(F, Env, E) || E <- Es]}; - {remote_u, ArgsT, RetT, Ct, F} -> {remote_u, ArgsT, RetT, bottom_up(F, Env, Ct), F}; + {remote, ArgsT, RetT, Ct, Fun, Es} -> {remote, ArgsT, RetT, bottom_up(F, Env, Ct), Fun, [bottom_up(F, Env, E) || E <- Es]}; + {remote_u, ArgsT, RetT, Ct, Fun} -> {remote_u, ArgsT, RetT, bottom_up(F, Env, Ct), Fun}; {con, Ar, I, Es} -> {con, Ar, I, [bottom_up(F, Env, E) || E <- Es]}; {tuple, Es} -> {tuple, [bottom_up(F, Env, E) || E <- Es]}; {proj, E, I} -> {proj, bottom_up(F, Env, E), I}; @@ -1744,6 +1826,10 @@ get_attributes(Ann) -> indexed(Xs) -> lists:zip(lists:seq(1, length(Xs)), Xs). +setnth(I, X, Xs) -> + {Ys, [_ | Zs]} = lists:split(I - 1, Xs), + Ys ++ [X] ++ Zs. + -dialyzer({nowarn_function, [fcode_error/1, internal_error/1]}). fcode_error(Error) -> @@ -1855,7 +1941,7 @@ pp_fexpr({'let', _, _, _} = Expr) -> pp_parens( pp_par( [ pp_beside([ pp_text("let "), - pp_above([ pp_par([pp_text(X), pp_text("="), pp_fexpr(A)]) || {X, A} <- Ls ]), + pp_above([ pp_par([pp_text(X), pp_text("="), prettypr:nest(2, pp_fexpr(A))]) || {X, A} <- Ls ]), pp_text(" in ") ]), pp_fexpr(Body) ])); pp_fexpr({builtin_u, B, N}) -> From cb045b025613fb2ae615a01d350a88feb95479e3 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 24 Sep 2019 10:43:21 +0200 Subject: [PATCH 11/27] whitespace --- src/aeso_ast_to_fcode.erl | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index e5a0997..fc675b6 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -1579,14 +1579,14 @@ pat_vars({con, _, _, Ps}) -> pat_vars(Ps); pat_vars(Ps) when is_list(Ps) -> [X || P <- Ps, X <- pat_vars(P)]. -spec fsplit_pat_vars(fsplit_pat()) -> [var_name()]. -fsplit_pat_vars({var, X}) -> [X || X /= "_"]; -fsplit_pat_vars({bool, _}) -> []; -fsplit_pat_vars({int, _}) -> []; -fsplit_pat_vars({string, _}) -> []; -fsplit_pat_vars(nil) -> []; -fsplit_pat_vars({'::', P, Q}) -> [P, Q]; -fsplit_pat_vars({tuple, Ps}) -> Ps; -fsplit_pat_vars({con, _, _, Ps}) -> Ps. +fsplit_pat_vars({var, X}) -> [X || X /= "_"]; +fsplit_pat_vars({bool, _}) -> []; +fsplit_pat_vars({int, _}) -> []; +fsplit_pat_vars({string, _}) -> []; +fsplit_pat_vars(nil) -> []; +fsplit_pat_vars({'::', P, Q}) -> [P, Q]; +fsplit_pat_vars({tuple, Ps}) -> Ps; +fsplit_pat_vars({con, _, _, Ps}) -> Ps. free_vars(Xs) when is_list(Xs) -> lists:umerge([ free_vars(X) || X <- Xs ]); From 63d51baaa372926a52b331390036eab2bafafd1d Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 24 Sep 2019 11:00:10 +0200 Subject: [PATCH 12/27] Dialyzer issues --- src/aeso_ast_to_fcode.erl | 6 +++++- src/aeso_fcode_to_fate.erl | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index fc675b6..676d3e0 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -113,6 +113,7 @@ -type fcode() :: #{ contract_name := string(), state_type := ftype(), + state_layout := state_layout(), event_type := ftype() | none, functions := #{ fun_name() => fun_def() }, payable := boolean() }. @@ -1341,6 +1342,7 @@ simpl_switch(Env, E, [{'case', Pat, Body} | Alts]) -> end end. +-spec match_pat(fsplit_pat(), fexpr()) -> false | [{var_name(), fexpr()}]. match_pat({tuple, Xs}, {tuple, Es}) -> lists:zip(Xs, Es); match_pat({con, _, C, Xs}, {con, _, C, Es}) -> lists:zip(Xs, Es); match_pat(L, {lit, L}) -> []; @@ -1369,6 +1371,8 @@ constructor_form(Env, Expr) -> {con, _, _, _} -> Expr; {tuple, _} -> Expr; {lit, _} -> Expr; + nil -> Expr; + {op, '::', _} -> Expr; _ -> false end. @@ -1672,7 +1676,7 @@ bottom_up(F, Env, Expr) -> {funcall, Fun, Es} -> {funcall, bottom_up(F, Env, Fun), [bottom_up(F, Env, E) || E <- Es]}; {set_state, R, E} -> {set_state, R, bottom_up(F, Env, E)}; {get_state, _} -> Expr; - {closure, F, Env} -> {closure, F, bottom_up(F, Env, Env)}; + {closure, F, CEnv} -> {closure, F, bottom_up(F, Env, CEnv)}; {switch, Split} -> {switch, bottom_up(F, Env, Split)}; {lam, Xs, B} -> {lam, Xs, bottom_up(F, Env, B)}; {'let', X, E, Body} -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 7cab268..2a9f58d 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -304,7 +304,7 @@ to_scode(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value | Args]}) -> to_scode(_Env, {get_state, Reg}) -> [push(?s(Reg))]; to_scode(Env, {set_state, Reg, Val}) -> - call_to_scode(Env, [aeb_fate_ops:store(?s(Reg), ?a), + call_to_scode(Env, [{'STORE', ?s(Reg), ?a}, tuple(0)], [Val]); to_scode(Env, {closure, Fun, FVs}) -> From c8153f94a6ef47438d716fe186e4e1ff40b58f85 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 24 Sep 2019 16:22:25 +0200 Subject: [PATCH 13/27] More aggressive freshening to avoid shadowing issues --- src/aeso_ast_to_fcode.erl | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 676d3e0..b08dc75 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -1680,9 +1680,19 @@ bottom_up(F, Env, Expr) -> {switch, Split} -> {switch, bottom_up(F, Env, Split)}; {lam, Xs, B} -> {lam, Xs, bottom_up(F, Env, B)}; {'let', X, E, Body} -> - E1 = bottom_up(F, Env, E), - Env1 = Env#{ X => E1 }, - {'let', X, E1, bottom_up(F, Env1, Body)}; + E1 = bottom_up(F, Env, E), + %% Always freshen user variables to avoid shadowing issues. + ShouldFreshen = fun(Y = "%" ++ _) -> maps:is_key(Y, Env); + (_) -> true end, + case ShouldFreshen(X) of + true -> + Z = fresh_name(), + Env1 = Env#{ Z => E1 }, + {'let', Z, E1, bottom_up(F, Env1, rename([{X, Z}], Body))}; + false -> + Env1 = Env#{ X => E1 }, + {'let', X, E1, bottom_up(F, Env1, Body)} + end; {split, Type, X, Cases} -> {split, Type, X, [bottom_up(F, Env, Case) || Case <- Cases]}; {nosplit, E} -> {nosplit, bottom_up(F, Env, E)}; {'case', Pat, Split} -> {'case', Pat, bottom_up(F, Env, Split)} From 0a22c7a34aa38afbf66a77759ef065a749ffc9df Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 24 Sep 2019 16:22:41 +0200 Subject: [PATCH 14/27] More let-floating --- src/aeso_ast_to_fcode.erl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index b08dc75..1a0e8e8 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -1231,6 +1231,9 @@ let_float(_, {proj, E, I}) -> pull_out_let({proj, {here, E}, I}); let_float(_, {set_proj, E, I, V}) -> pull_out_let({set_proj, {here, E}, I, {here, V}}); +let_float(_, {op, Op, Es}) -> + {Lets, Es1} = pull_out_let([{here, E} || E <- Es]), + let_bind(Lets, {op, Op, Es1}); let_float(_, E) -> E. pull_out_let(Expr) when is_tuple(Expr) -> From bb1a45c557eee5592e0b311c19a8ce740a7aed30 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 24 Sep 2019 16:22:56 +0200 Subject: [PATCH 15/27] Improve case-on-constructor optimisation --- src/aeso_ast_to_fcode.erl | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 1a0e8e8..02f4f29 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -760,7 +760,9 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> I when is_integer(I) -> {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars), SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]), - Cases = [ {'case', SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)} + MakeCase = fun({var, Z}, Split) -> {'case', {var, "_"}, rename_split([{Z, X}], Split)}; + (SPat, Split) -> {'case', SPat, Split} end, + Cases = [ MakeCase(SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)) || {SPat, FAlts} <- SAlts ], {split, Type, X, Cases} end. @@ -1298,14 +1300,11 @@ simplify(Env, {proj, {var, X}, I} = Expr) -> E -> E end; -simplify(Env, {switch, {split, _, X, Alts}} = Expr) -> - case constructor_form(Env, {var, X}) of - false -> Expr; - E -> - case simpl_switch(Env, E, Alts) of - false -> Expr; - Expr1 -> Expr1 - end +simplify(Env, {switch, Split}) -> + case simpl_switch(Env, Split) of + nomatch -> {builtin, abort, [{lit, {string, <<"Incomplete patterns">>}}]}; + stuck -> {switch, Split}; + Expr -> Expr end; simplify(_, E) -> @@ -1329,19 +1328,20 @@ simpl_proj(Env, I, Expr) -> simpl_switch(_Env, {nosplit, E}) -> E; simpl_switch(Env, {split, _, X, Alts}) -> case constructor_form(Env, {var, X}) of - false -> false; + false -> stuck; E -> simpl_switch(Env, E, Alts) end. -simpl_switch(_, _, []) -> false; +simpl_switch(_, _, []) -> nomatch; simpl_switch(Env, E, [{'case', Pat, Body} | Alts]) -> case match_pat(Pat, E) of false -> simpl_switch(Env, E, Alts); Binds -> Env1 = maps:merge(Env, maps:from_list(Binds)), case simpl_switch(Env1, Body) of - false -> false; - Body1 -> let_bind(Binds, Body1) + nomatch -> simpl_switch(Env, E, Alts); + stuck -> stuck; + Body1 -> let_bind(Binds, Body1) end end. @@ -1992,7 +1992,7 @@ pp_ftype({tvar, X}) -> pp_text(X); pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, {int, N}}]); pp_ftype({oracle, Q, R}) -> pp_call_t("oracle", [Q, R]); pp_ftype({tuple, Ts}) -> - pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); + pp_parens(pp_par(pp_punctuate(pp_text(" *"), [pp_ftype(T) || T <- Ts]))); pp_ftype({list, T}) -> pp_call_t("list", [T]); pp_ftype({function, Args, Res}) -> From 46a30b118f96845883a8beab4f525e96b3972a4e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 30 Sep 2019 11:59:27 +0200 Subject: [PATCH 16/27] Get rid of unnecessary return instruction after tail-call --- src/aeso_fcode_to_fate.erl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 2a9f58d..7588f3c 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -1582,6 +1582,7 @@ tweak_returns(['RETURN', {'PUSH', A} | Code]) -> [{'RETURNR', A} | Code tweak_returns(['RETURN' | Code = [{'CALL_T', _} | _]]) -> Code; tweak_returns(['RETURN' | Code = [{'ABORT', _} | _]]) -> Code; tweak_returns(['RETURN' | Code = [{'EXIT', _} | _]]) -> Code; +tweak_returns(['RETURN' | Code = [loop | _]]) -> Code; tweak_returns(Code) -> Code. %% -- Split basic blocks at CALL instructions -- @@ -1595,8 +1596,7 @@ split_calls(Ref, [], Acc, Blocks) -> split_calls(Ref, [I | Code], Acc, Blocks) when element(1, I) == 'CALL'; element(1, I) == 'CALL_R'; element(1, I) == 'CALL_GR'; - element(1, I) == 'jumpif'; - I == loop -> + element(1, I) == 'jumpif' -> split_calls(make_ref(), Code, [], [{Ref, lists:reverse([I | Acc])} | Blocks]); split_calls(Ref, [{'ABORT', _} = I | _Code], Acc, Blocks) -> lists:reverse([{Ref, lists:reverse([I | Acc])} | Blocks]); From bf5e2e244382f71597ff2ea98ae7a416519dfd45 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 6 Dec 2019 17:09:48 +0100 Subject: [PATCH 17/27] Fix parse errors causing crashes instead of nice errors --- src/aeso_ast_infer_types.erl | 18 ++++++++++++++++++ src/aeso_parser.erl | 8 ++++---- src/aeso_syntax.erl | 7 ++++--- test/aeso_compiler_tests.erl | 11 +++++++++++ test/contracts/bad_records.aes | 5 +++++ 5 files changed, 42 insertions(+), 7 deletions(-) create mode 100644 test/contracts/bad_records.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 9376129..565c34d 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -1290,6 +1290,16 @@ infer_expr(Env, {block, Attrs, Stmts}) -> BlockType = fresh_uvar(Attrs), NewStmts = infer_block(Env, Attrs, Stmts, BlockType), {typed, Attrs, {block, Attrs, NewStmts}, BlockType}; +infer_expr(_Env, {record_or_map_error, Attrs, Fields}) -> + type_error({mixed_record_and_map, {record, Attrs, Fields}}), + Type = fresh_uvar(Attrs), + {typed, Attrs, {record, Attrs, []}, Type}; +infer_expr(Env, {record_or_map_error, Attrs, Expr, []}) -> + type_error({empty_record_or_map_update, {record, Attrs, Expr, []}}), + infer_expr(Env, Expr); +infer_expr(Env, {record_or_map_error, Attrs, Expr, Fields}) -> + type_error({mixed_record_and_map, {record, Attrs, Expr, Fields}}), + infer_expr(Env, Expr); 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], @@ -2456,6 +2466,14 @@ mk_error({compiler_version_mismatch, Ann, Version, Op, Bound}) -> "because it does not satisfy the constraint" " ~s ~s ~s\n", [PrintV(Version), Op, PrintV(Bound)]), mk_t_err(pos(Ann), Msg); +mk_error({empty_record_or_map_update, Expr}) -> + Msg = io_lib:format("Empty record/map update\n~s", + [pp_expr(" ", Expr)]), + mk_t_err(pos(Expr), Msg); +mk_error({mixed_record_and_map, Expr}) -> + Msg = io_lib:format("Mixed record fields and map keys in\n~s", + [pp_expr(" ", Expr)]), + mk_t_err(pos(Expr), Msg); mk_error(Err) -> Msg = io_lib:format("Unknown error: ~p\n", [Err]), mk_t_err(pos(0, 0), Msg). diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index 06a3c43..e03224c 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -349,7 +349,9 @@ record(Fs) -> bad_expr_err("Cannot use '@' in map construction", infix({lvalue, FAnn, LV}, {'@', Ann}, Id)); ({field, FAnn, LV, _}) -> bad_expr_err("Cannot use nested fields or keys in map construction", {lvalue, FAnn, LV}) end, - {map, Ann, lists:map(KV, Fs)} + {map, Ann, lists:map(KV, Fs)}; + record_or_map_error -> + {record_or_map_error, get_ann(hd(Fs)), Fs} end. record_or_map(Fields) -> @@ -361,9 +363,7 @@ record_or_map(Fields) -> case lists:usort(lists:map(Kind, Fields)) of [proj] -> record; [map_get] -> map; - _ -> - [{field, Ann, _, _} | _] = Fields, - bad_expr_err("Mixed record fields and map keys in", {record, Ann, Fields}) + _ -> record_or_map_error %% Defer error until type checking end. field_assignment() -> diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index 4eb52ef..66104b2 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -100,9 +100,8 @@ | {list, ann(), [expr()]} | {list_comp, ann(), expr(), [comprehension_exp()]} | {typed, ann(), expr(), type()} - | {record, ann(), [field(expr())]} - | {record, ann(), expr(), [field(expr())]} %% record update - | {map, ann(), expr(), [field(expr())]} %% map update + | {record_or_map(), ann(), [field(expr())]} + | {record_or_map(), ann(), expr(), [field(expr())]} %% record/map update | {map, ann(), [{expr(), expr()}]} | {map_get, ann(), expr(), expr()} | {map_get, ann(), expr(), expr(), expr()} @@ -111,6 +110,8 @@ | id() | qid() | con() | qcon() | constant(). +-type record_or_map() :: record | map | record_or_map_error. + -type comprehension_exp() :: [ {comprehension_bind, id(), expr()} | {comprehension_if, ann(), expr()} | letbind() ]. diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 50130e6..c5912cd 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -595,6 +595,17 @@ failing_contracts() -> [<>]) + , ?TYPE_ERROR(bad_records, + [<>, + <>, + <> + ]) ]. -define(Path(File), "code_errors/" ??File). diff --git a/test/contracts/bad_records.aes b/test/contracts/bad_records.aes new file mode 100644 index 0000000..529e6f9 --- /dev/null +++ b/test/contracts/bad_records.aes @@ -0,0 +1,5 @@ +contract BadRecord = + entrypoint foo() = + let r = {x = 0, [0] = 1} + r{x = 0, [0] = 1} + r{} From a403a9d227ac56266cf5bb8fbc916f17e6141d15 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 26 Nov 2019 15:08:57 +0100 Subject: [PATCH 18/27] Unbox singleton tuples and records --- src/aeso_ast_to_fcode.erl | 34 +++++++++++++++++++++++++++------- src/aeso_fcode_to_fate.erl | 7 +++++-- 2 files changed, 32 insertions(+), 9 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 02f4f29..a8c3224 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -367,6 +367,8 @@ compute_state_layout(Env = #{ context := {main_contract, _} }, "state", Type) -> Env#{ state_layout => Layout }; compute_state_layout(Env, _, _) -> Env. +compute_state_layout(R, {tuple, [T]}) -> + compute_state_layout(R, T); compute_state_layout(R, {tuple, Ts}) -> {R1, Ls} = compute_state_layout(R, Ts), {R1, {tuple, Ls}}; @@ -497,7 +499,7 @@ expr_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Args}) when C %% Tuples expr_to_fcode(Env, _Type, {tuple, _, Es}) -> - {tuple, [expr_to_fcode(Env, E) || E <- Es]}; + make_tuple([expr_to_fcode(Env, E) || E <- Es]); %% Records expr_to_fcode(Env, Type, {proj, _Ann, Rec = {typed, _, _, RecType}, {id, _, X}}) -> @@ -509,18 +511,28 @@ expr_to_fcode(Env, Type, {proj, _Ann, Rec = {typed, _, _, RecType}, {id, _, X}}) FArgs = [type_to_fcode(Env, Arg) || Arg <- Args], {remote_u, FArgs, type_to_fcode(Env, Ret), expr_to_fcode(Env, Rec), {entrypoint, list_to_binary(X)}}; + {record_t, [_]} -> expr_to_fcode(Env, Rec); %% Singleton record {record_t, _} -> {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)} end; +expr_to_fcode(Env, {record_t, [FieldT]}, {record, _Ann, [_] = Fields}) -> + {set, E} = field_value(FieldT, Fields), + expr_to_fcode(Env, E); expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> FVal = fun(F) -> %% All fields are present and no updates {set, E} = field_value(F, Fields), expr_to_fcode(Env, E) end, - {tuple, lists:map(FVal, FieldTypes)}; + make_tuple(lists:map(FVal, FieldTypes)); +expr_to_fcode(Env, {record_t, [FieldT]}, {record, _Ann, Rec, Fields}) -> + case field_value(FieldT, Fields) of + false -> expr_to_fcode(Env, Rec); + {set, E} -> expr_to_fcode(Env, E); + {upd, Z, E} -> {'let', Z, expr_to_fcode(Env, Rec), expr_to_fcode(bind_var(Env, Z), E)} + end; expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> X = fresh_name(), Proj = fun(I) -> {proj, {var, X}, I - 1} end, @@ -672,6 +684,13 @@ make_if(Cond, Then, Else) -> X = fresh_name(), {'let', X, Cond, make_if({var, X}, Then, Else)}. +-spec make_tuple([fexpr()]) -> fexpr(). +make_tuple([E]) -> E; +make_tuple(Es) -> {tuple, Es}. + +-spec strip_singleton_tuples(ftype()) -> ftype(). +strip_singleton_tuples({tuple, [T]}) -> strip_singleton_tuples(T); +strip_singleton_tuples(T) -> T. get_oracle_type(oracle_register, {fun_t, _, _, _, OType}) -> OType; get_oracle_type(oracle_query, {fun_t, _, _, [OType | _], _}) -> OType; @@ -759,12 +778,13 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> {nosplit, rename(Ren, Body)}; I when is_integer(I) -> {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars), + Type1 = strip_singleton_tuples(Type), SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]), MakeCase = fun({var, Z}, Split) -> {'case', {var, "_"}, rename_split([{Z, X}], Split)}; (SPat, Split) -> {'case', SPat, Split} end, - Cases = [ MakeCase(SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)) + Cases = [ MakeCase(SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type1) ++ Vars1, FAlts)) || {SPat, FAlts} <- SAlts ], - {split, Type, X, Cases} + {split, Type1, X, Cases} end. -spec merge_alts(integer(), var_name(), [{fsplit_pat(), falt()}]) -> [{fsplit_pat(), [falt()]}]. @@ -887,7 +907,7 @@ pat_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Pats}) when C #con_tag{tag = I, arities = As} = lookup_con(Env, Con), {con, As, I, [pat_to_fcode(Env, Pat) || Pat <- Pats]}; pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> - {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; + make_tuple([ pat_to_fcode(Env, Pat) || Pat <- Pats ]); pat_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; pat_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; pat_to_fcode(_Env, _Type, {char, _, N}) -> {int, N}; @@ -905,8 +925,8 @@ pat_to_fcode(Env, {record_t, Fields}, {record, _, FieldPats}) -> {set, Pat} -> Pat %% {upd, _, _} is impossible in patterns end end, - {tuple, [pat_to_fcode(Env, FieldPat(Field)) - || Field <- Fields]}; + make_tuple([pat_to_fcode(Env, FieldPat(Field)) + || Field <- Fields]); pat_to_fcode(_Env, Type, Pat) -> error({todo, Pat, ':', Type}). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 7588f3c..44949b9 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -120,9 +120,10 @@ type_to_scode(name) -> name; type_to_scode(channel) -> channel; type_to_scode(bits) -> bits; type_to_scode(any) -> any; -type_to_scode({variant, Cons}) -> {variant, lists:map(fun(T) -> type_to_scode({tuple, T}) end, Cons)}; +type_to_scode({variant, Cons}) -> {variant, [{tuple, types_to_scode(Con)} || Con <- Cons]}; type_to_scode({list, Type}) -> {list, type_to_scode(Type)}; -type_to_scode({tuple, Types}) -> {tuple, lists:map(fun type_to_scode/1, Types)}; +type_to_scode({tuple, [Type]}) -> type_to_scode(Type); +type_to_scode({tuple, Types}) -> {tuple, types_to_scode(Types)}; type_to_scode({map, Key, Val}) -> {map, type_to_scode(Key), type_to_scode(Val)}; type_to_scode({function, _Args, _Res}) -> {tuple, [string, any]}; type_to_scode({tvar, X}) -> @@ -134,6 +135,8 @@ type_to_scode({tvar, X}) -> J -> {tvar, J} end. +types_to_scode(Ts) -> lists:map(fun type_to_scode/1, Ts). + %% -- Phase I ---------------------------------------------------------------- %% Icode to structured assembly From 2e4558b3b4ad864ce6d8f32893ff782b9d40cdba Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 10 Dec 2019 12:57:52 +0100 Subject: [PATCH 19/27] Changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1ecefdc..d1e2c3f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] ### Added ### Changed +- FATE code generator improvements. ### Removed ## [4.1.0] - 2019-11-26 From 954af13f5970c33ee4db69d0f87e80f329183f1b Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 12 Dec 2019 09:14:34 +0100 Subject: [PATCH 20/27] Fix debug printing of store registers --- src/aeso_fcode_to_fate.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 44949b9..a6f70ff 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -654,7 +654,7 @@ pp_op(I) -> pp_arg(?i(I)) -> io_lib:format("~w", [I]); pp_arg({arg, N}) -> io_lib:format("arg~p", [N]); -pp_arg(?s(N)) -> io_lib:format("store~p", [-N]); +pp_arg(?s(N)) -> io_lib:format("store~p", [N]); pp_arg({var, N}) -> io_lib:format("var~p", [N]); pp_arg(?a) -> "a". From d4f291f252c22a5f8c6d53fc328626fd87321cdd Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Wed, 11 Dec 2019 09:02:32 +0100 Subject: [PATCH 21/27] Handle qualified constructors in patterns --- src/aeso_ast_infer_types.erl | 21 +++++++++------------ src/aeso_parser.erl | 3 ++- test/aeso_compiler_tests.erl | 3 ++- test/contracts/qualified_constructor.aes | 8 ++++++++ 4 files changed, 21 insertions(+), 14 deletions(-) create mode 100644 test/contracts/qualified_constructor.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 565c34d..fcca92f 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -1440,18 +1440,13 @@ infer_prefix({IntOp,As}) when IntOp =:= '-' -> abort_expr(Ann, Str) -> {app, Ann, {id, Ann, "abort"}, [{string, Ann, Str}]}. -free_vars({int, _, _}) -> - []; -free_vars({char, _, _}) -> - []; -free_vars({string, _, _}) -> - []; -free_vars({bool, _, _}) -> - []; -free_vars(Id={id, _, _}) -> - [Id]; -free_vars({con, _, _}) -> - []; +free_vars({int, _, _}) -> []; +free_vars({char, _, _}) -> []; +free_vars({string, _, _}) -> []; +free_vars({bool, _, _}) -> []; +free_vars(Id={id, _, _}) -> [Id]; +free_vars({con, _, _}) -> []; +free_vars({qcon, _, _}) -> []; free_vars({tuple, _, Cpts}) -> free_vars(Cpts); free_vars({list, _, Elems}) -> @@ -1460,6 +1455,8 @@ free_vars({app, _, {'::', _}, Args}) -> free_vars(Args); free_vars({app, _, {con, _, _}, Args}) -> free_vars(Args); +free_vars({app, _, {qcon, _, _}, Args}) -> + free_vars(Args); free_vars({record, _, Fields}) -> free_vars([E || {field, _, _, E} <- Fields]); free_vars({typed, _, A, _}) -> diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index e03224c..de9dcc6 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -545,7 +545,7 @@ list_comp_e(Ann, Expr, Binds) -> {list_comp, Ann, Expr, Binds}. -spec parse_pattern(aeso_syntax:expr()) -> aeso_parse_lib:parser(aeso_syntax:pat()). parse_pattern({app, Ann, Con = {'::', _}, Es}) -> {app, Ann, Con, lists:map(fun parse_pattern/1, Es)}; -parse_pattern({app, Ann, Con = {con, _, _}, Es}) -> +parse_pattern({app, Ann, Con = {Tag, _, _}, Es}) when Tag == con; Tag == qcon -> {app, Ann, Con, lists:map(fun parse_pattern/1, Es)}; parse_pattern({tuple, Ann, Es}) -> {tuple, Ann, lists:map(fun parse_pattern/1, Es)}; @@ -554,6 +554,7 @@ parse_pattern({list, Ann, Es}) -> parse_pattern({record, Ann, Fs}) -> {record, Ann, lists:map(fun parse_field_pattern/1, Fs)}; parse_pattern(E = {con, _, _}) -> E; +parse_pattern(E = {qcon, _, _}) -> E; parse_pattern(E = {id, _, _}) -> E; parse_pattern(E = {int, _, _}) -> E; parse_pattern(E = {bool, _, _}) -> E; diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index c5912cd..b4d400e 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -161,7 +161,8 @@ compilable_contracts() -> "list_comp", "payable", "unapplied_builtins", - "underscore_number_literals" + "underscore_number_literals", + "qualified_constructor" ]. not_yet_compilable(fate) -> []; diff --git a/test/contracts/qualified_constructor.aes b/test/contracts/qualified_constructor.aes new file mode 100644 index 0000000..31a77a5 --- /dev/null +++ b/test/contracts/qualified_constructor.aes @@ -0,0 +1,8 @@ +namespace Foo = + datatype x = A | B(int) + +contract Bar = + entrypoint f(a : Foo.x) = + switch(a) + Foo.A => 0 + Foo.B(n) => n From 64e2fff91a94e0a69eddc9bf6c140c8e3a2b3053 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 12 Dec 2019 08:49:54 +0100 Subject: [PATCH 22/27] Handle list comprehensions in pretty printer --- src/aeso_pretty.erl | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 2472ead..6a362de 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -305,6 +305,8 @@ expr_p(_, {tuple, _, Es}) -> tuple(lists:map(fun expr/1, Es)); expr_p(_, {list, _, Es}) -> list(lists:map(fun expr/1, Es)); +expr_p(_, {list_comp, _, E, Binds}) -> + list([follow(expr(E), hsep(text("|"), par(punctuate(text(","), lists:map(fun lc_bind/1, Binds)), 0)), 0)]); expr_p(_, {record, _, Fs}) -> record(lists:map(fun field/1, Fs)); expr_p(_, {map, Ann, KVs}) -> @@ -387,6 +389,13 @@ stmt_p({else, Else}) -> _ -> block_expr(200, text("else"), Else) end. +lc_bind({comprehension_bind, P, E}) -> + follow(hsep(expr(P), text("<-")), expr(E)); +lc_bind({comprehension_if, _, E}) -> + beside([text("if("), expr(E), text(")")]); +lc_bind(Let) -> + letdecl("let", Let). + -spec bin_prec(aeso_syntax:bin_op()) -> {integer(), integer(), integer()}. bin_prec('..') -> { 0, 0, 0}; %% Always printed inside '[ ]' bin_prec('=') -> { 0, 0, 0}; %% Always printed inside '[ ]' From d844c4d276b78fd5100a026ac612e26f3f085617 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 12 Dec 2019 08:50:17 +0100 Subject: [PATCH 23/27] Fix missing type annotation in list comprehension body --- src/aeso_ast_infer_types.erl | 2 +- test/aeso_compiler_tests.erl | 1 + test/contracts/lc_record_bug.aes | 4 ++++ 3 files changed, 6 insertions(+), 1 deletion(-) create mode 100644 test/contracts/lc_record_bug.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index fcca92f..5afe2e3 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -1138,7 +1138,7 @@ infer_expr(Env, {list, As, Elems}) -> NewElems = [check_expr(Env, X, ElemType) || X <- Elems], {typed, As, {list, As, NewElems}, {app_t, As, {id, As, "list"}, [ElemType]}}; infer_expr(Env, {list_comp, As, Yield, []}) -> - {typed, _, TypedYield, Type} = infer_expr(Env, Yield), + {typed, _, _, Type} = TypedYield = infer_expr(Env, Yield), {typed, As, {list_comp, As, TypedYield, []}, {app_t, As, {id, As, "list"}, [Type]}}; infer_expr(Env, {list_comp, As, Yield, [{comprehension_bind, Arg, BExpr}|Rest]}) -> BindVarType = fresh_uvar(As), diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index b4d400e..3ddca8c 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -138,6 +138,7 @@ compilable_contracts() -> "test", "builtin_bug", "builtin_map_get_bug", + "lc_record_bug", "nodeadcode", "deadcode", "variant_types", diff --git a/test/contracts/lc_record_bug.aes b/test/contracts/lc_record_bug.aes new file mode 100644 index 0000000..dcce24d --- /dev/null +++ b/test/contracts/lc_record_bug.aes @@ -0,0 +1,4 @@ +contract Foo = + record r = {x : int} + // Crashed in the backend due to missing type annotation on the lc body. + entrypoint lc(xs) = [ {x = x} | x <- xs ] From b51a79b5e119abe82d44dfab6b32efebbe6ac9d5 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 10 Dec 2019 16:12:08 +0100 Subject: [PATCH 24/27] Allow patterns in lets and list comprehension binds --- src/aeso_ast_infer_types.erl | 35 ++++++++++++++++++--------------- src/aeso_ast_to_fcode.erl | 13 ++++++++---- src/aeso_ast_to_icode.erl | 16 +++++++++------ src/aeso_parser.erl | 10 +++++----- src/aeso_pretty.erl | 10 +++++----- src/aeso_syntax.erl | 5 +++-- src/aeso_syntax_utils.erl | 6 +++--- test/aeso_compiler_tests.erl | 3 ++- test/aeso_parser_tests.erl | 2 +- test/contracts/let_patterns.aes | 13 ++++++++++++ 10 files changed, 70 insertions(+), 43 deletions(-) create mode 100644 test/contracts/let_patterns.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 5afe2e3..7cf8832 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -1140,19 +1140,18 @@ infer_expr(Env, {list, As, Elems}) -> infer_expr(Env, {list_comp, As, Yield, []}) -> {typed, _, _, Type} = TypedYield = infer_expr(Env, Yield), {typed, As, {list_comp, As, TypedYield, []}, {app_t, As, {id, As, "list"}, [Type]}}; -infer_expr(Env, {list_comp, As, Yield, [{comprehension_bind, Arg, BExpr}|Rest]}) -> - BindVarType = fresh_uvar(As), +infer_expr(Env, {list_comp, As, Yield, [{comprehension_bind, Pat, BExpr}|Rest]}) -> TypedBind = {typed, As2, _, TypeBExpr} = infer_expr(Env, BExpr), + {NewE, TypedPat = {typed, _, _, PatType}} = infer_pattern(Env, Pat), unify( Env , TypeBExpr - , {app_t, As, {id, As, "list"}, [BindVarType]} - , {list_comp, TypedBind, TypeBExpr, {app_t, As2, {id, As, "list"}, [BindVarType]}}), - NewE = bind_var(Arg, BindVarType, Env), + , {app_t, As, {id, As, "list"}, [PatType]} + , {list_comp, TypedBind, TypeBExpr, {app_t, As2, {id, As, "list"}, [PatType]}}), {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} = infer_expr(NewE, {list_comp, As, Yield, Rest}), { typed , As - , {list_comp, As, TypedYield, [{comprehension_bind, {typed, Arg, BindVarType}, TypedBind}|TypedRest]} + , {list_comp, As, TypedYield, [{comprehension_bind, TypedPat, TypedBind}|TypedRest]} , ResType}; infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Rest]}) -> NewCond = check_expr(Env, Cond, {id, AttrsIF, "bool"}), @@ -1162,8 +1161,8 @@ infer_expr(Env, {list_comp, AttrsL, Yield, [{comprehension_if, AttrsIF, Cond}|Re , AttrsL , {list_comp, AttrsL, TypedYield, [{comprehension_if, AttrsIF, NewCond}|TypedRest]} , ResType}; -infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, Type, E}|Rest]}) -> - NewE = {typed, _, _, PatType} = infer_expr(Env, {typed, AsLV, E, arg_type(AsLV, Type)}), +infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, E}|Rest]}) -> + NewE = {typed, _, _, PatType} = infer_expr(Env, E), BlockType = fresh_uvar(AsLV), {'case', _, NewPattern, NewRest} = infer_case( Env @@ -1175,7 +1174,7 @@ infer_expr(Env, {list_comp, AsLC, Yield, [{letval, AsLV, Pattern, Type, E}|Rest] {typed, _, {list_comp, _, TypedYield, TypedRest}, ResType} = NewRest, { typed , AsLC - , {list_comp, AsLC, TypedYield, [{letval, AsLV, NewPattern, Type, NewE}|TypedRest]} + , {list_comp, AsLC, TypedYield, [{letval, AsLV, NewPattern, NewE}|TypedRest]} , ResType }; infer_expr(Env, {list_comp, AsLC, Yield, [Def={letfun, AsLF, _, _, _, _}|Rest]}) -> @@ -1308,7 +1307,7 @@ infer_expr(Env, {lam, Attrs, Args, Body}) -> infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, Body, ResultType), NewArgs = [{arg, As, NewPat, NewT} || {typed, As, NewPat, NewT} <- NewArgPatterns], {typed, Attrs, {lam, Attrs, NewArgs, NewBody}, {fun_t, Attrs, [], ArgTypes, ResultType}}; -infer_expr(Env, Let = {letval, Attrs, _, _, _}) -> +infer_expr(Env, Let = {letval, Attrs, _, _}) -> type_error({missing_body_for_let, Attrs}), infer_expr(Env, {block, Attrs, [Let, abort_expr(Attrs, "missing body")]}); infer_expr(Env, Let = {letfun, Attrs, _, _, _, _}) -> @@ -1371,15 +1370,19 @@ infer_op(Env, As, Op, Args, InferOp) -> unify(Env, ArgTypes, OperandTypes, {infer_app, Op, Args, Inferred, ArgTypes}), {typed, As, {app, As, Op, TypedArgs}, ResultType}. -infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> +infer_pattern(Env, Pattern) -> Vars = free_vars(Pattern), Names = [N || {id, _, N} <- Vars, N /= "_"], case Names -- lists:usort(Names) of [] -> ok; Nonlinear -> type_error({non_linear_pattern, Pattern, lists:usort(Nonlinear)}) end, - NewEnv = bind_vars([{Var, fresh_uvar(Ann)} || Var = {id, Ann, _} <- Vars], Env#env{ in_pattern = true }), - NewPattern = {typed, _, _, PatType} = infer_expr(NewEnv, Pattern), + NewEnv = bind_vars([{Var, fresh_uvar(Ann1)} || Var = {id, Ann1, _} <- Vars], Env#env{ in_pattern = true }), + NewPattern = infer_expr(NewEnv, Pattern), + {NewEnv, NewPattern}. + +infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> + {NewEnv, NewPattern = {typed, _, _, PatType}} = infer_pattern(Env, Pattern), NewBranch = check_expr(NewEnv#env{ in_pattern = false }, Branch, SwitchType), unify(Env, PatType, ExprType, {case_pat, Pattern, PatType, ExprType}), {'case', Attrs, NewPattern, NewBranch}. @@ -1394,11 +1397,11 @@ infer_block(Env, Attrs, [Def={letfun, Ann, _, _, _, _}|Rest], BlockType) -> FunT = typesig_to_fun_t(TypeSig), NewE = bind_var({id, Ann, Name}, FunT, Env), [LetFun|infer_block(NewE, Attrs, Rest, BlockType)]; -infer_block(Env, _, [{letval, Attrs, Pattern, Type, E}|Rest], BlockType) -> - NewE = {typed, _, _, PatType} = infer_expr(Env, {typed, Attrs, E, arg_type(aeso_syntax:get_ann(Pattern), Type)}), +infer_block(Env, _, [{letval, Attrs, Pattern, E}|Rest], BlockType) -> + NewE = {typed, _, _, PatType} = infer_expr(Env, E), {'case', _, NewPattern, {typed, _, {block, _, NewRest}, _}} = infer_case(Env, Attrs, Pattern, PatType, {block, Attrs, Rest}, BlockType), - [{letval, Attrs, NewPattern, Type, NewE}|NewRest]; + [{letval, Attrs, NewPattern, NewE}|NewRest]; infer_block(Env, Attrs, [E|Rest], BlockType) -> [infer_expr(Env, E)|infer_block(Env, Attrs, Rest, BlockType)]. diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index a8c3224..4a4955b 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -564,9 +564,12 @@ expr_to_fcode(Env, _Type, {app, _, {'..', _}, [A, B]}) -> expr_to_fcode(Env, _Type, {list_comp, _, Yield, []}) -> {op, '::', [expr_to_fcode(Env, Yield), nil]}; -expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, {typed, {id, _, Arg}, _}, BindExpr}|Rest]}) -> +expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {typed, _, _, PatType}, BindExpr}|Rest]}) -> + Arg = fresh_name(), Env1 = bind_var(Env, Arg), - Bind = {lam, [Arg], expr_to_fcode(Env1, {list_comp, As, Yield, Rest})}, + Bind = {lam, [Arg], expr_to_fcode(Env1, {switch, As, {typed, As, {id, As, Arg}, PatType}, + [{'case', As, Pat, {list_comp, As, Yield, Rest}}, + {'case', As, {id, As, "_"}, {list, As, []}}]})}, {def_u, FlatMap, _} = resolve_fun(Env, ["ListInternal", "flat_map"]), {def, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]}; expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) -> @@ -574,7 +577,7 @@ expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Res expr_to_fcode(Env, Type, {list_comp, As, Yield, Rest}), nil ); -expr_to_fcode(Env, Type, {list_comp, As, Yield, [LV = {letval, _, _, _, _}|Rest]}) -> +expr_to_fcode(Env, Type, {list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}) -> expr_to_fcode(Env, Type, {block, As, [LV, {list_comp, As, Yield, Rest}]}); expr_to_fcode(Env, Type, {list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}) -> expr_to_fcode(Env, Type, {block, As, [LF, {list_comp, As, Yield, Rest}]}); @@ -960,8 +963,10 @@ decision_tree_to_fcode({'if', A, Then, Else}) -> %% -- Statements -- -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). -stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> +stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, Expr} | Stmts]) -> {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)}; +stmts_to_fcode(Env, [{letval, Ann, Pat, Expr} | Stmts]) -> + expr_to_fcode(Env, {switch, Ann, Expr, [{'case', Ann, Pat, {block, Ann, Stmts}}]}); stmts_to_fcode(Env, [{letfun, Ann, {id, _, X}, Args, _Type, Expr} | Stmts]) -> {'let', X, expr_to_fcode(Env, {lam, Ann, Args, Expr}), stmts_to_fcode(bind_var(Env, X), Stmts)}; diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index acf68ea..7a47905 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -318,19 +318,23 @@ ast_body({app, As, Fun, Args}, Icode) -> end; ast_body({list_comp, _, Yield, []}, Icode) -> #list{elems = [ast_body(Yield, Icode)]}; -ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, Arg, ArgType}, BindExpr}|Rest]}, Icode) -> +ast_body({list_comp, As, Yield, [{comprehension_bind, {typed, _, Pat, ArgType}, BindExpr}|Rest]}, Icode) -> + Arg = "%lc", + Body = {switch, As, {typed, As, {id, As, Arg}, ArgType}, + [{'case', As, Pat, {list_comp, As, Yield, Rest}}, + {'case', As, {id, As, "_"}, {list, As, []}}]}, #funcall { function = #var_ref{ name = ["ListInternal", "flat_map"] } , args = - [ #lambda{ args=[#arg{name = ast_id(Arg), type = ast_type(ArgType, Icode)}] - , body = ast_body({list_comp, As, Yield, Rest}, Icode) + [ #lambda{ args=[#arg{name = Arg, type = ast_type(ArgType, Icode)}] + , body = ast_body(Body, Icode) } , ast_body(BindExpr, Icode) ] }; ast_body({list_comp, As, Yield, [{comprehension_if, AsIF, Cond}|Rest]}, Icode) -> ast_body({'if', AsIF, Cond, {list_comp, As, Yield, Rest}, {list, As, []}}, Icode); -ast_body({list_comp, As, Yield, [LV = {letval, _, _, _, _}|Rest]}, Icode) -> +ast_body({list_comp, As, Yield, [LV = {letval, _, _, _}|Rest]}, Icode) -> ast_body({block, As, [LV, {list_comp, As, Yield, Rest}]}, Icode); ast_body({list_comp, As, Yield, [LF = {letfun, _, _, _, _, _}|Rest]}, Icode) -> ast_body({block, As, [LF, {list_comp, As, Yield, Rest}]}, Icode); @@ -344,14 +348,14 @@ ast_body({switch,_,A,Cases}, Icode) -> #switch{expr=ast_body(A, Icode), cases=[{ast_body(Pat, Icode),ast_body(Body, Icode)} || {'case',_,Pat,Body} <- Cases]}; -ast_body({block, As, [{letval, _, Pat, _, E} | Rest]}, Icode) -> +ast_body({block, As, [{letval, _, Pat, E} | Rest]}, Icode) -> E1 = ast_body(E, Icode), Pat1 = ast_body(Pat, Icode), Rest1 = ast_body({block, As, Rest}, Icode), #switch{expr = E1, cases = [{Pat1, Rest1}]}; ast_body({block, As, [{letfun, Ann, F, Args, _Type, Expr} | Rest]}, Icode) -> - ast_body({block, As, [{letval, Ann, F, unused, {lam, Ann, Args, Expr}} | Rest]}, Icode); + ast_body({block, As, [{letval, Ann, F, {lam, Ann, Args, Expr}} | Rest]}, Icode); ast_body({block,_,[]}, _Icode) -> #tuple{cpts=[]}; ast_body({block,_,[E]}, Icode) -> diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index de9dcc6..7109a46 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -164,9 +164,7 @@ letdecl() -> letdef() -> choice(valdef(), fundef()). valdef() -> - choice( - ?RULE(id(), tok('='), body(), {letval, [], _1, type_wildcard(), _3}), - ?RULE(id(), tok(':'), type(), tok('='), body(), {letval, [], _1, _3, _5})). + ?RULE(pattern(), tok('='), body(), {letval, [], _1, _3}). fundef() -> choice( @@ -238,7 +236,7 @@ branch() -> ?RULE(pattern(), keyword('=>'), body(), {'case', _2, _1, _3}). pattern() -> - ?LET_P(E, expr500(), parse_pattern(E)). + ?LET_P(E, expr(), parse_pattern(E)). %% -- Expressions ------------------------------------------------------------ @@ -297,7 +295,7 @@ comprehension_if() -> ?RULE(keyword('if'), parens(expr()), {comprehension_if, _1, _2}). comprehension_bind() -> - ?RULE(id(), tok('<-'), expr(), {comprehension_bind, _1, _3}). + ?RULE(pattern(), tok('<-'), expr(), {comprehension_bind, _1, _3}). arg_expr() -> ?LAZY_P( @@ -553,6 +551,8 @@ parse_pattern({list, Ann, Es}) -> {list, Ann, lists:map(fun parse_pattern/1, Es)}; parse_pattern({record, Ann, Fs}) -> {record, Ann, lists:map(fun parse_field_pattern/1, Fs)}; +parse_pattern({typed, Ann, E, Type}) -> + {typed, Ann, parse_pattern(E), Type}; parse_pattern(E = {con, _, _}) -> E; parse_pattern(E = {qcon, _, _}) -> E; parse_pattern(E = {id, _, _}) -> E; diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 6a362de..1979925 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -169,7 +169,7 @@ decl(D = {letfun, Attrs, _, _, _, _}) -> false -> "function" end, hsep(lists:map(Mod, Attrs) ++ [letdecl(Fun, D)]); -decl(D = {letval, _, _, _, _}) -> letdecl("let", D). +decl(D = {letval, _, _, _}) -> letdecl("let", D). -spec pragma(aeso_syntax:pragma()) -> doc(). pragma({compiler, Op, Ver}) -> @@ -193,8 +193,8 @@ name({tvar, _, Name}) -> text(Name); name({typed, _, Name, _}) -> name(Name). -spec letdecl(string(), aeso_syntax:letbind()) -> doc(). -letdecl(Let, {letval, _, F, T, E}) -> - block_expr(0, hsep([text(Let), typed(name(F), T), text("=")]), E); +letdecl(Let, {letval, _, P, E}) -> + block_expr(0, hsep([text(Let), expr(P), text("=")]), E); letdecl(Let, {letfun, _, F, Args, T, E}) -> block_expr(0, hsep([text(Let), typed(beside(name(F), args(Args)), T), text("=")]), E). @@ -459,7 +459,7 @@ elim1(Get={map_get, _, _}) -> elim(Get); elim1(Get={map_get, _, _, _}) -> elim(Get). alt({'case', _, Pat, Body}) -> - block_expr(0, hsep(expr_p(500, Pat), text("=>")), Body). + block_expr(0, hsep(expr(Pat), text("=>")), Body). block_expr(_, Header, {block, _, Ss}) -> block(Header, statements(Ss)); @@ -469,7 +469,7 @@ block_expr(P, Header, E) -> statements(Stmts) -> above([ statement(S) || S <- Stmts ]). -statement(S = {letval, _, _, _, _}) -> letdecl("let", S); +statement(S = {letval, _, _, _}) -> letdecl("let", S); statement(S = {letfun, _, _, _, _, _}) -> letdecl("let", S); statement(E) -> expr(E). diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index 66104b2..3c7ce56 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -47,7 +47,7 @@ -type pragma() :: {compiler, '==' | '<' | '>' | '=<' | '>=', compiler_version()}. -type letbind() - :: {letval, ann(), id(), type(), expr()} + :: {letval, ann(), pat(), expr()} | {letfun, ann(), id(), [arg()], type(), expr()}. -type arg() :: {arg, ann(), id(), type()}. @@ -112,7 +112,7 @@ -type record_or_map() :: record | map | record_or_map_error. --type comprehension_exp() :: [ {comprehension_bind, id(), expr()} +-type comprehension_exp() :: [ {comprehension_bind, pat(), expr()} | {comprehension_if, ann(), expr()} | letbind() ]. @@ -140,6 +140,7 @@ -type pat() :: {app, ann(), con() | op(), [pat()]} | {tuple, ann(), [pat()]} | {list, ann(), [pat()]} + | {typed, ann(), pat(), type()} | {record, ann(), [field(pat())]} | constant() | con() diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index 5aa43e9..b5618e5 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_decl, _, I, _} -> BindType(I); {type_def, _, I, _, D} -> Plus(BindType(I), Decl(D)); {fun_decl, _, _, T} -> Type(T); - {letval, _, F, T, E} -> Sum([BindExpr(F), Type(T), Expr(E)]); + {letval, _, P, E} -> Scoped(BindExpr(P), Expr(E)); {letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Expr(Xs ++ [E])]); %% typedef() {alias_t, T} -> Type(T); @@ -76,8 +76,8 @@ fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) -> Plus(Expr(E), Scoped(BindExpr(I), Expr({list_comp, A, Y, R}))); {list_comp, A, Y, [{comprehension_if, _, E}|R]} -> Plus(Expr(E), Expr({list_comp, A, Y, R})); - {list_comp, A, Y, [D = {letval, _, F, _, _} | R]} -> - Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R}))); + {list_comp, A, Y, [D = {letval, _, Pat, _} | R]} -> + Plus(Decl(D), Scoped(BindExpr(Pat), Expr({list_comp, A, Y, R}))); {list_comp, A, Y, [D = {letfun, _, F, _, _, _} | R]} -> Plus(Decl(D), Scoped(BindExpr(F), Expr({list_comp, A, Y, R}))); {typed, _, E, T} -> Plus(Expr(E), Type(T)); diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 3ddca8c..8a36646 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -163,7 +163,8 @@ compilable_contracts() -> "payable", "unapplied_builtins", "underscore_number_literals", - "qualified_constructor" + "qualified_constructor", + "let_patterns" ]. not_yet_compilable(fate) -> []; diff --git a/test/aeso_parser_tests.erl b/test/aeso_parser_tests.erl index ab585f3..09c4c3f 100644 --- a/test/aeso_parser_tests.erl +++ b/test/aeso_parser_tests.erl @@ -78,7 +78,7 @@ parse_string(Text, Opts) -> aeso_parser:string(Text, Opts). parse_expr(Text) -> - [{letval, _, _, _, Expr}] = + [{letval, _, _, Expr}] = parse_string("let _ = " ++ Text), Expr. diff --git a/test/contracts/let_patterns.aes b/test/contracts/let_patterns.aes new file mode 100644 index 0000000..3a2590e --- /dev/null +++ b/test/contracts/let_patterns.aes @@ -0,0 +1,13 @@ +contract LetPatterns = + + record r = {x : int, y : int, b : bool} + + entrypoint test() = foo([1, 0], (2, 3), Some(4), {x = 5, y = 6, b = false}) + + entrypoint foo(xs : list(int), p : int * int, some : option(int), r : r) = + let x :: _ = xs + let (a, b) = p + let Some(n) = some + let {x = i, y = j} = r + x + a + b + n + i + j + From ad5413496168fb8480c364fef6ccbbe7d224012a Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 16 Dec 2019 08:46:35 +0100 Subject: [PATCH 25/27] Parse negative literal patterns --- src/aeso_parser.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index 7109a46..c5f90cb 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -543,6 +543,8 @@ list_comp_e(Ann, Expr, Binds) -> {list_comp, Ann, Expr, Binds}. -spec parse_pattern(aeso_syntax:expr()) -> aeso_parse_lib:parser(aeso_syntax:pat()). parse_pattern({app, Ann, Con = {'::', _}, Es}) -> {app, Ann, Con, lists:map(fun parse_pattern/1, Es)}; +parse_pattern({app, Ann, {'-', _}, [{int, _, N}]}) -> + {int, Ann, -N}; parse_pattern({app, Ann, Con = {Tag, _, _}, Es}) when Tag == con; Tag == qcon -> {app, Ann, Con, lists:map(fun parse_pattern/1, Es)}; parse_pattern({tuple, Ann, Es}) -> From d019e44924010d5970c17f0c9192c3f275471e48 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 16 Dec 2019 08:46:58 +0100 Subject: [PATCH 26/27] Compile values to immediates when possible --- src/aeso_fcode_to_fate.erl | 54 +++++++++++++++++++++++--------------- 1 file changed, 33 insertions(+), 21 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index a6f70ff..47ff709 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -215,54 +215,66 @@ term_to_fate(Env, {'let', X, E, Body}) -> Env1 = Env#{ X => term_to_fate(Env, E) }, term_to_fate(Env1, Body); term_to_fate(Env, {var, X}) -> - maps:get(X, Env); + case maps:get(X, Env, undefined) of + undefined -> throw(not_a_fate_value); + V -> V + end; term_to_fate(_Env, {builtin, map_empty, []}) -> aeb_fate_data:make_map(#{}); term_to_fate(Env, {op, map_set, [M, K, V]}) -> Map = term_to_fate(Env, M), - Map#{term_to_fate(Env, K) => term_to_fate(Env, V)}. + Map#{term_to_fate(Env, K) => term_to_fate(Env, V)}; +term_to_fate(_Env, _) -> + throw(not_a_fate_value). -to_scode(_Env, {lit, L}) -> +to_scode(Env, T) -> + try term_to_fate(T) of + V -> [push(?i(V))] + catch throw:not_a_fate_value -> + to_scode1(Env, T) + end. + +to_scode1(_Env, {lit, L}) -> [push(?i(lit_to_fate(L)))]; -to_scode(_Env, nil) -> +to_scode1(_Env, nil) -> [aeb_fate_ops:nil(?a)]; -to_scode(Env, {var, X}) -> +to_scode1(Env, {var, X}) -> [push(lookup_var(Env, X))]; -to_scode(Env, {con, Ar, I, As}) -> +to_scode1(Env, {con, Ar, I, As}) -> N = length(As), [[to_scode(notail(Env), A) || A <- As], aeb_fate_ops:variant(?a, ?i(Ar), ?i(I), ?i(N))]; -to_scode(Env, {tuple, As}) -> +to_scode1(Env, {tuple, As}) -> N = length(As), [[ to_scode(notail(Env), A) || A <- As ], tuple(N)]; -to_scode(Env, {proj, E, I}) -> +to_scode1(Env, {proj, E, I}) -> [to_scode(notail(Env), E), aeb_fate_ops:element_op(?a, ?i(I), ?a)]; -to_scode(Env, {set_proj, R, I, E}) -> +to_scode1(Env, {set_proj, R, I, E}) -> [to_scode(notail(Env), E), to_scode(notail(Env), R), aeb_fate_ops:setelement(?a, ?i(I), ?a, ?a)]; -to_scode(Env, {op, Op, Args}) -> +to_scode1(Env, {op, Op, Args}) -> call_to_scode(Env, op_to_scode(Op), Args); -to_scode(Env, {'let', X, {var, Y}, Body}) -> +to_scode1(Env, {'let', X, {var, Y}, Body}) -> Env1 = bind_var(X, lookup_var(Env, Y), Env), to_scode(Env1, Body); -to_scode(Env, {'let', X, Expr, Body}) -> +to_scode1(Env, {'let', X, Expr, Body}) -> {I, Env1} = bind_local(X, Env), [ to_scode(notail(Env), Expr), aeb_fate_ops:store({var, I}, {stack, 0}), to_scode(Env1, Body) ]; -to_scode(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}) -> +to_scode1(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}) -> %% Tail-call to current function, f(e0..en). Compile to %% [ let xi = ei ] %% [ STORE argi xi ] @@ -280,17 +292,17 @@ to_scode(Env = #env{ current_function = Fun, tailpos = true }, {def, Fun, Args}) || {I, J} <- lists:zip(lists:seq(0, length(Vars) - 1), lists:reverse(Vars)) ], loop ]; -to_scode(Env, {def, Fun, Args}) -> +to_scode1(Env, {def, Fun, Args}) -> FName = make_function_id(Fun), Lbl = aeb_fate_data:make_string(FName), call_to_scode(Env, local_call(Env, ?i(Lbl)), Args); -to_scode(Env, {funcall, Fun, Args}) -> +to_scode1(Env, {funcall, Fun, Args}) -> call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args); -to_scode(Env, {builtin, B, Args}) -> +to_scode1(Env, {builtin, B, Args}) -> builtin_to_scode(Env, B, Args); -to_scode(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value | Args]}) -> +to_scode1(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value | Args]}) -> Lbl = make_function_id(Fun), {ArgTypes, RetType0} = typesig_to_scode([{"_", T} || T <- ArgsT], RetT), ArgType = ?i(aeb_fate_data:make_typerep({tuple, ArgTypes})), @@ -304,16 +316,16 @@ to_scode(Env, {remote, ArgsT, RetT, Ct, Fun, [Gas, Value | Args]}) -> call_to_scode(Env, Call, [Ct, Value, Gas | Args]) end; -to_scode(_Env, {get_state, Reg}) -> +to_scode1(_Env, {get_state, Reg}) -> [push(?s(Reg))]; -to_scode(Env, {set_state, Reg, Val}) -> +to_scode1(Env, {set_state, Reg, Val}) -> call_to_scode(Env, [{'STORE', ?s(Reg), ?a}, tuple(0)], [Val]); -to_scode(Env, {closure, Fun, FVs}) -> +to_scode1(Env, {closure, Fun, FVs}) -> to_scode(Env, {tuple, [{lit, {string, make_function_id(Fun)}}, FVs]}); -to_scode(Env, {switch, Case}) -> +to_scode1(Env, {switch, Case}) -> split_to_scode(Env, Case). local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_ops:call_t(Fun); From f7abaf07fab2d3e76b7ac3bbad53f177a29f63d6 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 16 Dec 2019 14:07:16 +0100 Subject: [PATCH 27/27] Add list comprehension match to test case --- test/contracts/let_patterns.aes | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/contracts/let_patterns.aes b/test/contracts/let_patterns.aes index 3a2590e..9ba1ba6 100644 --- a/test/contracts/let_patterns.aes +++ b/test/contracts/let_patterns.aes @@ -11,3 +11,5 @@ contract LetPatterns = let {x = i, y = j} = r x + a + b + n + i + j + entrypoint lc(xs : list(option(int))) : list(int) = + [ x | Some(x) <- xs ]