Merge branch 'master' into symbols-map

CONTRIBUTING.md

@@ -10,6 +10,8 @@ The following points should be considered before creating a new PR to the Sophia
 - If a PR introduces a new feature that is relevant to the users of the language, the [Sophia Features Documentation](docs/sophia_features.md) should be updated to describe the new feature.
 - If a PR introduces new syntax (e.g. changes in [aeso_syntax.erl](src/aeso_syntax.erl), [aeso_scan.erl](src/aeso_scan.erl), or [aeso_parser.erl](src/aeso_parser.erl)), the [Sophia Syntax Documentation](docs/sophia_syntax.md) should be updated to include the new syntax.
 - If a PR introduces a new library, the public interface of the new library should be fully documented in the [Sophia Standard Library Documentation](docs/sophia_stdlib.md).
+- If a PR introduces a new compiler option, the new option should be documented in the file
+[aeso_compiler.md](docs/aeso_compiler.md).
 
 ### Tests
 

docs/aeso_compiler.md

@@ -53,6 +53,32 @@ The **pp_** options all print to standard output the following:
 
 The option `include_child_contract_symbols` includes the symbols of child contracts functions in the generated fate code. It is turned off by default to avoid making contracts bigger on chain.
 
+#### Options to control which compiler optimizations should run:
+
+By default all optimizations are turned on, to disable an optimization, it should be
+explicitly set to false and passed as a compiler option.
+
+List of optimizations:
+
+- optimize_inliner
+- optimize_inline_local_functions
+- optimize_bind_subexpressions
+- optimize_let_floating
+- optimize_simplifier
+- optimize_drop_unused_lets
+- optimize_push_consume
+- optimize_one_shot_var
+- optimize_write_to_dead_var
+- optimize_inline_switch_target
+- optimize_swap_push
+- optimize_swap_pop
+- optimize_swap_write
+- optimize_constant_propagation
+- optimize_prune_impossible_branches
+- optimize_single_successful_branch
+- optimize_inline_store
+- optimize_float_switch_bod
+
 #### check_call(ContractString, Options) -> CheckRet
 
 Types

src/aeso_ast_infer_types.erl

@@ -837,6 +837,7 @@ infer(Contracts, Options) ->
         ets_new(type_vars, [set]),
         ets_new(warnings, [bag]),
         ets_new(type_vars_variance, [set]),
+        ets_new(functions_to_implement, [set]),
         %% Set the variance for builtin types
         ets_insert(type_vars_variance, {"list", [covariant]}),
         ets_insert(type_vars_variance, {"option", [covariant]}),
@@ -887,9 +888,10 @@ infer1(Env0, [{Contract, Ann, ConName, Impls, Code} | Rest], Acc, Options)
         contract -> ets_insert(defined_contracts, {qname(ConName)});
         contract_interface -> ok
     end,
+    populate_functions_to_implement(Env, ConName, Impls, Acc),
     {Env1, Code1} = infer_contract_top(push_scope(contract, ConName, Env), What, Code, Options),
+    report_unimplemented_functions(Env, ConName),
     Contract1 = {Contract, Ann, ConName, Impls, Code1},
-    check_implemented_interfaces(Env1, Contract1, Acc),
     Env2 = pop_scope(Env1),
     Env3 = bind_contract(Contract1, Env2),
     infer1(Env3, Rest, [Contract1 | Acc], Options);
@@ -909,54 +911,52 @@ infer1(Env, [{pragma, _, _} | Rest], Acc, Options) ->
     %% Pragmas are checked in check_modifiers
     infer1(Env, Rest, Acc, Options).
 
-check_implemented_interfaces(Env, {_Contract, _Ann, ConName, Impls, Code}, DefinedContracts) ->
+%% Report all functions that were not implemented by the contract ContractName.
+-spec report_unimplemented_functions(env(), ContractName) -> ok | no_return() when
+      ContractName :: aeso_syntax:con().
+report_unimplemented_functions(Env, ContractName) ->
     create_type_errors(),
-    AllInterfaces = [{name(IName), I} || I = {contract_interface, _, IName, _, _} <- DefinedContracts],
+    [ type_error({unimplemented_interface_function, ContractName, name(I), FunName})
-    ImplsNames = lists:map(fun name/1, Impls),
+      || {FunName, I, _} <- ets_tab2list(functions_to_implement) ],
-
-    %% All implemented intrefaces should already be defined
-    lists:foreach(fun(Impl) -> case proplists:get_value(name(Impl), AllInterfaces) of
-                                   undefined -> type_error({referencing_undefined_interface, Impl});
-                                   _         -> ok
-                               end
-                  end, Impls),
-
-    ImplementedInterfaces = [I || I <- [proplists:get_value(Name, AllInterfaces) || Name <- ImplsNames],
-                                    I /= undefined],
-    Funs = [ Fun || Fun <- Code,
-                    element(1, Fun) == letfun orelse element(1, Fun) == fun_decl ],
-    check_implemented_interfaces1(Env, ImplementedInterfaces, ConName, Funs, AllInterfaces),
     destroy_and_report_type_errors(Env).
 
-%% Recursively check that all directly and indirectly referenced interfaces are implemented
+%% Return a list of all function declarations to be implemented, given the list
-check_implemented_interfaces1(_, [], _, _, _) ->
+%% of interfaces to be implemented Impls and all the previously defined
-    ok;
+%% contracts DefinedContracts>
-check_implemented_interfaces1(Env, [{contract_interface, _, IName, _, Decls} | Interfaces],
+-spec functions_to_implement(Impls, DefinedContracts) -> [{InterfaceCon, FunDecl}] when
-                              ConId, Impls, AllInterfaces) ->
+      Impls :: [aeso_syntax:con()],
-    Unmatched = match_impls(Env, Decls, ConId, name(IName), Impls),
+      DefinedContracts :: [aeso_syntax:decl()],
-    check_implemented_interfaces1(Env, Interfaces, ConId, Unmatched, AllInterfaces).
+      InterfaceCon :: aeso_syntax:con(),
+      FunDecl :: aeso_syntax:fundecl().
+functions_to_implement(Impls, DefinedContracts) ->
+    ImplsNames = [ name(I) || I <- Impls ],
+    Interfaces = [ I || I = {contract_interface, _, Con, _, _} <- DefinedContracts,
+                        lists:member(name(Con), ImplsNames) ],
 
-%% Match the functions of the contract with the interfaces functions, and return unmatched functions
+    %% All implemented intrefaces should already be defined
-match_impls(_, [], _, _, Impls) ->
+    InterfacesNames = [name(element(3, I)) || I <- Interfaces],
-    Impls;
+    [ begin
-match_impls(Env, [{fun_decl, _, {id, _, FunName}, FunType = {fun_t, _, _, ArgsTypes, RetDecl}} | Decls], ConId, IName, Impls) ->
+        Found = lists:member(name(Impl), InterfacesNames),
-    Match = fun({letfun, _, {id, _, FName}, Args, RetFun, _}) when FName == FunName ->
+        Found orelse type_error({referencing_undefined_interface, Impl})
-                    length(ArgsTypes) == length(Args) andalso
+      end || Impl <- Impls
-                    unify(Env#env{unify_throws = false}, RetDecl, RetFun, unknown) andalso
+    ],
-                    lists:all(fun({T1, {typed, _, _, T2}}) -> unify(Env#env{unify_throws = false}, T1, T2, unknown) end,
+
-                              lists:zip(ArgsTypes, Args));
+    lists:flatten([ [ {Con, Decl} || Decl <- Decls] || {contract_interface, _, Con, _, Decls} <- Interfaces ]).
-               ({fun_decl, _, {id, _, FName}, FunT}) when FName == FunName ->
+
-                    unify(Env#env{unify_throws = false}, FunT, FunType, unknown);
+%% Fill the ets table functions_to_implement with functions from the implemented
-               (_) -> false
+%% interfaces Impls.
-            end,
+-spec populate_functions_to_implement(env(), ContractName, Impls, DefinedContracts) -> ok | no_return() when
-    UnmatchedImpls = case lists:search(Match, Impls) of
+      ContractName :: aeso_syntax:con(),
-                         {value, V} ->
+      Impls :: [aeso_syntax:con()],
-                             lists:delete(V, Impls);
+      DefinedContracts :: [aeso_syntax:decl()].
-                         false ->
+populate_functions_to_implement(Env, ContractName, Impls, DefinedContracts) ->
-                             type_error({unimplemented_interface_function, ConId, IName, FunName}),
+    create_type_errors(),
-                             Impls
+    [ begin
-                     end,
+        Inserted = ets_insert_new(functions_to_implement, {name(Id), I, Decl}),
-    match_impls(Env, Decls, ConId, IName, UnmatchedImpls).
+        [{_, I2, _}] = ets_lookup(functions_to_implement, name(Id)),
+        Inserted orelse type_error({interface_implementation_conflict, ContractName, I, I2, Id})
+      end || {I, Decl = {fun_decl, _, Id, _}} <- functions_to_implement(Impls, DefinedContracts) ],
+    destroy_and_report_type_errors(Env).
 
 %% Asserts that the main contract is somehow defined.
 identify_main_contract(Contracts, Options) ->
@@ -1466,15 +1466,32 @@ check_reserved_entrypoints(Funs) ->
 -spec check_fundecl(env(), aeso_syntax:decl()) -> {{name(), typesig()}, aeso_syntax:decl()}.
 check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type = {fun_t, _, _, _, _}}) ->
     Type1 = {fun_t, _, Named, Args, Ret} = check_type(Env, Type),
-    {{Name, {type_sig, Ann, none, Named, Args, Ret}}, {fun_decl, Ann, Id, Type1}};
+    TypeSig = {type_sig, Ann, none, Named, Args, Ret},
+    register_implementation(Env, Name),
+    {{Name, TypeSig}, {fun_decl, Ann, Id, Type1}};
 check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type}) ->
     type_error({fundecl_must_have_funtype, Ann, Id, Type}),
     {{Name, {type_sig, Ann, none, [], [], Type}}, check_type(Env, Type)}.
 
+%% Register the function FunName as implemented by deleting it from the functions
+%% to be implemented table if it is included there, or return true otherwise.
+-spec register_implementation(env(), FunName) -> true | no_return() when
+      FunName :: string().
+register_implementation(Env, Name) ->
+    case ets_lookup(functions_to_implement, Name) of
+        [{Name, _, {fun_decl, _, _, DeclType}}] ->
+            ets_delete(functions_to_implement, Name);
+        [] ->
+            true;
+        _ ->
+            error("Ets set has multiple keys")
+    end.
+
 infer_nonrec(Env, LetFun) ->
     create_constraints(),
-    NewLetFun = infer_letfun(Env, LetFun),
+    NewLetFun = {{FunName, FunSig}, _} = infer_letfun(Env, LetFun),
     check_special_funs(Env, NewLetFun),
+    register_implementation(Env, FunName),
     solve_then_destroy_and_report_unsolved_constraints(Env),
     Result = {TypeSig, _} = instantiate(NewLetFun),
     print_typesig(TypeSig),
@@ -1504,6 +1521,7 @@ infer_letrec(Env, Defs) ->
     Inferred =
         [ begin
             Res    = {{Name, TypeSig}, _} = infer_letfun(ExtendEnv, LF),
+            register_implementation(Env, Name),
             Got    = proplists:get_value(Name, Funs),
             Expect = typesig_to_fun_t(TypeSig),
             unify(Env, Got, Expect, {check_typesig, Name, Got, Expect}),
@@ -2204,7 +2222,7 @@ next_count() ->
 ets_tables() ->
     [options, type_vars, constraints, freshen_tvars, type_errors,
      defined_contracts, warnings, function_calls, all_functions,
-     type_vars_variance].
+     type_vars_variance, functions_to_implement].
 
 clean_up_ets() ->
     [ catch ets_delete(Tab) || Tab <- ets_tables() ],
@@ -2240,10 +2258,18 @@ ets_delete(Name) ->
     put(aeso_ast_infer_types, maps:remove(Name, Tabs)),
     ets:delete(TabId).
 
+ets_delete(Name, Key) ->
+    TabId = ets_tabid(Name),
+    ets:delete(TabId, Key).
+
 ets_insert(Name, Object) ->
     TabId = ets_tabid(Name),
     ets:insert(TabId, Object).
 
+ets_insert_new(Name, Object) ->
+    TabId = ets_tabid(Name),
+    ets:insert_new(TabId, Object).
+
 ets_lookup(Name, Key) ->
     TabId = ets_tabid(Name),
     ets:lookup(TabId, Key).
@@ -2828,6 +2854,12 @@ unify1(Env, [A|B], [C|D], Variance, When) ->
     unify0(Env, A, C, Variance, When) andalso unify0(Env, B, D, Variance, When);
 unify1(_Env, X, X, _Variance, _When) ->
     true;
+unify1(_Env, _A, {id, _, "void"}, Variance, _When)
+  when Variance == covariant orelse Variance == bivariant ->
+    true;
+unify1(_Env, {id, _, "void"}, _B, Variance, _When)
+  when Variance == contravariant orelse Variance == bivariant ->
+    true;
 unify1(_Env, {id, _, Name}, {id, _, Name}, _Variance, _When) ->
     true;
 unify1(Env, A = {con, _, NameA}, B = {con, _, NameB}, Variance, When) ->
@@ -3643,6 +3675,11 @@ mk_error({invalid_oracle_type, Why, What, Ann, Type}) ->
     Msg = io_lib:format("Invalid oracle type\n~s`", [pp_type("  `", Type)]),
     Cxt = io_lib:format("The ~s type must not be ~s", [What, WhyS]),
     mk_t_err(pos(Ann), Msg, Cxt);
+mk_error({interface_implementation_conflict, Contract, I1, I2, Fun}) ->
+    Msg = io_lib:format("Both interfaces `~s` and `~s` implemented by "
+                        "the contract `~s` have a function called `~s`",
+                        [name(I1), name(I2), name(Contract), name(Fun)]),
+    mk_t_err(pos(Contract), Msg);
 mk_error(Err) ->
     Msg = io_lib:format("Unknown error: ~p", [Err]),
     mk_t_err(pos(0, 0), Msg).

src/aeso_fcode_to_fate.erl

@@ -716,13 +716,8 @@ tuple(N) -> aeb_fate_ops:tuple(?a, N).
 %%  Optimize
 
 optimize_scode(Funs, Options) ->
-    case proplists:get_value(optimize_scode, Options, true) of
-        true ->
     maps:map(fun(Name, Def) -> optimize_fun(Funs, Name, Def, Options) end,
-                    Funs);
+            Funs).
-        false ->
-            Funs
-    end.
 
 flatten(missing) -> missing;
 flatten(Code)    -> lists:map(fun flatten_s/1, lists:flatten(Code)).
@@ -1105,7 +1100,8 @@ simpl_top(I, Code, Options) ->
 simpl_top(0, I, Code, _Options) ->
     code_error({optimizer_out_of_fuel, I, Code});
 simpl_top(Fuel, I, Code, Options) ->
-    apply_rules(Fuel, rules(), I, Code, Options).
+    Rules = [R || R = {Rule, _} <- rules(), proplists:get_value(Rule, Options, true)],
+    apply_rules(Fuel, Rules, I, Code, Options).
 
 apply_rules(Fuel, Rules, I, Code, Options) ->
     Cons = fun(X, Xs) -> simpl_top(Fuel - 1, X, Xs, Options) end,
@@ -1132,29 +1128,29 @@ apply_rules_once([{RName, Rule} | Rules], I, Code) ->
 -define(RULE(Name), {Name, fun Name/2}).
 
 merge_rules() ->
-    [?RULE(r_push_consume),
+    [?RULE(optimize_push_consume),
-     ?RULE(r_one_shot_var),
+     ?RULE(optimize_one_shot_var),
-     ?RULE(r_write_to_dead_var),
+     ?RULE(optimize_write_to_dead_var),
-     ?RULE(r_inline_switch_target)
+     ?RULE(optimize_inline_switch_target)
     ].
 
 rules() ->
     merge_rules() ++
-    [?RULE(r_swap_push),
+    [?RULE(optimize_swap_push),
-     ?RULE(r_swap_pop),
+     ?RULE(optimize_swap_pop),
-     ?RULE(r_swap_write),
+     ?RULE(optimize_swap_write),
-     ?RULE(r_constant_propagation),
+     ?RULE(optimize_constant_propagation),
-     ?RULE(r_prune_impossible_branches),
+     ?RULE(optimize_prune_impossible_branches),
-     ?RULE(r_single_successful_branch),
+     ?RULE(optimize_single_successful_branch),
-     ?RULE(r_inline_store),
+     ?RULE(optimize_inline_store),
-     ?RULE(r_float_switch_body)
+     ?RULE(optimize_float_switch_body)
     ].
 
 %% Removing pushes that are immediately consumed.
-r_push_consume({i, Ann1, {'STORE', ?a, A}}, Code) ->
+optimize_push_consume({i, Ann1, {'STORE', ?a, A}}, Code) ->
     inline_push(Ann1, A, 0, Code, []);
 %% Writing directly to memory instead of going through the accumulator.
-r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) ->
+optimize_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) ->
     IsPush =
         case op_view(I) of
             {_, ?a, _} -> true;
@@ -1166,7 +1162,7 @@ r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) ->
         end,
     if IsPush -> {[{i, merge_ann(Ann1, Ann2), setelement(2, I, R)}], Code};
        true   -> false end;
-r_push_consume(_, _) -> false.
+optimize_push_consume(_, _) -> false.
 
 inline_push(Ann, Arg, Stack, [{i, _, switch_body} = AI | Code], Acc) ->
     {AI1, {i, Ann1, _}} = swap_instrs({i, Ann, {'STORE', ?a, Arg}}, AI),
@@ -1199,7 +1195,7 @@ split_stack_arg(N, [A | As], Acc) ->
     split_stack_arg(N1, As, [A | Acc]).
 
 %% Move PUSHes past non-stack instructions.
-r_swap_push(Push = {i, _, PushI}, [I | Code]) ->
+optimize_swap_push(Push = {i, _, PushI}, [I | Code]) ->
     case op_view(PushI) of
         {_, ?a, _} ->
             case independent(Push, I) of
@@ -1210,10 +1206,10 @@ r_swap_push(Push = {i, _, PushI}, [I | Code]) ->
             end;
         _ -> false
     end;
-r_swap_push(_, _) -> false.
+optimize_swap_push(_, _) -> false.
 
 %% Move non-stack instruction past POPs.
-r_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
+optimize_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
     case independent(IA, JA) of
         true ->
             case {op_view(I), op_view(J)} of
@@ -1221,7 +1217,7 @@ r_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
                 {_, false} -> false;
                 {{_, IR, IAs}, {_, RJ, JAs}} ->
                     NonStackI = not lists:member(?a, [IR | IAs]),
-                    %% RJ /= ?a to not conflict with r_swap_push
+                    %% RJ /= ?a to not conflict with optimize_swap_push
                     PopJ      = RJ /= ?a andalso lists:member(?a, JAs),
                     case NonStackI andalso PopJ of
                         false -> false;
@@ -1232,22 +1228,22 @@ r_swap_pop(IA = {i, _, I}, [JA = {i, _, J} | Code]) ->
             end;
         false -> false
     end;
-r_swap_pop(_, _) -> false.
+optimize_swap_pop(_, _) -> false.
 
 %% Match up writes to variables with instructions further down.
-r_swap_write(I = {i, _, _}, [J | Code]) ->
+optimize_swap_write(I = {i, _, _}, [J | Code]) ->
     case {var_writes(I), independent(I, J)} of
         {[_], true} ->
             {J1, I1} = swap_instrs(I, J),
-            r_swap_write([J1], I1, Code);
+            optimize_swap_write([J1], I1, Code);
         _ -> false
     end;
-r_swap_write(_, _) -> false.
+optimize_swap_write(_, _) -> false.
 
-r_swap_write(Pre, I, [{i, _, switch_body} = J | Code]) ->
+optimize_swap_write(Pre, I, [{i, _, switch_body} = J | Code]) ->
     {J1, I1} = swap_instrs(I, J),
-    r_swap_write([J1 | Pre], I1, Code);
+    optimize_swap_write([J1 | Pre], I1, Code);
-r_swap_write(Pre, I, Code0 = [J | Code]) ->
+optimize_swap_write(Pre, I, Code0 = [J | Code]) ->
     case apply_rules_once(merge_rules(), I, Code0) of
         {_Rule, New, Rest} ->
             {lists:reverse(Pre) ++ New, Rest};
@@ -1256,27 +1252,27 @@ r_swap_write(Pre, I, Code0 = [J | Code]) ->
                 false -> false;
                 true  ->
                     {J1, I1} = swap_instrs(I, J),
-                    r_swap_write([J1 | Pre], I1, Code)
+                    optimize_swap_write([J1 | Pre], I1, Code)
             end
     end;
-r_swap_write(_, _, _) -> false.
+optimize_swap_write(_, _, _) -> false.
 
 %% Precompute instructions with known values
-r_constant_propagation(Cons = {i, Ann1, {'CONS', R, X, Xs}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
+optimize_constant_propagation(Cons = {i, Ann1, {'CONS', R, X, Xs}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
     Store = {i, Ann, {'STORE', S, ?i(false)}},
     Cons1 = case R of
                 ?a -> {i, Ann1, {'CONS', ?void, X, Xs}};
                 _  -> Cons
             end,
     {[Cons1, Store], Code};
-r_constant_propagation(Nil = {i, Ann1, {'NIL', R}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
+optimize_constant_propagation(Nil = {i, Ann1, {'NIL', R}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) ->
     Store = {i, Ann, {'STORE', S, ?i(true)}},
     Nil1 = case R of
                ?a -> {i, Ann1, {'NIL', ?void}};
                _  -> Nil
            end,
     {[Nil1, Store], Code};
-r_constant_propagation({i, Ann, I}, Code) ->
+optimize_constant_propagation({i, Ann, I}, Code) ->
     case op_view(I) of
         false -> false;
         {Op, R, As} ->
@@ -1290,7 +1286,7 @@ r_constant_propagation({i, Ann, I}, Code) ->
                     end
             end
     end;
-r_constant_propagation(_, _) -> false.
+optimize_constant_propagation(_, _) -> false.
 
 eval_op('ADD', [X, Y]) when is_integer(X), is_integer(Y) -> X + Y;
 eval_op('SUB', [X, Y]) when is_integer(X), is_integer(Y) -> X - Y;
@@ -1309,12 +1305,12 @@ eval_op('NOT', [false]) -> true;
 eval_op(_, _)           -> no_eval.   %% TODO: bits?
 
 %% Prune impossible branches from switches
-r_prune_impossible_branches({switch, ?i(V), Type, Alts, missing}, Code) ->
+optimize_prune_impossible_branches({switch, ?i(V), Type, Alts, missing}, Code) ->
     case pick_branch(Type, V, Alts) of
         false -> false;
         Alt   -> {Alt, Code}
     end;
-r_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def}, Code) when V == true; V == false ->
+optimize_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def}, Code) when V == true; V == false ->
     Alts1 = [if V -> missing; true -> False   end,
              if V -> True;    true -> missing end],
     case Alts == Alts1 of
@@ -1325,7 +1321,7 @@ r_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def},
                 _                  -> {[{switch, ?i(V), boolean, Alts1, Def}], Code}
             end
     end;
-r_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_)}},
+optimize_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_)}},
                             [{switch, R, Type = {variant, _}, Alts, missing} | Code]) when is_integer(Tag) ->
     case {R, lists:nth(Tag + 1, Alts)} of
         {_, missing} ->
@@ -1341,7 +1337,7 @@ r_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_
                 false -> {Alt, Code}
             end
     end;
-r_prune_impossible_branches(_, _) -> false.
+optimize_prune_impossible_branches(_, _) -> false.
 
 pick_branch(boolean, V, [False, True]) when V == true; V == false ->
     Alt = if V -> True; true -> False end,
@@ -1354,7 +1350,7 @@ pick_branch(_Type, _V, _Alts) ->
 
 %% If there's a single branch that doesn't abort we can push the code for that
 %% out of the switch.
-r_single_successful_branch({switch, R, Type, Alts, Def}, Code) ->
+optimize_single_successful_branch({switch, R, Type, Alts, Def}, Code) ->
     case push_code_out_of_switch([Def | Alts]) of
         {_, none} -> false;
         {_, many} -> false;
@@ -1362,7 +1358,7 @@ r_single_successful_branch({switch, R, Type, Alts, Def}, Code) ->
         {[Def1 | Alts1], PushedOut} ->
             {[{switch, R, Type, Alts1, Def1} | PushedOut], Code}
     end;
-r_single_successful_branch(_, _) -> false.
+optimize_single_successful_branch(_, _) -> false.
 
 push_code_out_of_switch([]) -> {[], none};
 push_code_out_of_switch([Alt | Alts]) ->
@@ -1398,7 +1394,7 @@ does_abort({switch, _, _, Alts, Def}) ->
 does_abort(_) -> false.
 
 %% STORE R A, SWITCH R --> SWITCH A
-r_inline_switch_target({i, Ann, {'STORE', R, A}}, [{switch, R, Type, Alts, Def} | Code]) ->
+optimize_inline_switch_target({i, Ann, {'STORE', R, A}}, [{switch, R, Type, Alts, Def} | Code]) ->
     Ann1   =
         case is_reg(A) of
             true  -> Ann#{ live_out := ordsets:add_element(A, maps:get(live_out, Ann)) };
@@ -1417,18 +1413,18 @@ r_inline_switch_target({i, Ann, {'STORE', R, A}}, [{switch, R, Type, Alts, Def}
             end;
         _        -> false %% impossible
     end;
-r_inline_switch_target(_, _) -> false.
+optimize_inline_switch_target(_, _) -> false.
 
 %% Float switch-body to closest switch
-r_float_switch_body(I = {i, _, _}, [J = {i, _, switch_body} | Code]) ->
+optimize_float_switch_body(I = {i, _, _}, [J = {i, _, switch_body} | Code]) ->
     {J1, I1} = swap_instrs(I, J),
     {[], [J1, I1 | Code]};
-r_float_switch_body(_, _) -> false.
+optimize_float_switch_body(_, _) -> false.
 
 %% Inline stores
-r_inline_store({i, _, {'STORE', R, R}}, Code) ->
+optimize_inline_store({i, _, {'STORE', R, R}}, Code) ->
     {[], Code};
-r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) ->
+optimize_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) ->
     %% Not when A is var unless updating the annotations properly.
     Inline = case A of
                  {arg, _}   -> true;
@@ -1436,13 +1432,13 @@ r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) ->
                  {store, _} -> true;
                  _          -> false
              end,
-    if Inline -> r_inline_store([I], false, R, A, Code);
+    if Inline -> optimize_inline_store([I], false, R, A, Code);
        true   -> false end;
-r_inline_store(_, _) -> false.
+optimize_inline_store(_, _) -> false.
 
-r_inline_store(Acc, Progress, R, A, [I = {i, _, switch_body} | Code]) ->
+optimize_inline_store(Acc, Progress, R, A, [I = {i, _, switch_body} | Code]) ->
-    r_inline_store([I | Acc], Progress, R, A, Code);
+    optimize_inline_store([I | Acc], Progress, R, A, Code);
-r_inline_store(Acc, Progress, R, A, [{i, Ann, I} | Code]) ->
+optimize_inline_store(Acc, Progress, R, A, [{i, Ann, I} | Code]) ->
     #{ write := W } = attributes(I),
     Inl = fun(X) when X == R -> A; (X) -> X end,
     case live_in(R, Ann) of
@@ -1462,14 +1458,14 @@ r_inline_store(Acc, Progress, R, A, [{i, Ann, I} | Code]) ->
             case lists:member(W, [R, A]) of
                 true when Progress1 -> {lists:reverse(Acc1), Code};
                 true                -> false;
-                false               -> r_inline_store(Acc1, Progress1, R, A, Code)
+                false               -> optimize_inline_store(Acc1, Progress1, R, A, Code)
             end
     end;
-r_inline_store(Acc, true, _, _, Code) -> {lists:reverse(Acc), Code};
+optimize_inline_store(Acc, true, _, _, Code) -> {lists:reverse(Acc), Code};
-r_inline_store(_, false, _, _, _) -> false.
+optimize_inline_store(_, false, _, _, _) -> false.
 
 %% Shortcut write followed by final read
-r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
+optimize_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
     case op_view(I) of
         {Op, R = {var, _}, As} ->
             Copy = case J of
@@ -1483,11 +1479,11 @@ r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
             end;
         _ -> false
     end;
-r_one_shot_var(_, _) -> false.
+optimize_one_shot_var(_, _) -> false.
 
 %% Remove writes to dead variables
-r_write_to_dead_var({i, _, {'STORE', ?void, ?a}}, _) -> false; %% Avoid looping
+optimize_write_to_dead_var({i, _, {'STORE', ?void, ?a}}, _) -> false; %% Avoid looping
-r_write_to_dead_var({i, Ann, I}, Code) ->
+optimize_write_to_dead_var({i, Ann, I}, Code) ->
     #{ pure := Pure } = attributes(I),
     case op_view(I) of
         {_Op, R, As} when R /= ?a, Pure ->
@@ -1500,7 +1496,7 @@ r_write_to_dead_var({i, Ann, I}, Code) ->
             end;
         _ -> false
     end;
-r_write_to_dead_var(_, _) -> false.
+optimize_write_to_dead_var(_, _) -> false.
 
 op_view({'ABORT', R}) -> {'ABORT', none, [R]};
 op_view({'EXIT', R}) -> {'EXIT', none, [R]};

src/aeso_syntax.erl

@@ -13,7 +13,7 @@
 -export_type([ann_line/0, ann_col/0, ann_origin/0, ann_format/0, ann/0]).
 -export_type([name/0, id/0, con/0, qid/0, qcon/0, tvar/0, op/0]).
 -export_type([bin_op/0, un_op/0]).
--export_type([decl/0, letbind/0, typedef/0, pragma/0]).
+-export_type([decl/0, letbind/0, typedef/0, pragma/0, fundecl/0]).
 -export_type([arg/0, field_t/0, constructor_t/0, named_arg_t/0]).
 -export_type([type/0, constant/0, expr/0, arg_expr/0, field/1, stmt/0, alt/0, lvalue/0, elim/0, pat/0]).
 -export_type([ast/0]).

test/aeso_compiler_tests.erl

@@ -203,6 +203,8 @@ compilable_contracts() ->
      "polymorphism_contract_interface_same_decl_multi_interface",
      "polymorphism_contract_interface_same_name_same_type",
      "polymorphism_variance_switching_chain_create",
+     "polymorphism_variance_switching_void_supertype",
+     "polymorphism_variance_switching_unify_with_interface_decls",
      "missing_init_fun_state_unit",
      "complex_compare_leq",
      "complex_compare",
@@ -847,25 +849,25 @@ failing_contracts() ->
                      "Trying to implement or extend an undefined interface `Z`">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_interface_same_name_different_type,
-                  [<<?Pos(4,20)
+                  [<<?Pos(9,5)
-                     "Unimplemented function `f` from the interface `I1` in the contract `I2`">>])
+                     "Duplicate definitions of `f` at\n"
+                     "  - line 8, column 5\n"
+                     "  - line 9, column 5">>])
     , ?TYPE_ERROR(polymorphism_contract_missing_implementation,
                   [<<?Pos(4,20)
                      "Unimplemented function `f` from the interface `I1` in the contract `I2`">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_same_decl_multi_interface,
                   [<<?Pos(7,10)
-                     "Unimplemented function `f` from the interface `J` in the contract `C`">>
+                     "Both interfaces `I` and `J` implemented by the contract `C` have a function called `f`">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_undefined_interface,
                   [<<?Pos(1,14)
                      "Trying to implement or extend an undefined interface `I`">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_same_name_different_type_multi_interface,
-                  [<<?Pos(9,5)
+                  [<<?Pos(7,10)
-                     "Duplicate definitions of `f` at\n"
+                     "Both interfaces `I` and `J` implemented by the contract `C` have a function called `f`">>
-                     "  - line 8, column 5\n"
-                     "  - line 9, column 5">>
                   ])
     , ?TYPE_ERROR(polymorphism_contract_interface_undefined_interface,
                   [<<?Pos(1,24)

test/contracts/polymorphism_variance_switching_unify_with_interface_decls.aes

@@ -0,0 +1,5 @@
+payable contract interface SalesOffer =
+    entrypoint init : (address, address, int, int) => unit
+
+payable contract Test : SalesOffer =
+    entrypoint init(_, _, _, _) = ()

test/contracts/polymorphism_variance_switching_void_supertype.aes

@@ -0,0 +1,5 @@
+payable contract interface SalesOffer =
+    entrypoint init : (address, address, int, int) => void
+
+payable contract Test : SalesOffer =
+    entrypoint init(_ : address, _ : address, _ : int, _ : int) = ()