Compile events to FATE

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

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()].
 
@@ -130,6 +130,7 @@
 -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(),
@@ -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, ".")).
 

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) ->
+builtin_to_scode(Env, chain_event, Args) ->
-    ?TODO(fate_event_instruction);
+    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]);
+        {'LOG0', A}                           -> Impure(none, [A]);
-        {'LOG1', A, B, C}                     -> Impure(none, [A, B, C]);
+        {'LOG1', A, B}                        -> Impure(none, [A, B]);
-        {'LOG2', A, B, C, D}                  -> Impure(none, [A, B, C, D]);
+        {'LOG2', A, B, C}                     -> Impure(none, [A, B, C]);
-        {'LOG3', A, B, C, D, E}               -> Impure(none, [A, B, C, D, E]);
+        {'LOG3', A, B, C, D}                  -> Impure(none, [A, B, C, D]);
-        {'LOG4', A, B, C, D, E, F}            -> Impure(none, [A, B, C, D, E, F]);
+        {'LOG4', A, B, C, D, E}               -> Impure(none, [A, B, C, D, E]);
         'DEACTIVATE'                          -> Impure(none, []);
         {'SPEND', A, B}                       -> Impure(none, [A, 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