From 0cf6a52b268ece57db36c014e9f6087ba5819739 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 25 Jun 2019 14:54:01 +0200 Subject: [PATCH] Compile events to FATE --- src/aeso_ast_infer_types.erl | 2 ++ src/aeso_ast_to_fcode.erl | 66 ++++++++++++++++++++++++++++-------- src/aeso_fcode_to_fate.erl | 16 +++++---- src/aeso_pretty.erl | 1 + 4 files changed, 64 insertions(+), 21 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 3d9a760..8df2359 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -772,11 +772,13 @@ is_word_type({id, _, Name}) -> lists:member(Name, ["int", "address", "hash", "bits", "bool"]); is_word_type({app_t, _, {id, _, Name}, [_, _]}) -> lists:member(Name, ["oracle", "oracle_query"]); +is_word_type({bytes_t, _, [N]}) -> N =< 32; is_word_type({con, _, _}) -> true; is_word_type({qcon, _, _}) -> true; is_word_type(_) -> false. is_string_type({id, _, "string"}) -> true; +is_string_type({bytes_t, _, _}) -> true; is_string_type(_) -> false. -spec check_constructor_overlap(env(), aeso_syntax:con(), type()) -> ok | no_return(). diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index ecb00a5..1d2262f 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -16,11 +16,11 @@ -type option() :: term(). --type attribute() :: stateful | pure. +-type attribute() :: stateful | pure | private. -type fun_name() :: {entrypoint, binary()} | {local_fun, [string()]} - | init. + | init | event. -type var_name() :: string(). -type sophia_name() :: [string()]. @@ -127,14 +127,15 @@ | {namespace, string()} | {abstract_contract, string()}. --type env() :: #{ type_env := type_env(), - fun_env := fun_env(), - con_env := con_env(), - builtins := builtins(), - options := [option()], - context => context(), - vars => [var_name()], - functions := #{ fun_name() => fun_def() } }. +-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() } }. %% -- Entrypoint ------------------------------------------------------------- @@ -229,7 +230,7 @@ to_fcode(Env, [{contract, _, {con, _, Main}, Decls}]) -> MainEnv = Env#{ context => {main_contract, Main}, builtins => Builtins#{[Main, "state"] => {get_state, none}, [Main, "put"] => {set_state, 1}, - [Main, "Chain", "event"] => {event, 1}} }, + [Main, "Chain", "event"] => {chain_event, 1}} }, #{ functions := Funs } = Env1 = decls_to_fcode(MainEnv, Decls), StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}), @@ -237,7 +238,7 @@ to_fcode(Env, [{contract, _, {con, _, Main}, Decls}]) -> #{ contract_name => Main, state_type => StateType, event_type => EventType, - functions => Funs }; + functions => add_event_function(Env1, EventType, Funs) }; to_fcode(Env, [{contract, _, {con, _, Con}, Decls} | Code]) -> Env1 = decls_to_fcode(Env#{ context => {abstract_contract, Con} }, Decls), to_fcode(Env1, Code); @@ -303,7 +304,11 @@ typedef_to_fcode(Env, {id, _, Name}, Xs, Def) -> _ -> #{} end, Env1 = bind_constructors(Env, Constructors), - bind_type(Env1, Q, FDef). + Env2 = case Name of + "event" -> Env1#{ event_type => Def }; + _ -> Env1 + end, + bind_type(Env2, Q, FDef). -spec type_to_fcode(env(), aeso_syntax:type()) -> ftype(). type_to_fcode(Env, Type) -> @@ -788,6 +793,8 @@ op_builtins() -> builtin_to_fcode(require, [Cond, Msg]) -> make_if(Cond, {tuple, []}, {builtin, abort, [Msg]}); +builtin_to_fcode(chain_event, [Event]) -> + {def, event, [Event]}; builtin_to_fcode(map_delete, [Key, Map]) -> {op, map_delete, [Map, Key]}; builtin_to_fcode(map_member, [Key, Map]) -> @@ -806,6 +813,36 @@ builtin_to_fcode(Builtin, Args) -> false -> {builtin, Builtin, Args} end. +%% -- Event function -- + +add_event_function(_Env, none, Funs) -> Funs; +add_event_function(Env, EventFType, Funs) -> + Funs#{ event => event_function(Env, EventFType) }. + +event_function(_Env = #{event_type := {variant_t, EventCons}}, EventType = {variant, FCons}) -> + Cons = [ {Name, I - 1, proplists:get_value(indices, Ann)} + || {I, {constr_t, Ann, {con, _, Name}, _}} <- indexed(EventCons) ], + Arities = [length(Ts) || Ts <- FCons], + io:format("Cons = ~p\nEventFType = ~p\n", [Cons, EventType]), + Case = fun({Name, Tag, Ixs}) -> + %% TODO: precompute (needs dependency) + Hash = {op, crypto_sha3, [{lit, {string, list_to_binary(Name)}}]}, + Vars = [ "arg" ++ integer_to_list(I) || I <- lists:seq(1, length(Ixs)) ], + IVars = lists:zip(Ixs, Vars), + Payload = + case [ V || {notindexed, V} <- IVars ] of + [] -> {lit, {string, <<>>}}; + [V] -> {var, V} + end, + Indices = [ {var, V} || {indexed, V} <- IVars ], + Body = {builtin, chain_event, [Payload, Hash | Indices]}, + {'case', {con, Arities, Tag, Vars}, {nosplit, Body}} + end, + #{ attrs => [stateful, private], + args => [{"e", EventType}], + return => {tuple, []}, + body => {switch, {split, EventType, "e", lists:map(Case, Cons)}} }. + %% -- Lambda lifting --------------------------------------------------------- %% The expr_to_fcode compiler lambda expressions to {lam, Xs, Body}, but in %% FATE we can only call top-level functions, so we need to lift the lambda to @@ -1237,7 +1274,8 @@ pp_fun(Name, #{ args := Args, return := Return, body := Body }) -> pp_text(" : "), pp_ftype(Return), pp_text(" =")]), prettypr:nest(2, pp_fexpr(Body))). -pp_fun_name(init) -> pp_text("init"); +pp_fun_name(init) -> pp_text(init); +pp_fun_name(event) -> pp_text(event); pp_fun_name({entrypoint, E}) -> pp_text(binary_to_list(E)); pp_fun_name({local_fun, Q}) -> pp_text(string:join(Q, ".")). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index a86ec74..f6c776f 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -140,6 +140,7 @@ make_function_id(X) -> aeb_fate_code:symbol_identifier(make_function_name(X)). make_function_name(init) -> <<"init">>; +make_function_name(event) -> <<"Chain.event">>; make_function_name({entrypoint, Name}) -> Name; make_function_name({local_fun, Xs}) -> list_to_binary("." ++ string:join(Xs, ".")). @@ -469,8 +470,9 @@ builtin_to_scode(_Env, get_state, []) -> builtin_to_scode(Env, set_state, [_] = Args) -> call_to_scode(Env, [aeb_fate_ops:store(?s, ?a), tuple(0)], Args); -builtin_to_scode(_Env, event, [_] = _Args) -> - ?TODO(fate_event_instruction); +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); builtin_to_scode(_Env, map_empty, []) -> [aeb_fate_ops:map_empty(?a)]; builtin_to_scode(_Env, bits_none, []) -> @@ -844,11 +846,11 @@ attributes(I) -> {'DIFFICULTY', A} -> Pure(A, []); {'GASLIMIT', A} -> Pure(A, []); {'GAS', A} -> Impure(?a, A); - {'LOG0', A, B} -> Impure(none, [A, B]); - {'LOG1', A, B, C} -> Impure(none, [A, B, C]); - {'LOG2', A, B, C, D} -> Impure(none, [A, B, C, D]); - {'LOG3', A, B, C, D, E} -> Impure(none, [A, B, C, D, E]); - {'LOG4', A, B, C, D, E, F} -> Impure(none, [A, B, C, D, E, F]); + {'LOG0', A} -> Impure(none, [A]); + {'LOG1', A, B} -> Impure(none, [A, B]); + {'LOG2', A, B, C} -> Impure(none, [A, B, C]); + {'LOG3', A, B, C, D} -> Impure(none, [A, B, C, D]); + {'LOG4', A, B, C, D, E} -> Impure(none, [A, B, C, D, E]); 'DEACTIVATE' -> Impure(none, []); {'SPEND', A, B} -> Impure(none, [A, B]); diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 8762cf7..5e6314f 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -330,6 +330,7 @@ expr_p(_, {Type, _, Bin}) Type == oracle_pubkey; Type == oracle_query_id -> text(binary_to_list(aeser_api_encoder:encode(Type, Bin))); +expr_p(_, {string, _, <<>>}) -> text("\"\""); expr_p(_, {string, _, S}) -> term(binary_to_list(S)); expr_p(_, {char, _, C}) -> case C of