From da92ddbd5de85f606005a47bcb1a162bd7e73acd Mon Sep 17 00:00:00 2001 From: Gaith Hallak Date: Tue, 4 Oct 2022 12:40:50 +0300 Subject: [PATCH] Polymorphism fixes (#415) * Assume that void is a supertype of all types * Add test for void supertype * Unify functions with decls from implemented interfaces * Rename delete_if_implementation * Match only with function name and without typesig --- src/aeso_ast_infer_types.erl | 133 +++++++++++------- src/aeso_syntax.erl | 2 +- test/aeso_compiler_tests.erl | 16 ++- ...e_switching_unify_with_interface_decls.aes | 5 + ...hism_variance_switching_void_supertype.aes | 5 + 5 files changed, 105 insertions(+), 56 deletions(-) create mode 100644 test/contracts/polymorphism_variance_switching_unify_with_interface_decls.aes create mode 100644 test/contracts/polymorphism_variance_switching_void_supertype.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 379aa62..b1fdffb 100644 --- a/src/aeso_ast_infer_types.erl +++ b/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], - ImplsNames = lists:map(fun name/1, Impls), - - %% 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), + [ type_error({unimplemented_interface_function, ContractName, name(I), FunName}) + || {FunName, I, _} <- ets_tab2list(functions_to_implement) ], destroy_and_report_type_errors(Env). -%% Recursively check that all directly and indirectly referenced interfaces are implemented -check_implemented_interfaces1(_, [], _, _, _) -> - ok; -check_implemented_interfaces1(Env, [{contract_interface, _, IName, _, Decls} | Interfaces], - ConId, Impls, AllInterfaces) -> - Unmatched = match_impls(Env, Decls, ConId, name(IName), Impls), - check_implemented_interfaces1(Env, Interfaces, ConId, Unmatched, AllInterfaces). +%% Return a list of all function declarations to be implemented, given the list +%% of interfaces to be implemented Impls and all the previously defined +%% contracts DefinedContracts> +-spec functions_to_implement(Impls, DefinedContracts) -> [{InterfaceCon, FunDecl}] when + Impls :: [aeso_syntax:con()], + DefinedContracts :: [aeso_syntax:decl()], + 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 -match_impls(_, [], _, _, Impls) -> - Impls; -match_impls(Env, [{fun_decl, _, {id, _, FunName}, FunType = {fun_t, _, _, ArgsTypes, RetDecl}} | Decls], ConId, IName, Impls) -> - Match = fun({letfun, _, {id, _, FName}, Args, RetFun, _}) when FName == FunName -> - length(ArgsTypes) == length(Args) andalso - 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)); - ({fun_decl, _, {id, _, FName}, FunT}) when FName == FunName -> - unify(Env#env{unify_throws = false}, FunT, FunType, unknown); - (_) -> false - end, - UnmatchedImpls = case lists:search(Match, Impls) of - {value, V} -> - lists:delete(V, Impls); - false -> - type_error({unimplemented_interface_function, ConId, IName, FunName}), - Impls - end, - match_impls(Env, Decls, ConId, IName, UnmatchedImpls). + %% All implemented intrefaces should already be defined + InterfacesNames = [name(element(3, I)) || I <- Interfaces], + [ begin + Found = lists:member(name(Impl), InterfacesNames), + Found orelse type_error({referencing_undefined_interface, Impl}) + end || Impl <- Impls + ], + + lists:flatten([ [ {Con, Decl} || Decl <- Decls] || {contract_interface, _, Con, _, Decls} <- Interfaces ]). + +%% Fill the ets table functions_to_implement with functions from the implemented +%% interfaces Impls. +-spec populate_functions_to_implement(env(), ContractName, Impls, DefinedContracts) -> ok | no_return() when + ContractName :: aeso_syntax:con(), + Impls :: [aeso_syntax:con()], + DefinedContracts :: [aeso_syntax:decl()]. +populate_functions_to_implement(Env, ContractName, Impls, DefinedContracts) -> + create_type_errors(), + [ begin + Inserted = ets_insert_new(functions_to_implement, {name(Id), I, Decl}), + [{_, 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). diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index 8b60e38..f1c7f99 100644 --- a/src/aeso_syntax.erl +++ b/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]). diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 57b25b4..fc65752 100644 --- a/test/aeso_compiler_tests.erl +++ b/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, - [<>]) + [<>]) , ?TYPE_ERROR(polymorphism_contract_missing_implementation, [<> ]) , ?TYPE_ERROR(polymorphism_contract_same_decl_multi_interface, [<> + "Both interfaces `I` and `J` implemented by the contract `C` have a function called `f`">> ]) , ?TYPE_ERROR(polymorphism_contract_undefined_interface, [<> ]) , ?TYPE_ERROR(polymorphism_contract_same_name_different_type_multi_interface, - [<> + [<> ]) , ?TYPE_ERROR(polymorphism_contract_interface_undefined_interface, [< unit + +payable contract Test : SalesOffer = + entrypoint init(_, _, _, _) = () diff --git a/test/contracts/polymorphism_variance_switching_void_supertype.aes b/test/contracts/polymorphism_variance_switching_void_supertype.aes new file mode 100644 index 0000000..23436f5 --- /dev/null +++ b/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) = ()