Merge pull request #77 from aeternity/fate-compiler-improvements

Update to new TUPLE instruction

rebar.config

@@ -2,8 +2,7 @@
 
 {erl_opts, [debug_info]}.
 
-{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git",
+{deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", {ref, "f129887"}}}
-                            {ref, "241a96e"}}}
        , {getopt, "1.0.1"}
        , {jsx, {git, "https://github.com/talentdeficit/jsx.git",
                      {tag, "2.8.0"}}}

rebar.lock

@@ -1,7 +1,7 @@
 {"1.1.0",
 [{<<"aebytecode">>,
   {git,"https://github.com/aeternity/aebytecode.git",
-       {ref,"241a96ebaa3e041781003cd20532a59ace87eb87"}},
+       {ref,"f1298870e526f4e9330447d3a281af5ef4e06e17"}},
   0},
  {<<"aeserialization">>,
   {git,"https://github.com/aeternity/aeserialization.git",

src/aeso_ast_to_fcode.erl

@@ -330,6 +330,19 @@ type_to_fcode(_Env, _Sub, Type) ->
 args_to_fcode(Env, Args) ->
     [ {Name, type_to_fcode(Env, Type)} || {arg, _, {id, _, Name}, Type} <- Args ].
 
+-define(make_let(X, Expr, Body),
+        make_let(Expr, fun(X) -> Body end)).
+
+make_let(Expr, Body) ->
+    case Expr of
+        {var, _}         -> Body(Expr);
+        {lit, {int, _}}  -> Body(Expr);
+        {lit, {bool, _}} -> Body(Expr);
+        _                ->
+            X = fresh_name(),
+            {'let', X, Expr, Body({var, X})}
+    end.
+
 -spec expr_to_fcode(env(), aeso_syntax:expr()) -> fexpr().
 expr_to_fcode(Env, {typed, _, Expr, Type}) ->
     expr_to_fcode(Env, Type, Expr);
@@ -415,17 +428,9 @@ expr_to_fcode(Env, _Type, {list, _, Es}) ->
 
 %% Conditionals
 expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) ->
-    Switch = fun(X) ->
+    make_if(expr_to_fcode(Env, Cond),
-                 {switch, {split, boolean, X,
+            expr_to_fcode(Env, Then),
-                    [{'case', {bool, false}, {nosplit, expr_to_fcode(Env, Else)}},
+            expr_to_fcode(Env, Else));
-                     {'case', {bool, true},  {nosplit, expr_to_fcode(Env, Then)}}]}}
-             end,
-    case Cond of
-        {var, X} -> Switch(X);
-        _          ->
-            X = fresh_name(),
-            {'let', X, expr_to_fcode(Env, Cond), Switch(X)}
-    end;
 
 %% Switch
 expr_to_fcode(Env, _, {switch, _, Expr = {typed, _, E, Type}, Alts}) ->
@@ -484,25 +489,24 @@ expr_to_fcode(Env, Type, {map, Ann, KVs}) ->
     Fields = [{field, Ann, [{map_get, Ann, K}], V} || {K, V} <- KVs],
     expr_to_fcode(Env, Type, {map, Ann, {map, Ann, []}, Fields});
 expr_to_fcode(Env, _Type, {map, _, Map, KVs}) ->
-    X    = fresh_name(),
+    ?make_let(Map1, expr_to_fcode(Env, Map),
-    Map1 = {var, X},
-    {'let', X, expr_to_fcode(Env, Map),
         lists:foldr(fun(Fld, M) ->
                         case Fld of
                             {field, _, [{map_get, _, K}], V} ->
                                 {op, map_set, [M, expr_to_fcode(Env, K), expr_to_fcode(Env, V)]};
                             {field_upd, _, [MapGet], {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], V}, _}} when element(1, MapGet) == map_get ->
-                                Y = fresh_name(),
                                 [map_get, _, K | Default] = tuple_to_list(MapGet),
-                                GetExpr =
+                                ?make_let(Key, expr_to_fcode(Env, K),
-                                    case Default of
+                                begin
-                                        []  -> {op, map_get, [Map1, {var, Y}]};
+                                    GetExpr =
-                                        [D] -> {op, map_get_d, [Map1, {var, Y}, expr_to_fcode(Env, D)]}
+                                        case Default of
-                                    end,
+                                            []  -> {op, map_get, [Map1, Key]};
-                                {'let', Y, expr_to_fcode(Env, K),
+                                            [D] -> {op, map_get_d, [Map1, Key, expr_to_fcode(Env, D)]}
-                                {'let', Z, GetExpr,
+                                        end,
-                                {op, map_set, [M, {var, Y}, expr_to_fcode(bind_var(Env, Z), V)]}}}
+                                    {'let', Z, GetExpr,
-                        end end, Map1, KVs)};
+                                    {op, map_set, [M, Key, expr_to_fcode(bind_var(Env, Z), V)]}}
+                                end)
+                        end end, Map1, KVs));
 expr_to_fcode(Env, _Type, {map_get, _, Map, Key}) ->
     {op, map_get, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)]};
 expr_to_fcode(Env, _Type, {map_get, _, Map, Key, Def}) ->
@@ -516,6 +520,14 @@ expr_to_fcode(Env, _Type, {lam, _, Args, Body}) ->
 expr_to_fcode(_Env, Type, Expr) ->
     error({todo, {Expr, ':', Type}}).
 
+make_if({var, X}, Then, Else) ->
+    {switch, {split, boolean, X,
+        [{'case', {bool, false}, {nosplit, Else}},
+         {'case', {bool, true},  {nosplit, Then}}]}};
+make_if(Cond, Then, Else) ->
+    X = fresh_name(),
+    {'let', X, Cond, make_if({var, X}, Then, Else)}.
+
 %% -- Pattern matching --
 
 -spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fsplit().
@@ -744,8 +756,14 @@ op_builtins() ->
      bits_set, bits_clear, bits_test, bits_sum, bits_intersection, bits_union,
      bits_difference, int_to_str, address_to_str].
 
-builtin_to_fcode(map_lookup, [Key, Map]) ->
+builtin_to_fcode(map_member, [Key, Map]) ->
-    {op, map_get, [Map, Key]};
+    {op, map_member, [Map, Key]};
+builtin_to_fcode(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]) ->
     {op, map_get_d, [Map, Key, Def]};
 builtin_to_fcode(Builtin, Args) ->

src/aeso_compiler.erl

@@ -75,23 +75,14 @@ file(File, Options) ->
     end.
 
 -spec from_string(binary() | string(), options()) -> {ok, map()} | {error, binary()}.
-from_string(ContractBin, Options) when is_binary(ContractBin) ->
+from_string(Contract, Options) ->
-    from_string(binary_to_list(ContractBin), Options);
+    from_string(proplists:get_value(backend, Options, aevm), Contract, Options).
-from_string(ContractString, Options) ->
+
+from_string(Backend, ContractBin, Options) when is_binary(ContractBin) ->
+    from_string(Backend, binary_to_list(ContractBin), Options);
+from_string(Backend, ContractString, Options) ->
     try
-        #{icode := Icode} = string_to_icode(ContractString, Options),
+        from_string1(Backend, ContractString, Options)
-        TypeInfo  = extract_type_info(Icode),
-        Assembler = assemble(Icode, Options),
-        pp_assembler(Assembler, Options),
-        ByteCodeList = to_bytecode(Assembler, Options),
-        ByteCode = << << B:8 >> || B <- ByteCodeList >>,
-        pp_bytecode(ByteCode, Options),
-        {ok, Version} = version(),
-        {ok, #{byte_code => ByteCode,
-               compiler_version => Version,
-               contract_source => ContractString,
-               type_info => TypeInfo
-              }}
     catch
         %% The compiler errors.
         error:{parse_errors, Errors} ->
@@ -104,6 +95,26 @@ from_string(ContractString, Options) ->
         %% General programming errors in the compiler just signal error.
     end.
 
+from_string1(aevm, ContractString, Options) ->
+    #{icode := Icode} = string_to_icode(ContractString, Options),
+    TypeInfo  = extract_type_info(Icode),
+    Assembler = assemble(Icode, Options),
+    pp_assembler(Assembler, Options),
+    ByteCodeList = to_bytecode(Assembler, Options),
+    ByteCode = << << B:8 >> || B <- ByteCodeList >>,
+    pp_bytecode(ByteCode, Options),
+    {ok, Version} = version(),
+    {ok, #{byte_code => ByteCode,
+           compiler_version => Version,
+           contract_source => ContractString,
+           type_info => TypeInfo
+          }};
+from_string1(fate, ContractString, Options) ->
+    Ast       = parse(ContractString, Options),
+    TypedAst  = aeso_ast_infer_types:infer(Ast, Options),
+    FCode     = aeso_ast_to_fcode:ast_to_fcode(TypedAst, Options),
+    {ok, aeso_fcode_to_fate:compile(FCode, Options)}.
+
 -spec string_to_icode(string(), [option()]) -> map().
 string_to_icode(ContractString, Options) ->
     Ast = parse(ContractString, Options),

src/aeso_fcode_to_fate.erl

@@ -39,6 +39,7 @@
 -define(i(X), {immediate, X}).
 -define(a, {stack, 0}).
 -define(s, {var, -1}).  %% TODO: until we have state support in FATE
+-define(void, {var, 9999}).
 
 -define(IsState(X), (is_tuple(X) andalso tuple_size(X) =:= 2 andalso element(1, X) =:= var andalso element(2, X) < 0)).
 
@@ -141,7 +142,7 @@ function_to_scode(ContractName, Functions, _Name, Args, Body, ResType, _Options)
     SCode    = to_scode(init_env(ContractName, Functions, Args), Body),
     {{ArgTypes, type_to_scode(ResType)}, SCode}.
 
-type_to_scode({variant, Cons}) -> {variant, lists:map(fun length/1, Cons)};
+type_to_scode({variant, Cons}) -> {variant, lists:map(fun(T) -> type_to_scode({tuple, T}) end, 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({map, Key, Val}) -> {map, type_to_scode(Key), type_to_scode(Val)};
@@ -159,7 +160,7 @@ add_default_init_function(SFuns, {tuple, []}) ->
             SFuns;
         error ->
             Sig = {[], {tuple, []}},
-            Body = [aeb_fate_ops:tuple(0)],
+            Body = [tuple(0)],
             SFuns#{ InitName => {Sig, Body} }
     end.
 
@@ -221,7 +222,7 @@ to_scode(Env, {con, Ar, I, As}) ->
 to_scode(Env, {tuple, As}) ->
     N = length(As),
     [[ to_scode(notail(Env), A) || A <- As ],
-     aeb_fate_ops:tuple(N)];
+     tuple(N)];
 
 to_scode(Env, {proj, E, I}) ->
     [to_scode(notail(Env), E),
@@ -396,7 +397,7 @@ builtin_to_scode(_Env, get_state, []) ->
     [push(?s)];
 builtin_to_scode(Env, set_state, [_] = Args) ->
     call_to_scode(Env, [aeb_fate_ops:store(?s, ?a),
-                        aeb_fate_ops:tuple(0)], Args);
+                        tuple(0)], Args);
 builtin_to_scode(_Env, event, [_] = _Args) ->
     ?TODO(fate_event_instruction);
 builtin_to_scode(_Env, map_empty, []) ->
@@ -409,7 +410,7 @@ builtin_to_scode(Env, abort, [_] = Args) ->
     call_to_scode(Env, aeb_fate_ops:abort(?a), Args);
 builtin_to_scode(Env, chain_spend, [_, _] = Args) ->
     call_to_scode(Env, [aeb_fate_ops:spend(?a, ?a),
-                        aeb_fate_ops:tuple(0)], Args);
+                        tuple(0)], Args);
 builtin_to_scode(Env, chain_balance, [_] = Args) ->
     call_to_scode(Env, aeb_fate_ops:balance_other(?a, ?a), Args);
 builtin_to_scode(Env, chain_block_hash, [_] = Args) ->
@@ -516,6 +517,9 @@ op_to_scode(int_to_str)        -> aeb_fate_ops:int_to_str(?a, ?a).
 %% easier, and specialize to PUSH (which is cheaper) at the end.
 push(A) -> aeb_fate_ops:store(?a, A).
 
+tuple(0) -> push(?i({tuple, {}}));
+tuple(N) -> aeb_fate_ops:tuple(?a, N).
+
 %% -- Phase II ---------------------------------------------------------------
 %%  Optimize
 
@@ -585,6 +589,7 @@ pp_ann(_, []) -> [].
 
 pp_arg(?i(I))    -> io_lib:format("~w", [I]);
 pp_arg({arg, N}) -> io_lib:format("arg~p", [N]);
+pp_arg({var, N}) when N < 0 -> io_lib:format("store~p", [-N]);
 pp_arg({var, N}) -> io_lib:format("var~p", [N]);
 pp_arg(?a)       -> "a".
 
@@ -605,7 +610,7 @@ ann_writes([{switch, Arg, Type, Alts, Def} | Code], Writes, Acc) ->
     Writes1 = ordsets:union(Writes, ordsets:intersection([WritesDef | WritesAlts])),
     ann_writes(Code, Writes1, [{switch, Arg, Type, Alts1, Def1} | Acc]);
 ann_writes([I | Code], Writes, Acc) ->
-    Ws = var_writes(I),
+    Ws = [ W || W <- var_writes(I), not ?IsState(W) ],
     Writes1 = ordsets:union(Writes, Ws),
     Ann = #{ writes_in => Writes, writes_out => Writes1 },
     ann_writes(Code, Writes1, [{i, Ann, I} | Acc]);
@@ -662,13 +667,13 @@ attributes(I) ->
         {'SWITCH_V3', A, _, _, _}             -> Impure(pc, A);
         {'SWITCH_VN', A, _}                   -> Impure(pc, A);
         {'PUSH', A}                           -> Pure(?a, A);
-        'DUPA'                                -> Pure(?a, []);
+        'DUPA'                                -> Pure(?a, ?a);
         {'DUP', A}                            -> Pure(?a, A);
         {'POP', A}                            -> Pure(A, ?a);
         {'STORE', A, B}                       -> Pure(A, B);
         'INCA'                                -> Pure(?a, ?a);
         {'INC', A}                            -> Pure(A, A);
-        'DECA'                                -> Pure(?a, []);
+        'DECA'                                -> Pure(?a, ?a);
         {'DEC', A}                            -> Pure(A, A);
         {'ADD', A, B, C}                      -> Pure(A, [B, C]);
         {'SUB', A, B, C}                      -> Pure(A, [B, C]);
@@ -685,7 +690,7 @@ attributes(I) ->
         {'AND', A, B, C}                      -> Pure(A, [B, C]);
         {'OR', A, B, C}                       -> Pure(A, [B, C]);
         {'NOT', A, B}                         -> Pure(A, B);
-        {'TUPLE', _}                          -> Pure(?a, []);
+        {'TUPLE', A, N}                       -> Pure(A, [?a || N > 0]);
         {'ELEMENT', A, B, C}                  -> Pure(A, [B, C]);
         {'SETELEMENT', A, B, C, D}            -> Pure(A, [B, C, D]);
         {'MAP_EMPTY', A}                      -> Pure(A, []);
@@ -870,8 +875,7 @@ merge_rules() ->
 
 rules() ->
     merge_rules() ++
-    [?RULE(r_dup_to_push),
+    [?RULE(r_swap_push),
-     ?RULE(r_swap_push),
      ?RULE(r_swap_write),
      ?RULE(r_constant_propagation),
      ?RULE(r_prune_impossible_branches),
@@ -880,11 +884,6 @@ rules() ->
     ].
 
 %% Removing pushes that are immediately consumed.
-r_push_consume({i, Ann1, {'STORE', ?a, A}}, [{i, Ann2, {'POP', B}} | Code]) ->
-    case live_out(B, Ann2) of
-        true  -> {[{i, merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code};
-        false -> {[], Code}
-    end;
 r_push_consume({i, Ann1, {'STORE', ?a, A}}, Code) ->
     inline_push(Ann1, A, 0, Code, []);
 %% Writing directly to memory instead of going through the accumulator.
@@ -930,14 +929,6 @@ split_stack_arg(N, [A | As], Acc) ->
             true    -> N end,
     split_stack_arg(N1, As, [A | Acc]).
 
-%% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations
-r_dup_to_push({i, Ann1, Push={'STORE', ?a, _}}, [{i, Ann2, 'DUPA'} | Code]) ->
-    #{ live_in  := LiveIn  } = Ann1,
-    Ann1_ = Ann1#{ live_out => LiveIn },
-    Ann2_ = Ann2#{ live_in  => LiveIn },
-    {[{i, Ann1_, Push}, {i, Ann2_, Push}], Code};
-r_dup_to_push(_, _) -> false.
-
 %% Move PUSH A past non-stack instructions.
 r_swap_push(Push = {i, _, {'STORE', ?a, _}}, [I | Code]) ->
     case independent(Push, I) of
@@ -1137,15 +1128,15 @@ r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
 r_one_shot_var(_, _) -> false.
 
 %% Remove writes to dead variables
+r_write_to_dead_var({i, _, {'STORE', ?void, ?a}}, _) -> false; %% Avoid looping
 r_write_to_dead_var({i, Ann, I}, Code) ->
     case op_view(I) of
         {_Op, R = {var, _}, As} ->
             case live_out(R, Ann) of
                 false ->
                     %% Subtle: we still have to pop the stack if any of the arguments
-                    %% came from there. In this case we pop to R, which we know is
+                    %% came from there.
-                    %% unused.
+                    {[{i, Ann, {'STORE', ?void, ?a}} || X <- As, X == ?a], Code};
-                    {[{i, Ann, {'POP', R}} || X <- As, X == ?a], Code};
                 true -> false
             end;
         _ -> false

test/aeso_compiler_tests.erl

@@ -16,20 +16,24 @@
 %%  are made on the output, just that it is a binary which indicates
 %%  that the compilation worked.
 simple_compile_test_() ->
-     [ {"Testing the " ++ ContractName ++ " contract",
+     [ {"Testing the " ++ ContractName ++ " contract with the " ++ atom_to_list(Backend) ++ " backend",
         fun() ->
-            case compile(ContractName) of
+            case compile(Backend, ContractName) of
                 #{byte_code := ByteCode,
                   contract_source := _,
-                  type_info := _} -> ?assertMatch(Code when is_binary(Code), ByteCode);
+                  type_info := _} when Backend == aevm ->
+                    ?assertMatch(Code when is_binary(Code), ByteCode);
+                Code when Backend == fate, is_tuple(Code) ->
+                    ?assertMatch(#{}, aeb_fate_code:functions(Code));
                 ErrBin ->
                     io:format("\n~s", [ErrBin]),
                     error(ErrBin)
             end
-        end} || ContractName <- compilable_contracts() ] ++
+        end} || ContractName <- compilable_contracts(), Backend <- [aevm, fate],
+                not lists:member(ContractName, not_yet_compilable(Backend))] ++
      [ {"Testing error messages of " ++ ContractName,
         fun() ->
-            case compile(ContractName) of
+            case compile(aevm, ContractName) of
                 <<"Type errors\n", ErrorString/binary>> ->
                     check_errors(lists:sort(ExpectedErrors), ErrorString);
                 <<"Parse errors\n", ErrorString/binary>> ->
@@ -44,14 +48,14 @@ simple_compile_test_() ->
                     {ok, Bin} = file:read_file(filename:join([aeso_test_utils:contract_path(), File])),
                     {File, Bin}
                   end || File <- ["included.aes", "../contracts/included2.aes"] ]),
-            #{byte_code := Code1} = compile("include", [{include, {explicit_files, FileSystem}}]),
+            #{byte_code := Code1} = compile(aevm, "include", [{include, {explicit_files, FileSystem}}]),
-            #{byte_code := Code2} = compile("include"),
+            #{byte_code := Code2} = compile(aevm, "include"),
             ?assertMatch(true, Code1 == Code2)
         end} ] ++
      [ {"Testing deadcode elimination",
         fun() ->
-            #{ byte_code := NoDeadCode } = compile("nodeadcode"),
+            #{ byte_code := NoDeadCode } = compile(aevm, "nodeadcode"),
-            #{ byte_code := DeadCode   } = compile("deadcode"),
+            #{ byte_code := DeadCode   } = compile(aevm, "deadcode"),
             SizeNoDeadCode = byte_size(NoDeadCode),
             SizeDeadCode   = byte_size(DeadCode),
             ?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + 40 < SizeNoDeadCode}),
@@ -67,12 +71,12 @@ check_errors(Expect, ErrorString) ->
         {Missing, Extra} -> ?assertEqual(Missing, Extra)
     end.
 
-compile(Name) ->
+compile(Backend, Name) ->
-    compile(Name, [{include, {file_system, [aeso_test_utils:contract_path()]}}]).
+    compile(Backend, Name, [{include, {file_system, [aeso_test_utils:contract_path()]}}]).
 
-compile(Name, Options) ->
+compile(Backend, Name, Options) ->
     String = aeso_test_utils:read_contract(Name),
-    case aeso_compiler:from_string(String, [{src_file, Name} | Options]) of
+    case aeso_compiler:from_string(String, [{src_file, Name}, {backend, Backend} | Options]) of
         {ok, Map}            -> Map;
         {error, ErrorString} -> ErrorString
     end.
@@ -112,6 +116,16 @@ compilable_contracts() ->
      "address_chain"
     ].
 
+not_yet_compilable(fate) ->
+    ["oracles",             %% Oracle.register
+     "events",              %% events
+     "basic_auth",          %% auth_tx_hash instruction
+     "bitcoin_auth",        %% auth_tx_hash instruction
+     "address_literals",    %% oracle_query_id literals
+     "address_chain"        %% Oracle.check_query
+    ];
+not_yet_compilable(aevm) -> [].
+
 %% Contracts that should produce type errors
 
 failing_contracts() ->