Merge pull request #129 from aeternity/deadcode-elim

Deadcode elimination for FATE

src/aeso_ast_to_fcode.erl

@@ -226,6 +226,9 @@ init_type_env() ->
        ["Chain", "ttl"] => ?type({variant, [[integer], [integer]]})
      }.
 
+is_no_code(Env) ->
+    proplists:get_value(no_code, maps:get(options, Env, []), false).
+
 %% -- Compilation ------------------------------------------------------------
 
 -spec to_fcode(env(), aeso_syntax:ast()) -> fcode().
@@ -244,7 +247,7 @@ to_fcode(Env, [{contract, Attrs, {con, _, Main}, Decls}]) ->
        state_type    => StateType,
        event_type    => EventType,
        payable       => Payable,
-       functions     => add_init_function(Env1,
+       functions     => add_init_function(Env1, StateType,
                         add_event_function(Env1, EventType, Funs)) };
 to_fcode(Env, [{contract, _, {con, _, Con}, Decls} | Code]) ->
     Env1 = decls_to_fcode(Env#{ context => {abstract_contract, Con} }, Decls),
@@ -268,7 +271,7 @@ decls_to_fcode(Env, Decls) ->
 -spec decl_to_fcode(env(), aeso_syntax:decl()) -> env().
 decl_to_fcode(Env, {type_decl, _, _, _}) -> Env;
 decl_to_fcode(Env = #{context := {main_contract, _}}, {fun_decl, Ann, {id, _, Name}, _}) ->
-    case proplists:get_value(no_code, maps:get(options, Env, []), false) of
+    case is_no_code(Env) of
         false -> fcode_error({missing_definition, Name, lists:keydelete(entrypoint, 1, Ann)});
         true  -> Env
     end;
@@ -852,16 +855,30 @@ builtin_to_fcode(Builtin, Args) ->
 
 %% -- Init function --
 
-add_init_function(_Env, Funs) ->
+add_init_function(Env, StateType, Funs0) ->
+    case is_no_code(Env) of
+        true  -> Funs0;
+        false ->
+            Funs     = add_default_init_function(Env, StateType, Funs0),
+            InitName = {entrypoint, <<"init">>},
+            InitFun  = #{ args := InitArgs } = maps:get(InitName, Funs, none),
+            Vars     = [ {var, X} || {X, _} <- InitArgs ],
+            Funs#{ init => InitFun#{ return => {tuple, []},
+                                     body   => {builtin, set_state, [{def, InitName, Vars}]} } }
+    end.
+
+add_default_init_function(_Env, StateType, Funs) ->
     InitName = {entrypoint, <<"init">>},
-    InitFun = #{ args := InitArgs } =
+    case maps:get(InitName, Funs, none) of
-        case maps:get(InitName, Funs, none) of
+        %% Only add default init function if state is unit.
-            none -> #{ attrs => [], args => [], return => {tuple, []}, body => {tuple, []} };
+        none when StateType == {tuple, []} ->
-            Info -> Info
+            Funs#{ InitName => #{attrs  => [],
-        end,
+                                 args   => [],
-    Vars = [ {var, X} || {X, _} <- InitArgs ],
+                                 return => {tuple, []},
-    Funs#{ init => InitFun#{ return => {tuple, []},
+                                 body   => {tuple, []}} };
-                             body   => {builtin, set_state, [{def, InitName, Vars}]} } }.
+        none -> fcode_error(missing_init_function);
+        _    -> Funs
+    end.
 
 %% -- Event function --
 
@@ -990,13 +1007,16 @@ lambda_lift_exprs(As) -> [lambda_lift_expr(A) || A <- As].
 
 -spec optimize_fcode(fcode()) -> fcode().
 optimize_fcode(Code = #{ functions := Funs }) ->
-    Code#{ functions := maps:map(fun(Name, Def) -> optimize_fun(Code, Name, Def) end, Funs) }.
+    Code1 = Code#{ functions := maps:map(fun(Name, Def) -> optimize_fun(Code, Name, Def) end, Funs) },
+    eliminate_dead_code(Code1).
 
 -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) }.
 
+%% --- Inlining ---
+
 -spec inliner(fcode(), fun_name(), fexpr()) -> fexpr().
 inliner(Fcode, Fun, {def, Fun1, Args} = E) when Fun1 /= Fun ->
     case should_inline(Fcode, Fun1) of
@@ -1009,6 +1029,33 @@ should_inline(_Fcode, _Fun1) -> false == list_to_atom("true").  %% Dialyzer
 
 inline(_Fcode, Fun, Args) -> {def, Fun, Args}. %% TODO
 
+%% --- Deadcode elimination ---
+
+-spec eliminate_dead_code(fcode()) -> fcode().
+eliminate_dead_code(Code = #{ functions := Funs }) ->
+    UsedFuns = used_functions(Funs),
+    Code#{ functions := maps:filter(fun(Name, _) -> maps:is_key(Name, UsedFuns) end,
+                                    Funs) }.
+
+-spec used_functions(#{ fun_name() => fun_def() }) -> #{ fun_name() => true }.
+used_functions(Funs) ->
+    Exported = [ Fun || {Fun, #{ attrs := Attrs }} <- maps:to_list(Funs),
+                        not lists:member(private, Attrs) ],
+    used_functions(#{}, Exported, Funs).
+
+used_functions(Used, [], _) -> Used;
+used_functions(Used, [Name | Rest], Defs) ->
+    case maps:is_key(Name, Used) of
+        true  -> used_functions(Used, Rest, Defs);
+        false ->
+            New =
+                case maps:get(Name, Defs, undef) of
+                    undef             -> []; %% We might be compiling a stub
+                    #{ body := Body } -> used_defs(Body)
+                end,
+            used_functions(Used#{ Name => true }, New ++ Rest, Defs)
+    end.
+
 %% -- Helper functions -------------------------------------------------------
 
 %% -- Types --
@@ -1178,6 +1225,34 @@ free_vars(Expr) ->
         {'case', P, A}       -> free_vars(A) -- lists:sort(fsplit_pat_vars(P))
     end.
 
+used_defs(Xs) when is_list(Xs) ->
+    lists:umerge([ used_defs(X) || X <- Xs ]);
+used_defs(Expr) ->
+    case Expr of
+        {var, _}             -> [];
+        {lit, _}             -> [];
+        nil                  -> [];
+        {def, F, As}         -> lists:umerge([F], used_defs(As));
+        {def_u, F, _}        -> [F];
+        {remote, _, _, Ct, _, As} -> used_defs([Ct | As]);
+        {remote_u, _, _, Ct, _}   -> used_defs(Ct);
+        {builtin, _, As}     -> used_defs(As);
+        {builtin_u, _, _}    -> [];
+        {con, _, _, As}      -> used_defs(As);
+        {tuple, As}          -> used_defs(As);
+        {proj, A, _}         -> used_defs(A);
+        {set_proj, A, _, B}  -> used_defs([A, B]);
+        {op, _, As}          -> used_defs(As);
+        {'let', _, A, B}     -> used_defs([A, B]);
+        {funcall, A, Bs}     -> used_defs([A | Bs]);
+        {lam, _, B}          -> used_defs(B);
+        {closure, F, A}      -> lists:umerge([F], used_defs(A));
+        {switch, A}          -> used_defs(A);
+        {split, _, _, As}    -> used_defs(As);
+        {nosplit, A}         -> used_defs(A);
+        {'case', _, A}       -> used_defs(A)
+    end.
+
 get_named_args(NamedArgsT, Args) ->
     IsNamed = fun({named_arg, _, _, _}) -> true;
                  (_) -> false end,

src/aeso_fcode_to_fate.erl

@@ -130,12 +130,10 @@ debug(Tag, Options, Fmt, Args) ->
 %% @doc Main entry point.
 compile(FCode, Options) ->
     #{ contract_name := ContractName,
-       state_type    := StateType,
        functions     := Functions } = FCode,
     SFuns  = functions_to_scode(ContractName, Functions, Options),
     SFuns1 = optimize_scode(SFuns, Options),
-    SFuns2 = add_default_init_function(SFuns1, StateType),
+    FateCode = to_basic_blocks(SFuns1),
-    FateCode = to_basic_blocks(SFuns2),
     debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]),
     FateCode.
 
@@ -196,21 +194,6 @@ type_to_scode({tvar, X}) ->
         J -> {tvar, J}
     end.
 
-add_default_init_function(SFuns, StateType) when StateType /= {tuple, []} ->
-    %% Only add default if the type is unit.
-    SFuns;
-add_default_init_function(SFuns, {tuple, []}) ->
-    %% Only add default if the init function is not present
-    InitName = make_function_name({entrypoint, <<"init">>}),
-    case maps:find(InitName, SFuns) of
-        {ok, _} ->
-            SFuns;
-        error ->
-            Sig = {[], {tuple, []}},
-            Body = [tuple(0)],
-            SFuns#{ InitName => {[], Sig, Body} }
-    end.
-
 %% -- Phase I ----------------------------------------------------------------
 %%  Icode to structured assembly
 

test/aeso_compiler_tests.erl

@@ -53,15 +53,17 @@ simple_compile_test_() ->
             #{byte_code := Code2} = compile(aevm, "include"),
             ?assertMatch(true, Code1 == Code2)
         end} ] ++
-     [ {"Testing deadcode elimination",
+     [ {"Testing deadcode elimination for " ++ atom_to_list(Backend),
         fun() ->
-            #{ byte_code := NoDeadCode } = compile(aevm, "nodeadcode"),
+            #{ byte_code := NoDeadCode } = compile(Backend, "nodeadcode"),
-            #{ byte_code := DeadCode   } = compile(aevm, "deadcode"),
+            #{ byte_code := DeadCode   } = compile(Backend, "deadcode"),
             SizeNoDeadCode = byte_size(NoDeadCode),
             SizeDeadCode   = byte_size(DeadCode),
-            ?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + 40 < SizeNoDeadCode}),
+            Delta          = if Backend == aevm -> 40;
+                                Backend == fate -> 20 end,
+            ?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + Delta < SizeNoDeadCode}),
             ok
-        end} ].
+        end} || Backend <- [aevm, fate] ].
 
 check_errors(Expect, ErrorString) ->
     %% This removes the final single \n as well.