From 367f87b612f0310dfe3d5cf7ef66227e29ac61ed Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 21 Jan 2019 14:20:57 +0100 Subject: [PATCH 01/18] Implement namespaces This includes a massive refactoring of the type checker, getting rid of most of the ets tables and keeping a proper environment. --- src/aeso_ast_infer_types.erl | 1153 ++++++++++++++++++---------- src/aeso_ast_to_icode.erl | 40 +- src/aeso_compiler.erl | 10 +- src/aeso_icode.erl | 45 +- src/aeso_icode_to_asm.erl | 4 +- src/aeso_parser.erl | 3 +- src/aeso_pretty.erl | 2 + src/aeso_scan.erl | 2 +- src/aeso_syntax.erl | 10 +- test/aeso_abi_tests.erl | 2 +- test/aeso_compiler_tests.erl | 9 +- test/contracts/chain.aes | 4 +- test/contracts/namespace_clash.aes | 5 + test/contracts/namespaces.aes | 31 + 14 files changed, 863 insertions(+), 457 deletions(-) create mode 100644 test/contracts/namespace_clash.aes create mode 100644 test/contracts/namespaces.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 76e8d62..86d3c3c 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -59,17 +59,243 @@ -type field_constraint() :: #field_constraint{} | #record_create_constraint{}. -record(field_info, - { field_t :: utype() + { ann :: aeso_syntax:ann() + , field_t :: utype() , record_t :: utype() , kind :: contract | record }). -type field_info() :: #field_info{}. +-type access() :: public | private | internal. + +-type typedef() :: {[aeso_syntax:tvar()], aeso_syntax:type_def() | {contract_t, [aeso_syntax:field_t()]}} + | {builtin, non_neg_integer()}. + +-type type() :: aeso_syntax:type(). +-type name() :: string(). +-type qname() :: [string()]. +-type typesig() :: {type_sig, aeso_syntax:ann(), [aeso_syntax:named_arg_t()], [type()], type()}. + +-type fun_info() :: {aeso_syntax:ann(), typesig() | type()}. +-type type_info() :: {aeso_syntax:ann(), typedef()}. +-type var_info() :: {aeso_syntax:ann(), type()}. + +-type fun_env() :: [{name(), fun_info()}]. +-type type_env() :: [{name(), type_info()}]. + +-record(scope, { funs = [] :: fun_env() + , types = [] :: type_env() + , access = public :: access() + , kind = namespace :: namespace | contract + , ann = [{origin, system}] :: aeso_syntax:ann() + }). + +-type scope() :: #scope{}. + +-record(env, + { scopes = #{ [] => #scope{}} :: #{ qname() => scope() } + , vars = [] :: [{name(), var_info()}] + , fields = #{} :: #{ name() => [field_info()] } %% fields are global + , namespace = [] :: qname() + }). + +-type env() :: #env{}. + -define(PRINT_TYPES(Fmt, Args), when_option(pp_types, fun () -> io:format(Fmt, Args) end)). +%% -- Environment manipulation ----------------------------------------------- + +-spec push_scope(namespace | contract, aeso_syntax:con(), env()) -> env(). +push_scope(Kind, Con, Env) -> + Ann = aeso_syntax:get_ann(Con), + Name = name(Con), + New = Env#env.namespace ++ [Name], + Env#env{ namespace = New, scopes = (Env#env.scopes)#{ New => #scope{ kind = Kind, ann = Ann } } }. + +-spec pop_scope(env()) -> env(). +pop_scope(Env) -> + Env#env{ namespace = lists:droplast(Env#env.namespace) }. + +-spec get_scope(env(), qname()) -> false | scope(). +get_scope(#env{ scopes = Scopes }, Name) -> + maps:get(Name, Scopes, false). + +-spec on_current_scope(env(), fun((scope()) -> scope())) -> env(). +on_current_scope(Env = #env{ namespace = NS, scopes = Scopes }, Fun) -> + Scope = maps:get(NS, Scopes), + Env#env{ scopes = Scopes#{ NS => Fun(Scope) } }. + +-spec bind_var(aeso_syntax:id(), type(), env()) -> env(). +bind_var({id, Ann, X}, T, Env) -> + Env#env{ vars = [{X, {Ann, T}} | Env#env.vars] }. + +-spec bind_vars([{aeso_syntax:id(), type()}], env()) -> env(). +bind_vars([], Env) -> Env; +bind_vars([{X, T} | Vars], Env) -> + bind_vars(Vars, bind_var(X, T, Env)). + +-spec bind_fun(name(), type() | typesig(), env()) -> env(). +bind_fun(X, Type, Env) -> + Ann = aeso_syntax:get_ann(Type), + case lookup_name(Env, [X]) of + false -> + on_current_scope(Env, fun(Scope = #scope{ funs = Funs }) -> + Scope#scope{ funs = [{X, {Ann, Type}} | Funs] } + end); + {_QId, {Ann1, _}} -> + type_error({duplicate_definition, X, [Ann1, Ann]}), + Env + end. + +-spec bind_funs([{name(), type() | typesig()}], env()) -> env(). +bind_funs([], Env) -> Env; +bind_funs([{Id, Type} | Rest], Env) -> + bind_funs(Rest, bind_fun(Id, Type, Env)). + +-spec bind_type(name(), aeso_syntax:ann(), typedef(), env()) -> env(). +bind_type(X, Ann, Def, Env) -> + on_current_scope(Env, fun(Scope = #scope{ types = Types }) -> + Scope#scope{ types = [{X, {Ann, Def}} | Types] } + end). + +-spec bind_field(name(), field_info(), env()) -> env(). +bind_field(X, Info, Env = #env{ fields = Fields }) -> + Fields1 = maps:update_with(X, fun(Infos) -> [Info | Infos] end, [Info], Fields), + Env#env{ fields = Fields1 }. + +-spec bind_fields([{name(), field_info()}], env()) -> env(). +bind_fields([], Env) -> Env; +bind_fields([{Id, Info} | Rest], Env) -> + bind_fields(Rest, bind_field(Id, Info, Env)). + +%% Contract entrypoints take two named arguments (gas : int = Call.gas_left(), value : int = 0). +contract_call_type({fun_t, Ann, [], Args, Ret}) -> + Id = fun(X) -> {id, Ann, X} end, + Int = Id("int"), + Typed = fun(E, T) -> {typed, Ann, E, T} end, + Named = fun(Name, Default) -> {named_arg_t, Ann, Id(Name), Int, Default} end, + {fun_t, Ann, [Named("gas", Typed({app, Ann, Typed({qid, Ann, ["Call", "gas_left"]}, + {fun_t, Ann, [], [], Int}), + []}, Int)), + Named("value", Typed({int, Ann, 0}, Int))], Args, Ret}. + +-spec bind_contract(aeso_syntax:decl(), env()) -> env(). +bind_contract({contract, Ann, Id, Contents}, Env) -> + Key = name(Id), + Sys = [{origin, system}], + Fields = [ {field_t, AnnF, Entrypoint, contract_call_type(Type)} + || {fun_decl, AnnF, Entrypoint, Type} <- Contents ] ++ + %% Predefined fields + [ {field_t, Sys, {id, Sys, "address"}, {id, Sys, "address"}} ], + FieldInfo = [ {Entrypoint, #field_info{ kind = contract, + field_t = Type, + record_t = Id }} + || {field_t, _, {id, _, Entrypoint}, Type} <- Fields ], + bind_type(Key, Ann, {[], {contract_t, Fields}}, + bind_fields(FieldInfo, Env)). + +%% What scopes could a given name come from? +-spec possible_scopes(env(), qname()) -> [qname()]. +possible_scopes(#env{ namespace = Current}, Name) -> + Qual = lists:droplast(Name), + [ lists:sublist(Current, I) ++ Qual || I <- lists:seq(0, length(Current)) ]. + +-spec lookup_name(env(), qname()) -> false | {qname(), fun_info()}. +lookup_name(Env, Name) -> + lookup_env(Env, term, Name). + +-spec lookup_type(env(), type_id()) -> false | {qname(), type_info()}. +lookup_type(Env, Id) -> + case lookup_env(Env, type, qname(Id)) of + false -> false; + {QId, Type} -> {QId, unfold_types_in_type(Env, push_anns(Id, Type))} + end. + +-spec lookup_env(env(), term, qname()) -> false | {qname(), fun_info()}; + (env(), type, qname()) -> false | {qname(), type_info()}. +lookup_env(Env, Kind, Name) -> + Var = case Name of + [X] when Kind == term -> proplists:get_value(X, Env#env.vars, false); + _ -> false + end, + case Var of + {Ann, Type} -> {Name, {Ann, Type}}; + false -> + Names = [ Qual ++ [lists:last(Name)] || Qual <- possible_scopes(Env, Name) ], + case [ Res || QName <- Names, Res <- [lookup_env1(Env, Kind, QName)], Res /= false] of + [] -> false; + [Res] -> Res; + Many -> type_error({ambiguous_name, [{qid, Ann, Q} || {Q, {Ann, _}} <- Many]}) + end + end. + +-spec lookup_env1(env(), type | term, qname()) -> false | {qname(), fun_info()}. +lookup_env1(#env{ namespace = Current, scopes = Scopes }, Kind, QName) -> + Qual = lists:droplast(QName), + Name = lists:last(QName), + AllowPrivate = lists:prefix(Qual, Current), + %% Get the scope + case maps:get(Qual, Scopes, false) of + false -> false; %% TODO: return reason for not in scope + #scope{ funs = Funs, types = Types } -> + Defs = case Kind of + type -> Types; + term -> Funs + end, + %% Look up the unqualified name + case proplists:get_value(Name, Defs, false) of + false -> false; + {Ann, _} = E -> + %% Check that it's not private (or we can see private funs) + case not is_private(Ann) orelse AllowPrivate of + true -> {QName, E}; + false -> false + end + end + end. + +-spec lookup_record_field(env(), name()) -> [field_info()]. +lookup_record_field(Env, FieldName) -> + maps:get(FieldName, Env#env.fields, []). + +%% For 'create' or 'update' constraints we don't consider contract types. +-spec lookup_record_field(env(), name(), contract | record) -> [field_info()]. +lookup_record_field(Env, FieldName, Kind) -> + [ Fld || Fld = #field_info{ kind = K } <- lookup_record_field(Env, FieldName), + Kind == project orelse K /= contract ]. + +%% -- Name manipulation ------------------------------------------------------ + +-spec qname(type_id()) -> qname(). +qname({id, _, X}) -> [X]; +qname({qid, _, Xs}) -> Xs; +qname({con, _, X}) -> [X]; +qname({qcon, _, Xs}) -> Xs. + +-spec name(aeso_syntax:id() | aeso_syntax:con()) -> name(). +name({_, _, X}) -> X. + +-spec qid(aeso_syntax:ann(), qname()) -> aeso_syntax:id() | aeso_syntax:qid(). +qid(Ann, [X]) -> {id, Ann, X}; +qid(Ann, Xs) -> {qid, Ann, Xs}. + +-spec qcon(aeso_syntax:ann(), qname()) -> aeso_syntax:con() | aeso_syntax:qcon(). +qcon(Ann, [X]) -> {con, Ann, X}; +qcon(Ann, Xs) -> {qcon, Ann, Xs}. + +-spec set_qname(qname(), type_id()) -> type_id(). +set_qname(Xs, {id, Ann, _}) -> qid(Ann, Xs); +set_qname(Xs, {qid, Ann, _}) -> qid(Ann, Xs); +set_qname(Xs, {con, Ann, _}) -> qcon(Ann, Xs); +set_qname(Xs, {qcon, Ann, _}) -> qcon(Ann, Xs). + +is_private(Ann) -> proplists:get_value(private, Ann, false). + +%% -- The rest --------------------------------------------------------------- + %% Environment containing language primitives --spec global_env() -> [{string(), aeso_syntax:type()}]. +-spec global_env() -> env(). global_env() -> Ann = [{origin, system}], Int = {id, Ann, "int"}, @@ -97,87 +323,135 @@ global_env() -> TTL = {qid, Ann, ["Chain", "ttl"]}, Fee = Int, [A, Q, R, K, V] = lists:map(TVar, ["a", "q", "r", "k", "v"]), - %% Option constructors - [{"None", Option(A)}, - {"Some", Fun1(A, Option(A))}, - %% TTL constructors - {"RelativeTTL", Fun1(Int, TTL)}, - {"FixedTTL", Fun1(Int, TTL)}, - %% Spend transaction. - {["Chain","spend"], Fun([Address, Int], Unit)}, - %% Environment variables - %% {["Contract", "owner"], Int}, %% Not in EVM? - {["Contract", "address"], Address}, - {["Contract", "balance"], Int}, - {["Call", "origin"], Address}, - {["Call", "caller"], Address}, - {["Call", "value"], Int}, - {["Call", "gas_price"], Int}, - {["Call", "gas_left"], Fun([], Int)}, - {["Chain", "balance"], Fun1(Address, Int)}, - {["Chain", "block_hash"], Fun1(Int, Int)}, - {["Chain", "coinbase"], Address}, - {["Chain", "timestamp"], Int}, - {["Chain", "block_height"], Int}, - {["Chain", "difficulty"], Int}, - {["Chain", "gas_limit"], Int}, - {["Chain", "event"], Fun1(Event, Unit)}, - %% State - {"state", State}, - {"put", Fun1(State, Unit)}, - %% Abort - {"abort", Fun1(String, A)}, - %% Oracles - {["Oracle", "register"], SignFun([Address, Fee, TTL], Oracle(Q, R))}, - {["Oracle", "query_fee"], Fun([Oracle(Q, R)], Fee)}, - {["Oracle", "query"], Fun([Oracle(Q, R), Q, Fee, TTL, TTL], Query(Q, R))}, - {["Oracle", "get_question"], Fun([Oracle(Q, R), Query(Q, R)], Q)}, - {["Oracle", "respond"], SignFun([Oracle(Q, R), Query(Q, R), R], Unit)}, - {["Oracle", "extend"], SignFun([Oracle(Q, R), TTL], Unit)}, - {["Oracle", "get_answer"], Fun([Oracle(Q, R), Query(Q, R)], option_t(Ann, R))}, - %% Name service - {["AENS", "resolve"], Fun([String, String], option_t(Ann, A))}, - {["AENS", "preclaim"], SignFun([Address, Hash], Unit)}, - {["AENS", "claim"], SignFun([Address, String, Int], Unit)}, - {["AENS", "transfer"], SignFun([Address, Address, Hash], Unit)}, - {["AENS", "revoke"], SignFun([Address, Hash], Unit)}, - %% Maps - {["Map", "from_list"], Fun1(List(Pair(K, V)), Map(K, V))}, - {["Map", "to_list"], Fun1(Map(K, V), List(Pair(K, V)))}, - {["Map", "lookup"], Fun([K, Map(K, V)], Option(V))}, - {["Map", "lookup_default"], Fun([K, Map(K, V), V], V)}, - {["Map", "delete"], Fun([K, Map(K, V)], Map(K, V))}, - {["Map", "member"], Fun([K, Map(K, V)], Bool)}, - {["Map", "size"], Fun1(Map(K, V), Int)}, - %% Crypto/Curve operations - {["Crypto", "ecverify"], Fun([Hash, Address, SignId], Bool)}, - {["Crypto", "sha3"], Fun1(A, Hash)}, - {["Crypto", "sha256"], Fun1(A, Hash)}, - {["Crypto", "blake2b"], Fun1(A, Hash)}, - %% Strings - {["String", "length"], Fun1(String, Int)}, - {["String", "concat"], Fun([String, String], String)}, - {["String", "sha3"], Fun1(String, Hash)}, - {["String", "sha256"], Fun1(String, Hash)}, - {["String", "blake2b"], Fun1(String, Hash)}, - %% Bits - {["Bits", "set"], Fun([Bits, Int], Bits)}, - {["Bits", "clear"], Fun([Bits, Int], Bits)}, - {["Bits", "test"], Fun([Bits, Int], Bool)}, - {["Bits", "sum"], Fun1(Bits, Int)}, - {["Bits", "intersection"], Fun([Bits, Bits], Bits)}, - {["Bits", "union"], Fun([Bits, Bits], Bits)}, - {["Bits", "difference"], Fun([Bits, Bits], Bits)}, - {["Bits", "none"], Bits}, - {["Bits", "all"], Bits}, - %% Conversion - {["Int", "to_str"], Fun1(Int, String)}, - {["Address", "to_str"], Fun1(Address, String)} - ]. -global_type_env() -> - _As = [{origin, system}], - []. + MkDefs = fun(Defs) -> [{X, {Ann, if is_integer(T) -> {builtin, T}; true -> T end}} || {X, T} <- Defs] end, + + TopScope = #scope + { funs = MkDefs( + %% Option constructors + [{"None", Option(A)}, + {"Some", Fun1(A, Option(A))}, + %% TTL constructors + {"RelativeTTL", Fun1(Int, TTL)}, + {"FixedTTL", Fun1(Int, TTL)}, + %% State + {"state", State}, + {"put", Fun1(State, Unit)}, + %% Abort + {"abort", Fun1(String, A)}]) + , types = MkDefs( + [{"int", 0}, {"bool", 0}, {"string", 0}, {"address", 0}, + {"hash", 0}, {"signature", 0}, {"bits", 0}, + {"option", 1}, {"list", 1}, {"map", 2}, + {"oracle", 2}, {"oracle_query", 2} + ]) }, + + ChainScope = #scope + { funs = MkDefs( + %% Spend transaction. + [{"spend", Fun([Address, Int], Unit)}, + %% Chain environment + {"balance", Fun1(Address, Int)}, + {"block_hash", Fun1(Int, Int)}, + {"coinbase", Address}, + {"timestamp", Int}, + {"block_height", Int}, + {"difficulty", Int}, + {"gas_limit", Int}, + {"event", Fun1(Event, Unit)}]) + , types = MkDefs([{"TTL", 0}]) }, + + ContractScope = #scope + { funs = MkDefs( + [{"address", Address}, + %% {"owner", Int}, %% Not in EVM + {"balance", Int}]) }, + + CallScope = #scope + { funs = MkDefs( + [{"origin", Address}, + {"caller", Address}, + {"value", Int}, + {"gas_price", Int}, + {"gas_left", Fun([], Int)}]) + }, + + OracleScope = #scope + { funs = MkDefs( + [{"register", SignFun([Address, Fee, TTL], Oracle(Q, R))}, + {"query_fee", Fun([Oracle(Q, R)], Fee)}, + {"query", Fun([Oracle(Q, R), Q, Fee, TTL, TTL], Query(Q, R))}, + {"get_question", Fun([Oracle(Q, R), Query(Q, R)], Q)}, + {"respond", SignFun([Oracle(Q, R), Query(Q, R), R], Unit)}, + {"extend", SignFun([Oracle(Q, R), TTL], Unit)}, + {"get_answer", Fun([Oracle(Q, R), Query(Q, R)], option_t(Ann, R))}]) }, + + AENSScope = #scope + { funs = MkDefs( + [{"resolve", Fun([String, String], option_t(Ann, A))}, + {"preclaim", SignFun([Address, Hash], Unit)}, + {"claim", SignFun([Address, String, Int], Unit)}, + {"transfer", SignFun([Address, Address, Hash], Unit)}, + {"revoke", SignFun([Address, Hash], Unit)}]) }, + + MapScope = #scope + { funs = MkDefs( + [{"from_list", Fun1(List(Pair(K, V)), Map(K, V))}, + {"to_list", Fun1(Map(K, V), List(Pair(K, V)))}, + {"lookup", Fun([K, Map(K, V)], Option(V))}, + {"lookup_default", Fun([K, Map(K, V), V], V)}, + {"delete", Fun([K, Map(K, V)], Map(K, V))}, + {"member", Fun([K, Map(K, V)], Bool)}, + {"size", Fun1(Map(K, V), Int)}]) }, + + %% Crypto/Curve operations + CryptoScope = #scope + { funs = MkDefs( + [{"ecverify", Fun([Hash, Address, SignId], Bool)}, + {"sha3", Fun1(A, Hash)}, + {"sha256", Fun1(A, Hash)}, + {"blake2b", Fun1(A, Hash)}]) }, + + %% Strings + StringScope = #scope + { funs = MkDefs( + [{"length", Fun1(String, Int)}, + {"concat", Fun([String, String], String)}, + {"sha3", Fun1(String, Hash)}, + {"sha256", Fun1(String, Hash)}, + {"blake2b", Fun1(String, Hash)}]) }, + + %% Bits + BitsScope = #scope + { funs = MkDefs( + [{"set", Fun([Bits, Int], Bits)}, + {"clear", Fun([Bits, Int], Bits)}, + {"test", Fun([Bits, Int], Bool)}, + {"sum", Fun1(Bits, Int)}, + {"intersection", Fun([Bits, Bits], Bits)}, + {"union", Fun([Bits, Bits], Bits)}, + {"difference", Fun([Bits, Bits], Bits)}, + {"none", Bits}, + {"all", Bits}]) }, + + %% Conversion + IntScope = #scope{ funs = MkDefs([{"to_str", Fun1(Int, String)}]) }, + AddressScope = #scope{ funs = MkDefs([{"to_str", Fun1(Address, String)}]) }, + + #env{ scopes = + #{ [] => TopScope + , ["Chain"] => ChainScope + , ["Contract"] => ContractScope + , ["Call"] => CallScope + , ["Oracle"] => OracleScope + , ["AENS"] => AENSScope + , ["Map"] => MapScope + , ["Crypto"] => CryptoScope + , ["String"] => StringScope + , ["Bits"] => BitsScope + , ["Int"] => IntScope + , ["Address"] => AddressScope + } }. option_t(As, T) -> {app_t, As, {id, As, "option"}, [T]}. map_t(As, K, V) -> {app_t, As, {id, As, "map"}, [K, V]}. @@ -188,56 +462,76 @@ infer(Contracts) -> -type option() :: permissive_address_literals. +-spec init_env(list(option())) -> env(). +init_env(Options) -> + case proplists:get_value(permissive_address_literals, Options, false) of + false -> global_env(); + true -> + %% Treat oracle and query ids as address to allow address literals for these + Ann = [{origin, system}], + Tag = fun(Tag, Val) -> {Tag, Ann, Val} end, + lists:foldl(fun({Name, Arity}, E) -> + bind_type(Name, [{origin, system}], + {lists:duplicate(Arity, Tag(tvar, "_")), + {alias_t, Tag(id, "address")}}, E) + end, global_env(), [{"oracle", 2}, {"oracle_query", 2}]) + end. + -spec infer(aeso_syntax:ast(), list(option())) -> aeso_syntax:ast(). infer(Contracts, Options) -> - ets_init(), %Init the ETS table state + ets_init(), %% Init the ETS table state try - TypeEnv = - case proplists:get_value(permissive_address_literals, Options, false) of - false -> global_type_env(); - true -> - %% Treat oracle and query ids as address to allow address literals for these - Tag = fun(Tag, Vals) -> list_to_tuple([Tag, [{origin, system}] | Vals]) end, - Alias = fun(Name, Arity) -> - Tag(type_def, [Tag(id, [Name]), - lists:duplicate(Arity, Tag(tvar, "_")), - {alias_t, Tag(id, ["address"])}]) - end, - [Alias("oracle", 2), Alias("oracle_query", 2)] - end, + Env = init_env(Options), create_options(Options), ets_new(type_vars, [set]), - infer1(TypeEnv, Contracts) + infer1(Env, Contracts, []) after clean_up_ets() end. -infer1(TypeEnv, [Contract = {contract, Attribs, ConName, Code}|Rest]) -> +-spec infer1(env(), [aeso_syntax:decl()], [aeso_syntax:decl()]) -> [aeso_syntax:decl()]. +infer1(_, [], Acc) -> lists:reverse(Acc); +infer1(Env, [Contract = {contract, Ann, ConName, Code} | Rest], Acc) -> %% do type inference on each contract independently. - Contract1 = {contract, Attribs, ConName, infer_contract_top(TypeEnv, Code)}, - TypeEnv1 = [Contract | TypeEnv], - [Contract1 | infer1(TypeEnv1, Rest)]; -infer1(_, []) -> - []. + check_scope_name_clash(Env, contract, ConName), + {Env1, Code1} = infer_contract_top(push_scope(contract, ConName, Env), Code), + Contract1 = {contract, Ann, ConName, Code1}, + Env2 = pop_scope(Env1), + Env3 = bind_contract(Contract, Env2), + infer1(Env3, Rest, [Contract1 | Acc]); +infer1(Env, [{namespace, Ann, Name, Code} | Rest], Acc) -> + check_scope_name_clash(Env, namespace, Name), + {Env1, Code1} = infer_contract_top(push_scope(namespace, Name, Env), Code), + Namespace1 = {namespace, Ann, Name, Code1}, + infer1(pop_scope(Env1), Rest, [Namespace1 | Acc]). -infer_contract_top(TypeEnv, Defs0) -> +check_scope_name_clash(Env, Kind, Name) -> + case get_scope(Env, qname(Name)) of + false -> ok; + #scope{ kind = K, ann = Ann } -> + create_type_errors(), + type_error({duplicate_scope, Kind, Name, K, Ann}), + destroy_and_report_type_errors() + end. + +-spec infer_contract_top(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. +infer_contract_top(Env, Defs0) -> Defs = desugar(Defs0), - create_type_defs(TypeEnv ++ Defs), - C = unfold_record_types(infer_contract(global_env(), Defs)), - destroy_type_defs(), - C. + {Env1, Defs1} = infer_contract(Env, Defs), + Env2 = on_current_scope(Env1, fun(Scope) -> unfold_record_types(Env1, Scope) end), + Defs2 = unfold_record_types(Env2, Defs1), + {Env2, Defs2}. +%% TODO: revisit infer_constant({letval, Attrs,_Pattern, Type, E}) -> - ets_init(), %Init the ETS table state - create_type_defs([]), + ets_init(), %% Init the ETS table state {typed, _, _, PatType} = infer_expr(global_env(), {typed, Attrs, E, arg_type(Type)}), - T = instantiate(PatType), - destroy_type_defs(), - T. + instantiate(PatType). %% infer_contract takes a proplist mapping global names to types, and %% a list of definitions. +-spec infer_contract(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. infer_contract(Env, Defs) -> Kind = fun({type_def, _, _, _, _}) -> type; ({letfun, _, _, _, _, _}) -> function; @@ -246,34 +540,22 @@ infer_contract(Env, Defs) -> Get = fun(K) -> [ Def || Def <- Defs, Kind(Def) == K ] end, {Env1, TypeDefs} = check_typedefs(Env, Get(type)), ProtoSigs = [ check_fundecl(Env1, Decl) || Decl <- Get(prototype) ], - Env2 = ProtoSigs ++ Env1, + create_type_errors(), + Env2 = bind_funs(ProtoSigs, Env1), Functions = Get(function), - check_name_clashes(Env2, Functions), + %% Check for duplicates in Functions (we turn it into a map below) + _ = bind_funs([{Fun, {tuple_t, Ann, []}} || {letfun, Ann, {id, _, Fun}, _, _, _} <- Functions], + #env{}), FunMap = maps:from_list([ {Fun, Def} || Def = {letfun, _, {id, _, Fun}, _, _, _} <- Functions ]), check_reserved_entrypoints(FunMap), DepGraph = maps:map(fun(_, Def) -> aeso_syntax_utils:used_ids(Def) end, FunMap), SCCs = aeso_utils:scc(DepGraph), %% io:format("Dependency sorted functions:\n ~p\n", [SCCs]), - create_type_errors(), - FinalEnv = TypeDefs ++ check_sccs(Env2, FunMap, SCCs, []), + {Env3, Defs1} = check_sccs(Env2, FunMap, SCCs, []), destroy_and_report_type_errors(), - FinalEnv. - -check_name_clashes(Env, Funs) -> - create_type_errors(), - Name = fun({fun_decl, Ann, {id, _, X}, _}) -> [{X, Ann}]; - ({letfun, Ann, {id, _, X}, _, _, _}) -> [{X, Ann}]; - ({type_def, _, _, _, _}) -> []; - ({X, Type}) -> [{X, aeso_syntax:get_ann(Type)}] - end, - All = lists:flatmap(Name, Env ++ Funs), - Names = [ X || {X, _} <- All ], - Duplicates = lists:usort(Names -- lists:usort(Names)), - [ type_error({duplicate_definition, X, [ Ann || {Y, Ann} <- All, X == Y ]}) - || X <- Duplicates ], - destroy_and_report_type_errors(), - ok. + {Env3, TypeDefs ++ Defs1}. +-spec check_typedefs(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. check_typedefs(Env, Defs) -> create_type_errors(), GetName = fun({type_def, _, {id, _, Name}, _, _}) -> Name end, @@ -287,25 +569,31 @@ check_typedefs(Env, Defs) -> {Env1, [ Def || SCC <- SCCs, Name <- SCCNames(SCC), Def <- [maps:get(Name, TypeMap, undefined)], Def /= undefined ]}. +-spec check_typedef_sccs(env(), #{ name() => aeso_syntax:decl() }, [{acyclic, name()} | {cyclic, [name()]}]) -> + env(). check_typedef_sccs(Env, _TypeMap, []) -> Env; check_typedef_sccs(Env, TypeMap, [{acyclic, Name} | SCCs]) -> case maps:get(Name, TypeMap, undefined) of undefined -> check_typedef_sccs(Env, TypeMap, SCCs); %% Builtin type {type_def, Ann, D, Xs, Def} -> + Env1 = bind_type(Name, Ann, {Xs, Def}, Env), case Def of - {alias_t, _} -> check_typedef_sccs(Env, TypeMap, SCCs); %% TODO: check these - {record_t, _} -> check_typedef_sccs(Env, TypeMap, SCCs); %% and these + {alias_t, _} -> check_typedef_sccs(Env1, TypeMap, SCCs); %% TODO: check these + {record_t, Fields} -> + RecTy = app_t(Ann, D, Xs), + Env2 = check_fields(Env1, TypeMap, RecTy, Fields), + check_typedef_sccs(Env2, TypeMap, SCCs); {variant_t, Cons} -> - Target = {app_t, Ann, D, Xs}, + Target = app_t(Ann, D, Xs), ConType = fun([]) -> Target; (Args) -> {type_sig, Ann, [], Args, Target} end, ConTypes = [ begin {constr_t, _, {con, _, Con}, Args} = ConDef, {Con, ConType(Args)} end || ConDef <- Cons ], check_repeated_constructors([ {Con, ConType(Args)} || {constr_t, _, Con, Args} <- Cons ]), - [ check_constructor_overlap(Env, Con, Target) || {constr_t, _, Con, _} <- Cons ], + [ check_constructor_overlap(Env1, Con, Target) || {constr_t, _, Con, _} <- Cons ], [ check_event(Cons) || Name == "event" ], - check_typedef_sccs(ConTypes ++ Env, TypeMap, SCCs) + check_typedef_sccs(bind_funs(ConTypes, Env1), TypeMap, SCCs) end end; check_typedef_sccs(Env, TypeMap, [{cyclic, Names} | SCCs]) -> @@ -313,6 +601,12 @@ check_typedef_sccs(Env, TypeMap, [{cyclic, Names} | SCCs]) -> type_error({recursive_types_not_implemented, lists:map(Id, Names)}), check_typedef_sccs(Env, TypeMap, SCCs). +-spec check_fields(env(), #{ name() => aeso_syntax:decl() }, type(), [aeso_syntax:field_t()]) -> env(). +check_fields(Env, _TypeMap, _, []) -> Env; +check_fields(Env, TypeMap, RecTy, [{field_t, Ann, Id, Type} | Fields]) -> + Env1 = bind_field(name(Id), #field_info{ ann = Ann, kind = record, field_t = Type, record_t = RecTy }, Env), + check_fields(Env1, TypeMap, RecTy, Fields). + check_event(Cons) -> [ check_event(Name, Types) || {constr_t, _, {con, _, Name}, Types} <- Cons ]. @@ -326,13 +620,14 @@ check_event(Name, Types) -> [ type_error({event_0_to_3_indexed_values, Name}) || length(Indexed) > 3 ], [ type_error({event_0_to_1_string_values, Name}) || length(NonIndexed) > 1 ]. +-spec check_constructor_overlap(env(), aeso_syntax:con(), type()) -> ok | no_return(). check_constructor_overlap(Env, Con = {con, _, Name}, NewType) -> - case proplists:get_value(Name, Env) of - undefined -> ok; - Type -> + case lookup_name(Env, Name) of + false -> ok; + {_, {Ann, Type}} -> OldType = case Type of {type_sig, _, _, _, T} -> T; _ -> Type end, - OldCon = {con, aeso_syntax:get_ann(OldType), Name}, %% TODO: we don't have the location of the old constructor here + OldCon = {con, Ann, Name}, type_error({repeated_constructor, [{OldCon, OldType}, {Con, NewType}]}) end. @@ -345,31 +640,33 @@ check_repeated_constructors(Cons) -> [ Fail(Dup) || Dup <- Duplicated ], ok. -check_sccs(_, _, [], Acc) -> lists:reverse(Acc); -check_sccs(Env, Funs, [{acyclic, X} | SCCs], Acc) -> +-spec check_sccs(env(), #{ name() => aeso_syntax:decl() }, [{acyclic, name()} | {cyclic, [name()]}], [aeso_syntax:decl()]) -> + {env(), [aeso_syntax:decl()]}. +check_sccs(Env, _, [], Acc) -> {Env, lists:reverse(Acc)}; +check_sccs(Env = #env{}, Funs, [{acyclic, X} | SCCs], Acc) -> case maps:get(X, Funs, undefined) of undefined -> %% Previously defined function check_sccs(Env, Funs, SCCs, Acc); Def -> - {TypeSig, Def1} = infer_nonrec(Env, Def), - Env1 = [TypeSig | Env], + {{_, TypeSig}, Def1} = infer_nonrec(Env, Def), + Env1 = bind_fun(X, TypeSig, Env), check_sccs(Env1, Funs, SCCs, [Def1 | Acc]) end; -check_sccs(Env, Funs, [{cyclic, Xs} | SCCs], Acc) -> +check_sccs(Env = #env{}, Funs, [{cyclic, Xs} | SCCs], Acc) -> Defs = [ maps:get(X, Funs) || X <- Xs ], {TypeSigs, {letrec, _, Defs1}} = infer_letrec(Env, {letrec, [], Defs}), - Env1 = TypeSigs ++ Env, + Env1 = bind_funs(TypeSigs, Env), check_sccs(Env1, Funs, SCCs, Defs1 ++ Acc). check_reserved_entrypoints(Funs) -> Reserved = ["address"], - create_type_errors(), - [ type_error({reserved_entrypoint, Name, Def}) - || {Name, Def} <- maps:to_list(Funs), lists:member(Name, Reserved) ], - destroy_and_report_type_errors(). + _ = [ type_error({reserved_entrypoint, Name, Def}) + || {Name, Def} <- maps:to_list(Funs), lists:member(Name, Reserved) ], + ok. -check_fundecl(_Env, {fun_decl, Attrib, {id, _NameAttrib, Name}, {fun_t, _, Named, Args, Ret}}) -> - {Name, {type_sig, Attrib, Named, Args, Ret}}; %% TODO: actually check that the type makes sense! +-spec check_fundecl(env(), aeso_syntax:decl()) -> {name(), typesig()}. +check_fundecl(_Env, {fun_decl, Ann, {id, _, Name}, {fun_t, _, Named, Args, Ret}}) -> + {Name, {type_sig, Ann, Named, Args, Ret}}; %% TODO: actually check that the type makes sense! check_fundecl(_, {fun_decl, _Attrib, {id, _, Name}, Type}) -> error({fundecl_must_have_funtype, Name, Type}). @@ -377,54 +674,54 @@ infer_nonrec(Env, LetFun) -> create_constraints(), NewLetFun = infer_letfun(Env, LetFun), check_special_funs(Env, NewLetFun), - solve_constraints(), - destroy_and_report_unsolved_constraints(), + solve_constraints(Env), + destroy_and_report_unsolved_constraints(Env), Result = {TypeSig, _} = instantiate(NewLetFun), print_typesig(TypeSig), Result. %% Currenty only the init function. -check_special_funs(_Env, {{"init", Type}, _}) -> +check_special_funs(Env, {{"init", Type}, _}) -> {type_sig, Ann, _Named, _Args, Res} = Type, State = %% We might have implicit (no) state. - case lookup_type({id, [], "state"}) of + case lookup_type(Env, {id, [], "state"}) of false -> {tuple_t, [{origin, system}], []}; _ -> {id, [{origin, system}], "state"} end, - unify(Res, State, {checking_init_type, Ann}); + unify(Env, Res, State, {checking_init_type, Ann}); check_special_funs(_, _) -> ok. typesig_to_fun_t({type_sig, Ann, Named, Args, Res}) -> {fun_t, Ann, Named, Args, Res}. infer_letrec(Env, {letrec, Attrs, Defs}) -> create_constraints(), - Env1 = [{Name, fresh_uvar(A)} + Funs = [{Name, fresh_uvar(A)} || {letfun, _, {id, A, Name}, _, _, _} <- Defs], - ExtendEnv = Env1 ++ Env, + ExtendEnv = bind_funs(Funs, Env), Inferred = [ begin Res = {{Name, TypeSig}, _} = infer_letfun(ExtendEnv, LF), - Got = proplists:get_value(Name, Env1), + Got = proplists:get_value(Name, Funs), Expect = typesig_to_fun_t(TypeSig), - unify(Got, Expect, {check_typesig, Name, Got, Expect}), - solve_field_constraints(), + unify(Env, Got, Expect, {check_typesig, Name, Got, Expect}), + solve_field_constraints(Env), ?PRINT_TYPES("Checked ~s : ~s\n", [Name, pp(dereference_deep(Got))]), Res end || LF <- Defs ], - destroy_and_report_unsolved_constraints(), + destroy_and_report_unsolved_constraints(Env), TypeSigs = instantiate([Sig || {Sig, _} <- Inferred]), NewDefs = instantiate([D || {_, D} <- Inferred]), [print_typesig(S) || S <- TypeSigs], {TypeSigs, {letrec, Attrs, NewDefs}}. infer_letfun(Env, {letfun, Attrib, {id, NameAttrib, Name}, Args, What, Body}) -> - ArgTypes = [{ArgName, arg_type(T)} || {arg, _, {id, _, ArgName}, T} <- Args], + ArgTypes = [{ArgName, arg_type(T)} || {arg, _, ArgName, T} <- Args], ExpectedType = arg_type(What), - NewBody={typed, _, _, ResultType} = check_expr(ArgTypes ++ Env, Body, ExpectedType), + NewBody={typed, _, _, ResultType} = check_expr(bind_vars(ArgTypes, Env), Body, ExpectedType), NewArgs = [{arg, A1, {id, A2, ArgName}, T} - || {{ArgName, T}, {arg, A1, {id, A2, ArgName}, _}} <- lists:zip(ArgTypes, Args)], + || {{_, T}, {arg, A1, {id, A2, ArgName}, _}} <- lists:zip(ArgTypes, Args)], NamedArgs = [], TypeSig = {type_sig, Attrib, NamedArgs, [T || {arg, _, _, T} <- NewArgs], ResultType}, {{Name, TypeSig}, @@ -440,30 +737,30 @@ arg_type({app_t, Attrs, Name, Args}) -> arg_type(T) -> T. +app_t(_Ann, Name, []) -> Name; +app_t(Ann, Name, Args) -> {app_t, Ann, Name, Args}. + lookup_name(Env, As, Name) -> lookup_name(Env, As, Name, []). -lookup_name(Env, As, Name, Options) -> - case proplists:get_value(Name, Env) of - undefined -> - Id = case Name of - [C | _] when is_integer(C) -> {id, As, Name}; - [X | _] when is_list(X) -> {qid, As, Name} - end, +lookup_name(Env, As, Id, Options) -> + case lookup_name(Env, qname(Id)) of + false -> type_error({unbound_variable, Id}), - fresh_uvar(As); - {type_sig, _, _, _, _} = Type -> - freshen_type(typesig_to_fun_t(Type)); - Type -> - case proplists:get_value(freshen, Options, false) of - true -> freshen_type(Type); - false -> Type - end + {Id, fresh_uvar(As)}; + {QId, {_, Ty}} -> + Freshen = proplists:get_value(freshen, Options, false), + Ty1 = case Ty of + {type_sig, _, _, _, _} -> freshen_type(typesig_to_fun_t(Ty)); + _ when Freshen -> freshen_type(Ty); + _ -> Ty + end, + {set_qname(QId, Id), Ty1} end. check_expr(Env, Expr, Type) -> E = {typed, _, _, Type1} = infer_expr(Env, Expr), - unify(Type1, Type, {check_expr, Expr, Type1, Type}), + unify(Env, Type1, Type, {check_expr, Expr, Type1, Type}), E. infer_expr(_Env, Body={bool, As, _}) -> @@ -479,15 +776,15 @@ infer_expr(_Env, Body={hash, As, Hash}) -> end; infer_expr(_Env, Body={id, As, "_"}) -> {typed, As, Body, fresh_uvar(As)}; -infer_expr(Env, Body={id, As, Name}) -> - Type = lookup_name(Env, As, Name), - {typed, As, Body, Type}; -infer_expr(Env, Body={qid, As, Name}) -> - Type = lookup_name(Env, As, Name), - {typed, As, Body, Type}; -infer_expr(Env, Body={con, As, Name}) -> - Type = lookup_name(Env, As, Name, [freshen]), - {typed, As, Body, Type}; +infer_expr(Env, Id = {id, As, _}) -> + {QName, Type} = lookup_name(Env, As, Id), + {typed, As, QName, Type}; +infer_expr(Env, Id = {qid, As, _}) -> + {QName, Type} = lookup_name(Env, As, Id), + {typed, As, QName, Type}; +infer_expr(Env, Id = {con, As, _}) -> + {QName, Type} = lookup_name(Env, As, Id, [freshen]), + {typed, As, QName, Type}; infer_expr(Env, {unit, As}) -> infer_expr(Env, {tuple, As, []}); infer_expr(Env, {tuple, As, Cpts}) -> @@ -519,14 +816,14 @@ infer_expr(Env, {app, Ann, Fun, Args0}) -> NewArgs = [infer_expr(Env, A) || A <- Args], ArgTypes = [T || {typed, _, _, T} <- NewArgs], ResultType = fresh_uvar(FunAnn), - unify(FunType, {fun_t, [], NamedArgsVar, ArgTypes, ResultType}, {infer_app, Fun, Args, FunType, ArgTypes}), + unify(Env, FunType, {fun_t, [], NamedArgsVar, ArgTypes, ResultType}, {infer_app, Fun, Args, FunType, ArgTypes}), {typed, FunAnn, {app, Ann, NewFun, NamedArgs1 ++ NewArgs}, dereference(ResultType)} end; infer_expr(Env, {'if', Attrs, Cond, Then, Else}) -> NewCond = check_expr(Env, Cond, {id, Attrs, "bool"}), NewThen = {typed, _, _, ThenType} = infer_expr(Env, Then), NewElse = {typed, _, _, ElseType} = infer_expr(Env, Else), - unify(ThenType, ElseType, {if_branches, Then, ThenType, Else, ElseType}), + unify(Env, ThenType, ElseType, {if_branches, Then, ThenType, Else, ElseType}), {typed, Attrs, {'if', Attrs, NewCond, NewThen, NewElse}, ThenType}; infer_expr(Env, {switch, Attrs, Expr, Cases}) -> NewExpr = {typed, _, _, ExprType} = infer_expr(Env, Expr), @@ -538,7 +835,7 @@ infer_expr(Env, {record, Attrs, Fields}) -> RecordType = fresh_uvar(Attrs), NewFields = [{field, A, FieldName, infer_expr(Env, Expr)} || {field, A, FieldName, Expr} <- Fields], - RecordType1 = unfold_types_in_type(RecordType), + RecordType1 = unfold_types_in_type(Env, RecordType), constrain([ #record_create_constraint{ record_t = RecordType1, fields = [ FieldName || {field, _, [{proj, _, FieldName}], _} <- Fields ], @@ -561,7 +858,7 @@ infer_expr(Env, {proj, Attrs, Record, FieldName}) -> NewRecord = {typed, _, _, RecordType} = infer_expr(Env, Record), FieldType = fresh_uvar(Attrs), constrain([#field_constraint{ - record_t = unfold_types_in_type(RecordType), + record_t = unfold_types_in_type(Env, RecordType), field = FieldName, field_t = FieldType, kind = project, @@ -650,7 +947,7 @@ check_record_update(Env, RecordType, Fld) -> {field_upd, Ann, LV, check_expr(Env, Fun, FunType)} end, constrain([#field_constraint{ - record_t = unfold_types_in_type(RecordType), + record_t = unfold_types_in_type(Env, RecordType), field = FieldName, field_t = FldType, kind = update, @@ -661,7 +958,7 @@ infer_op(Env, As, Op, Args, InferOp) -> TypedArgs = [infer_expr(Env, A) || A <- Args], ArgTypes = [T || {typed, _, _, T} <- TypedArgs], Inferred = {fun_t, _, _, OperandTypes, ResultType} = InferOp(Op), - unify(ArgTypes, OperandTypes, {infer_app, Op, Args, Inferred, ArgTypes}), + unify(Env, ArgTypes, OperandTypes, {infer_app, Op, Args, Inferred, ArgTypes}), {typed, As, {app, As, Op, TypedArgs}, ResultType}. infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> @@ -671,10 +968,10 @@ infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> [] -> ok; Nonlinear -> type_error({non_linear_pattern, Pattern, lists:usort(Nonlinear)}) end, - NewEnv = [{Name, fresh_uvar(Attr)} || {id, Attr, Name} <- Vars] ++ Env, + NewEnv = bind_vars([{Var, fresh_uvar(Ann)} || Var = {id, Ann, _} <- Vars], Env), NewPattern = {typed, _, _, PatType} = infer_expr(NewEnv, Pattern), NewBranch = check_expr(NewEnv, Branch, SwitchType), - unify(PatType, ExprType, {case_pat, Pattern, PatType, ExprType}), + unify(Env, PatType, ExprType, {case_pat, Pattern, PatType, ExprType}), {'case', Attrs, NewPattern, NewBranch}. %% NewStmts = infer_block(Env, Attrs, Stmts, BlockType) @@ -818,83 +1115,83 @@ when_option(Opt, Do) -> %% Record types -create_type_defs(Defs) -> - %% A map from type names to definitions - ets_new(type_defs, [set]), - %% A relation from field names to types - ets_new(record_fields, [bag]), - [ case Def of - {type_def, _Attrs, Id, Args, Typedef} -> - insert_typedef(Id, Args, Typedef); - {contract, _Attrs, Id, Contents} -> - insert_contract(Id, Contents); - _ -> ok - end || Def <- Defs], - ok. +%% create_type_defs(Defs) -> +%% %% A map from type names to definitions +%% ets_new(type_defs, [set]), +%% %% A relation from field names to types +%% ets_new(record_fields, [bag]), +%% [ case Def of +%% {type_def, _Attrs, Id, Args, Typedef} -> +%% insert_typedef(Id, Args, Typedef); +%% {contract, _Attrs, Id, Contents} -> +%% insert_contract(Id, Contents); +%% _ -> ok +%% end || Def <- Defs], +%% ok. -destroy_type_defs() -> - ets_delete(type_defs), - ets_delete(record_fields). +%% destroy_type_defs() -> +%% ets_delete(type_defs), +%% ets_delete(record_fields). %% Key used in type_defs ets table. --spec type_key(type_id()) -> [string()]. -type_key({Tag, _, Name}) when Tag =:= id; Tag =:= con -> [Name]; -type_key({Tag, _, QName}) when Tag =:= qid; Tag =:= qcon -> QName. +%% -spec type_key(type_id()) -> [string()]. +%% type_key({Tag, _, Name}) when Tag =:= id; Tag =:= con -> [Name]; +%% type_key({Tag, _, QName}) when Tag =:= qid; Tag =:= qcon -> QName. %% Contract entrypoints take two named arguments (gas : int = Call.gas_left(), value : int = 0). -contract_call_type({fun_t, Ann, [], Args, Ret}) -> - Id = fun(X) -> {id, Ann, X} end, - Int = Id("int"), - Typed = fun(E, T) -> {typed, Ann, E, T} end, - Named = fun(Name, Default) -> {named_arg_t, Ann, Id(Name), Int, Default} end, - {fun_t, Ann, [Named("gas", Typed({app, Ann, Typed({qid, Ann, ["Call", "gas_left"]}, - {fun_t, Ann, [], [], Int}), - []}, Int)), - Named("value", Typed({int, Ann, 0}, Int))], Args, Ret}. +%% contract_call_type({fun_t, Ann, [], Args, Ret}) -> +%% Id = fun(X) -> {id, Ann, X} end, +%% Int = Id("int"), +%% Typed = fun(E, T) -> {typed, Ann, E, T} end, +%% Named = fun(Name, Default) -> {named_arg_t, Ann, Id(Name), Int, Default} end, +%% {fun_t, Ann, [Named("gas", Typed({app, Ann, Typed({qid, Ann, ["Call", "gas_left"]}, +%% {fun_t, Ann, [], [], Int}), +%% []}, Int)), +%% Named("value", Typed({int, Ann, 0}, Int))], Args, Ret}. -insert_contract(Id, Contents) -> - Key = type_key(Id), - Sys = [{origin, system}], - Fields = [ {field_t, Ann, Entrypoint, contract_call_type(Type)} - || {fun_decl, Ann, Entrypoint, Type} <- Contents ] ++ - %% Predefined fields - [ {field_t, Sys, {id, Sys, "address"}, {id, Sys, "address"}} ], - ets_insert(type_defs, {Key, [], {contract_t, Fields}}), - %% TODO: types defined in other contracts - [insert_record_field(Entrypoint, #field_info{ kind = contract, - field_t = Type, - record_t = Id }) - || {field_t, _, {id, _, Entrypoint}, Type} <- Fields ]. +%% insert_contract(Id, Contents) -> +%% Key = type_key(Id), +%% Sys = [{origin, system}], +%% Fields = [ {field_t, Ann, Entrypoint, contract_call_type(Type)} +%% || {fun_decl, Ann, Entrypoint, Type} <- Contents ] ++ +%% %% Predefined fields +%% [ {field_t, Sys, {id, Sys, "address"}, {id, Sys, "address"}} ], +%% ets_insert(type_defs, {Key, [], {contract_t, Fields}}), +%% %% TODO: types defined in other contracts +%% [insert_record_field(Entrypoint, #field_info{ kind = contract, +%% field_t = Type, +%% record_t = Id }) +%% || {field_t, _, {id, _, Entrypoint}, Type} <- Fields ]. --spec insert_typedef(type_id(), [aeso_syntax:tvar()], aeso_syntax:typedef()) -> ok. -insert_typedef(Id, Args, Typedef) -> - Attrs = aeso_syntax:get_ann(Id), - Key = type_key(Id), - ets_insert(type_defs, {Key, Args, Typedef}), - case Typedef of - {record_t, Fields} -> - [insert_record_field(FieldName, #field_info{ kind = record, - field_t = FieldType, - record_t = {app_t, Attrs, Id, Args} }) - || {field_t, _, {id, _, FieldName}, FieldType} <- Fields], - ok; - {variant_t, _} -> ok; - {alias_t, _} -> ok - end. +%% -spec insert_typedef(type_id(), [aeso_syntax:tvar()], aeso_syntax:typedef()) -> ok. +%% insert_typedef(Id, Args, Typedef) -> +%% Attrs = aeso_syntax:get_ann(Id), +%% Key = type_key(Id), +%% ets_insert(type_defs, {Key, Args, Typedef}), +%% case Typedef of +%% {record_t, Fields} -> +%% [insert_record_field(FieldName, #field_info{ kind = record, +%% field_t = FieldType, +%% record_t = {app_t, Attrs, Id, Args} }) +%% || {field_t, _, {id, _, FieldName}, FieldType} <- Fields], +%% ok; +%% {variant_t, _} -> ok; +%% {alias_t, _} -> ok +%% end. --spec lookup_type(type_id()) -> false | {[aeso_syntax:tvar()], aeso_syntax:typedef()}. -lookup_type(Id) -> - case ets_lookup(type_defs, type_key(Id)) of - [] -> false; - [{_Key, Params, Typedef}] -> - {Params, unfold_types_in_type(push_anns(Id, Typedef))} - end. +%% -spec lookup_type(type_id()) -> false | {[aeso_syntax:tvar()], aeso_syntax:typedef()}. +%% lookup_type(Id) -> +%% case ets_lookup(type_defs, type_key(Id)) of +%% [] -> false; +%% [{_Key, Params, Typedef}] -> +%% {Params, unfold_types_in_type(push_anns(Id, Typedef))} +%% end. -push_anns(T1, {alias_t, Id}) -> +push_anns(T1, {Ann, {Args, {alias_t, Id}}}) -> As1 = aeso_syntax:get_ann(T1), As2 = aeso_syntax:get_ann(Id), As = umerge(lists:sort(As2), lists:sort(As1)), - {alias_t, aeso_syntax:set_ann(As, Id)}; + {Ann, {Args, {alias_t, aeso_syntax:set_ann(As, Id)}}}; push_anns(_, T) -> T. umerge([], Ls2) -> Ls2; @@ -907,18 +1204,9 @@ umerge(Ls1 = [{K1, _V1} | _], [E = {K2, _V2} | Ls2]) when K2 < K1 -> [E | umerge(Ls1, Ls2)]. --spec insert_record_field(string(), field_info()) -> true. -insert_record_field(FieldName, FieldInfo) -> - ets_insert(record_fields, {FieldName, FieldInfo}). - --spec lookup_record_field(string()) -> [{string(), field_info()}]. -lookup_record_field(FieldName) -> - ets_lookup(record_fields, FieldName). - -%% For 'create' or 'update' constraints we don't consider contract types. -lookup_record_field(FieldName, Kind) -> - [ Fld || Fld = {_, #field_info{ kind = K }} <- lookup_record_field(FieldName), - Kind == project orelse K /= contract ]. +%% -spec insert_record_field(string(), field_info()) -> true. +%% insert_record_field(FieldName, FieldInfo) -> +%% ets_insert(record_fields, {FieldName, FieldInfo}). %% -- Constraints -- @@ -926,13 +1214,13 @@ create_constraints() -> create_named_argument_constraints(), create_field_constraints(). -solve_constraints() -> - solve_named_argument_constraints(), - solve_field_constraints(). +solve_constraints(Env) -> + solve_named_argument_constraints(Env), + solve_field_constraints(Env). -destroy_and_report_unsolved_constraints() -> - destroy_and_report_unsolved_field_constraints(), - destroy_and_report_unsolved_named_argument_constraints(). +destroy_and_report_unsolved_constraints(Env) -> + destroy_and_report_unsolved_field_constraints(Env), + destroy_and_report_unsolved_named_argument_constraints(Env). %% -- Named argument constraints -- @@ -950,20 +1238,20 @@ add_named_argument_constraint(Constraint) -> ets_insert(named_argument_constraints, Constraint), ok. -solve_named_argument_constraints() -> - Unsolved = solve_named_argument_constraints(get_named_argument_constraints()), +solve_named_argument_constraints(Env) -> + Unsolved = solve_named_argument_constraints(Env, get_named_argument_constraints()), Unsolved == []. --spec solve_named_argument_constraints([named_argument_constraint()]) -> [named_argument_constraint()]. -solve_named_argument_constraints(Constraints0) -> +-spec solve_named_argument_constraints(env(), [named_argument_constraint()]) -> [named_argument_constraint()]. +solve_named_argument_constraints(Env, Constraints0) -> [ C || C <- dereference_deep(Constraints0), - unsolved == check_named_argument_constraint(C) ]. + unsolved == check_named_argument_constraint(Env, C) ]. %% If false, a type error have been emitted, so it's safe to drop the constraint. --spec check_named_argument_constraint(named_argument_constraint()) -> true | false | unsolved. -check_named_argument_constraint(#named_argument_constraint{ args = {uvar, _, _} }) -> +-spec check_named_argument_constraint(env(), named_argument_constraint()) -> true | false | unsolved. +check_named_argument_constraint(_Env, #named_argument_constraint{ args = {uvar, _, _} }) -> unsolved; -check_named_argument_constraint( +check_named_argument_constraint(Env, C = #named_argument_constraint{ args = Args, name = Id = {id, _, Name}, type = Type }) -> @@ -971,11 +1259,11 @@ check_named_argument_constraint( [] -> type_error({bad_named_argument, Args, Id}), false; - [T] -> unify(T, Type, {check_named_arg_constraint, C}), true + [T] -> unify(Env, T, Type, {check_named_arg_constraint, C}), true end. -destroy_and_report_unsolved_named_argument_constraints() -> - Unsolved = solve_named_argument_constraints(get_named_argument_constraints()), +destroy_and_report_unsolved_named_argument_constraints(Env) -> + Unsolved = solve_named_argument_constraints(Env, get_named_argument_constraints()), [ type_error({unsolved_named_argument_constraint, C}) || C <- Unsolved ], destroy_named_argument_constraints(), ok. @@ -997,21 +1285,21 @@ constrain(FieldConstraints) -> get_field_constraints() -> ets_tab2list(field_constraints). -solve_field_constraints() -> +solve_field_constraints(Env) -> FieldCs = lists:filter(fun(#field_constraint{}) -> true; (_) -> false end, get_field_constraints()), - solve_field_constraints(FieldCs). + solve_field_constraints(Env, FieldCs). -check_record_create_constraints([]) -> ok; -check_record_create_constraints([C | Cs]) -> +check_record_create_constraints(_, []) -> ok; +check_record_create_constraints(Env, [C | Cs]) -> #record_create_constraint{ record_t = Type, fields = Fields, context = When } = C, - Type1 = unfold_types_in_type(instantiate(Type)), - try lookup_type(record_type_name(Type1)) of - {_, {record_t, RecFields}} -> + Type1 = unfold_types_in_type(Env, instantiate(Type)), + try lookup_type(Env, record_type_name(Type1)) of + {_QId, {_Ann, {_Args, {record_t, RecFields}}}} -> ActualNames = [ Fld || {field_t, _, {id, _, Fld}, _} <- RecFields ], GivenNames = [ Fld || {id, _, Fld} <- Fields ], case ActualNames -- GivenNames of %% We know already that we don't have too many fields @@ -1023,10 +1311,10 @@ check_record_create_constraints([C | Cs]) -> catch _:_ -> %% Might be unsolved, we get a different error in that case ok end, - check_record_create_constraints(Cs). + check_record_create_constraints(Env, Cs). --spec solve_field_constraints([field_constraint()]) -> ok. -solve_field_constraints(Constraints) -> +-spec solve_field_constraints(env(), [field_constraint()]) -> ok. +solve_field_constraints(Env, Constraints) -> %% First look for record fields that appear in only one type definition IsAmbiguous = fun(#field_constraint{ record_t = RecordType, @@ -1034,7 +1322,7 @@ solve_field_constraints(Constraints) -> field_t = FieldType, kind = Kind, context = When }) -> - case lookup_record_field(FieldName, Kind) of + case lookup_record_field(Env, FieldName, Kind) of [] -> type_error({undefined_field, Field}), false; @@ -1043,45 +1331,45 @@ solve_field_constraints(Constraints) -> FreshFldType = freshen(FldType), FreshRecType = freshen(RecType), destroy_freshen_tvars(), - unify(FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}), - unify(FreshRecType, RecordType, {record_constraint, FreshRecType, RecordType, When}), + unify(Env, FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}), + unify(Env, FreshRecType, RecordType, {record_constraint, FreshRecType, RecordType, When}), false; _ -> %% ambiguity--need cleverer strategy true end end, AmbiguousConstraints = lists:filter(IsAmbiguous, Constraints), - solve_ambiguous_field_constraints(AmbiguousConstraints). + solve_ambiguous_field_constraints(Env, AmbiguousConstraints). --spec solve_ambiguous_field_constraints([field_constraint()]) -> ok. -solve_ambiguous_field_constraints(Constraints) -> - Unknown = solve_known_record_types(Constraints), +-spec solve_ambiguous_field_constraints(env(), [field_constraint()]) -> ok. +solve_ambiguous_field_constraints(Env, Constraints) -> + Unknown = solve_known_record_types(Env, Constraints), if Unknown == [] -> ok; length(Unknown) < length(Constraints) -> %% progress! Keep trying. - solve_ambiguous_field_constraints(Unknown); + solve_ambiguous_field_constraints(Env, Unknown); true -> - case solve_unknown_record_types(Unknown) of + case solve_unknown_record_types(Env, Unknown) of true -> %% Progress! - solve_ambiguous_field_constraints(Unknown); + solve_ambiguous_field_constraints(Env, Unknown); _ -> ok %% No progress. Report errors later. end end. --spec solve_unknown_record_types([field_constraint()]) -> true | [tuple()]. -solve_unknown_record_types(Unknown) -> +-spec solve_unknown_record_types(env(), [field_constraint()]) -> true | [tuple()]. +solve_unknown_record_types(Env, Unknown) -> UVars = lists:usort([UVar || #field_constraint{record_t = UVar = {uvar, _, _}} <- Unknown]), - Solutions = [solve_for_uvar(UVar, [{Kind, Field} - || #field_constraint{record_t = U, field = Field, kind = Kind} <- Unknown, - U == UVar]) + Solutions = [solve_for_uvar(Env, UVar, [{Kind, When, Field} + || #field_constraint{record_t = U, field = Field, kind = Kind, context = When} <- Unknown, + U == UVar]) || UVar <- UVars], case lists:member(true, Solutions) of true -> true; false -> Solutions end. --spec solve_known_record_types([field_constraint()]) -> [field_constraint()]. -solve_known_record_types(Constraints) -> +-spec solve_known_record_types(env(), [field_constraint()]) -> [field_constraint()]. +solve_known_record_types(Env, Constraints) -> DerefConstraints = [ C#field_constraint{record_t = dereference(RecordType)} || C = #field_constraint{record_t = RecordType} <- Constraints ], @@ -1093,8 +1381,8 @@ solve_known_record_types(Constraints) -> context = When} = C, RecId = record_type_name(RecType), Attrs = aeso_syntax:get_ann(RecId), - case lookup_type(RecId) of - {Formals, {What, Fields}} when What =:= record_t; What =:= contract_t -> + case lookup_type(Env, RecId) of + {_, {_Ann, {Formals, {What, Fields}}}} when What =:= record_t; What =:= contract_t -> FieldTypes = [{Name, Type} || {field_t, _, {id, _, Name}, Type} <- Fields], {id, _, FieldString} = FieldName, case proplists:get_value(FieldString, FieldTypes) of @@ -1104,13 +1392,13 @@ solve_known_record_types(Constraints) -> FldType -> create_freshen_tvars(), FreshFldType = freshen(FldType), - FreshRecType = freshen({app_t, Attrs, RecId, Formals}), + FreshRecType = freshen(app_t(Attrs, RecId, Formals)), destroy_freshen_tvars(), - unify(FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}), - unify(FreshRecType, RecType, {record_constraint, FreshRecType, RecType, When}), + unify(Env, FreshFldType, FieldType, {field_constraint, FreshFldType, FieldType, When}), + unify(Env, FreshRecType, RecType, {record_constraint, FreshRecType, RecType, When}), C end; - false -> + _ -> type_error({not_a_record_type, RecId, When}), not_solved end @@ -1122,55 +1410,71 @@ solve_known_record_types(Constraints) -> end], DerefConstraints--SolvedConstraints. -destroy_and_report_unsolved_field_constraints() -> +destroy_and_report_unsolved_field_constraints(Env) -> {FieldCs, CreateCs} = lists:partition(fun(#field_constraint{}) -> true; (_) -> false end, get_field_constraints()), - Unknown = solve_known_record_types(FieldCs), + Unknown = solve_known_record_types(Env, FieldCs), if Unknown == [] -> ok; true -> - case solve_unknown_record_types(Unknown) of + case solve_unknown_record_types(Env, Unknown) of true -> ok; Errors -> [ type_error(Err) || Err <- Errors ] end end, - check_record_create_constraints(CreateCs), + check_record_create_constraints(Env, CreateCs), destroy_field_constraints(), ok. record_type_name({app_t, _Attrs, RecId, _Args}) when ?is_type_id(RecId) -> RecId; record_type_name(RecId) when ?is_type_id(RecId) -> - RecId. + RecId; +record_type_name(_Other) -> + %% io:format("~p is not a record type\n", [Other]), + {id, [{origin, system}], "not_a_record_type"}. -solve_for_uvar(UVar = {uvar, Attrs, _}, Fields) -> +solve_for_uvar(Env, UVar = {uvar, Attrs, _}, Fields0) -> + Fields = [{Kind, Fld} || {Kind, _, Fld} <- Fields0], + [{_, When, _} | _] = Fields0, %% Get the location from the first field %% If we have 'create' constraints they must be complete. Covering = lists:usort([ Name || {create, {id, _, Name}} <- Fields ]), %% Does this set of fields uniquely identify a record type? FieldNames = [ Name || {_Kind, {id, _, Name}} <- Fields ], UniqueFields = lists:usort(FieldNames), - Candidates = [record_type_name(RecType) || {_, #field_info{record_t = RecType}} <- lookup_record_field(hd(FieldNames))], - TypesAndFields = [case lookup_type(RecName) of - {_, {record_t, RecFields}} -> - {RecName, [Field || {field_t, _, {id, _, Field}, _} <- RecFields]}; - _ -> %% impossible? - error({no_definition_for, RecName, in, Candidates}) + Candidates = [RecType || #field_info{record_t = RecType} <- lookup_record_field(Env, hd(FieldNames))], + TypesAndFields = [case lookup_type(Env, record_type_name(RecType)) of + {_, {_, {_, {record_t, RecFields}}}} -> + {RecType, [Field || {field_t, _, {id, _, Field}, _} <- RecFields]}; + {_, {_, {_, {contract_t, ConFields}}}} -> + %% TODO: is this right? + {RecType, [Field || {field_t, _, {id, _, Field}, _} <- ConFields]}; + false -> %% impossible? + error({no_definition_for, record_type_name(RecType), in, Env}) end - || RecName <- Candidates], - Solutions = lists:sort([RecName || {RecName, RecFields} <- TypesAndFields, - UniqueFields -- RecFields == [], - Covering == [] orelse RecFields -- Covering == []]), - case Solutions of - [] -> + || RecType <- Candidates], + PartialSolutions = + lists:sort([{RecType, if Covering == [] -> []; true -> RecFields -- Covering end} + || {RecType, RecFields} <- TypesAndFields, + UniqueFields -- RecFields == []]), + Solutions = [RecName || {RecName, []} <- PartialSolutions], + case {Solutions, PartialSolutions} of + {[], []} -> {no_records_with_all_fields, Fields}; - [RecId] -> - {Formals, {record_t, _}} = lookup_type(RecId), + {[], _} -> + case PartialSolutions of + [{RecType, Missing} | _] -> %% TODO: better error if ambiguous + {missing_fields, When, RecType, Missing} + end; + {[RecType], _} -> + RecName = record_type_name(RecType), + {_, {_, {Formals, {_RecOrCon, _}}}} = lookup_type(Env, RecName), create_freshen_tvars(), - FreshRecType = freshen({app_t, Attrs, RecId, Formals}), + FreshRecType = freshen(app_t(Attrs, RecName, Formals)), destroy_freshen_tvars(), - unify(UVar, FreshRecType, {solve_rec_type, UVar, Fields}), + unify(Env, UVar, FreshRecType, {solve_rec_type, UVar, Fields}), true; - StillPossible -> + {StillPossible, _} -> {ambiguous_record, Fields, StillPossible} end. @@ -1178,64 +1482,66 @@ solve_for_uvar(UVar = {uvar, Attrs, _}, Fields) -> %% names. But, before we pass the typed program to the code generator, %% we replace record types annotating expressions with their %% definition. This enables the code generator to see the fields. -unfold_record_types(T) -> - unfold_types(T, [unfold_record_types]). +unfold_record_types(Env, T) -> + unfold_types(Env, T, [unfold_record_types]). -unfold_types({typed, Attr, E, Type}, Options) -> - {typed, Attr, unfold_types(E, Options), unfold_types_in_type(Type, Options)}; -unfold_types({arg, Attr, Id, Type}, Options) -> - {arg, Attr, Id, unfold_types_in_type(Type, Options)}; -unfold_types({type_sig, Ann, NamedArgs, Args, Ret}, Options) -> +unfold_types(Env, {typed, Attr, E, Type}, Options) -> + {typed, Attr, unfold_types(Env, E, Options), unfold_types_in_type(Env, Type, Options)}; +unfold_types(Env, {arg, Attr, Id, Type}, Options) -> + {arg, Attr, Id, unfold_types_in_type(Env, Type, Options)}; +unfold_types(Env, {type_sig, Ann, NamedArgs, Args, Ret}, Options) -> {type_sig, Ann, - unfold_types_in_type(NamedArgs, Options), - unfold_types_in_type(Args, Options), - unfold_types_in_type(Ret, Options)}; -unfold_types({type_def, Ann, Name, Args, Def}, Options) -> - {type_def, Ann, Name, Args, unfold_types_in_type(Def, Options)}; -unfold_types({letfun, Ann, Name, Args, Type, Body}, Options) -> - {letfun, Ann, Name, unfold_types(Args, Options), unfold_types_in_type(Type, Options), unfold_types(Body, Options)}; -unfold_types(T, Options) when is_tuple(T) -> - list_to_tuple(unfold_types(tuple_to_list(T), Options)); -unfold_types([H|T], Options) -> - [unfold_types(H, Options)|unfold_types(T, Options)]; -unfold_types(X, _Options) -> + unfold_types_in_type(Env, NamedArgs, Options), + unfold_types_in_type(Env, Args, Options), + unfold_types_in_type(Env, Ret, Options)}; +unfold_types(Env, {type_def, Ann, Name, Args, Def}, Options) -> + {type_def, Ann, Name, Args, unfold_types_in_type(Env, Def, Options)}; +unfold_types(Env, {fun_decl, Ann, Name, Type}, Options) -> + {fun_decl, Ann, Name, unfold_types(Env, Type, Options)}; +unfold_types(Env, {letfun, Ann, Name, Args, Type, Body}, Options) -> + {letfun, Ann, Name, unfold_types(Env, Args, Options), unfold_types_in_type(Env, Type, Options), unfold_types(Env, Body, Options)}; +unfold_types(Env, T, Options) when is_tuple(T) -> + list_to_tuple(unfold_types(Env, tuple_to_list(T), Options)); +unfold_types(Env, [H|T], Options) -> + [unfold_types(Env, H, Options)|unfold_types(Env, T, Options)]; +unfold_types(_Env, X, _Options) -> X. -unfold_types_in_type(T) -> - unfold_types_in_type(T, []). +unfold_types_in_type(Env, T) -> + unfold_types_in_type(Env, T, []). -unfold_types_in_type({app_t, Ann, Id, Args}, Options) when ?is_type_id(Id) -> +unfold_types_in_type(Env, {app_t, Ann, Id, Args}, Options) when ?is_type_id(Id) -> UnfoldRecords = proplists:get_value(unfold_record_types, Options, false), - case lookup_type(Id) of - {Formals, {record_t, Fields}} when UnfoldRecords, length(Formals) == length(Args) -> + case lookup_type(Env, Id) of + {_, {_, {Formals, {record_t, Fields}}}} when UnfoldRecords, length(Formals) == length(Args) -> {record_t, - unfold_types_in_type( + unfold_types_in_type(Env, subst_tvars(lists:zip(Formals, Args), Fields), Options)}; - {Formals, {alias_t, Type}} when length(Formals) == length(Args) -> - unfold_types_in_type(subst_tvars(lists:zip(Formals, Args), Type), Options); + {_, {_, {Formals, {alias_t, Type}}}} when length(Formals) == length(Args) -> + unfold_types_in_type(Env, subst_tvars(lists:zip(Formals, Args), Type), Options); _ -> %% Not a record type, or ill-formed record type. - {app_t, Ann, Id, unfold_types_in_type(Args, Options)} + {app_t, Ann, Id, unfold_types_in_type(Env, Args, Options)} end; -unfold_types_in_type(Id, Options) when ?is_type_id(Id) -> +unfold_types_in_type(Env, Id, Options) when ?is_type_id(Id) -> %% Like the case above, but for types without parameters. UnfoldRecords = proplists:get_value(unfold_record_types, Options, false), - case lookup_type(Id) of - {[], {record_t, Fields}} when UnfoldRecords -> - {record_t, unfold_types_in_type(Fields, Options)}; - {[], {alias_t, Type1}} -> - unfold_types_in_type(Type1, Options); + case lookup_type(Env, Id) of + {_, {_, {[], {record_t, Fields}}}} when UnfoldRecords -> + {record_t, unfold_types_in_type(Env, Fields, Options)}; + {_, {_, {[], {alias_t, Type1}}}} -> + unfold_types_in_type(Env, Type1, Options); _ -> %% Not a record type, or ill-formed record type Id end; -unfold_types_in_type({field_t, Attr, Name, Type}, Options) -> - {field_t, Attr, Name, unfold_types_in_type(Type, Options)}; -unfold_types_in_type(T, Options) when is_tuple(T) -> - list_to_tuple(unfold_types_in_type(tuple_to_list(T), Options)); -unfold_types_in_type([H|T], Options) -> - [unfold_types_in_type(H, Options)|unfold_types_in_type(T, Options)]; -unfold_types_in_type(X, _Options) -> +unfold_types_in_type(Env, {field_t, Attr, Name, Type}, Options) -> + {field_t, Attr, Name, unfold_types_in_type(Env, Type, Options)}; +unfold_types_in_type(Env, T, Options) when is_tuple(T) -> + list_to_tuple(unfold_types_in_type(Env, tuple_to_list(T), Options)); +unfold_types_in_type(Env, [H|T], Options) -> + [unfold_types_in_type(Env, H, Options)|unfold_types_in_type(Env, T, Options)]; +unfold_types_in_type(_Env, X, _Options) -> X. @@ -1253,16 +1559,16 @@ subst_tvars1(_Env, X) -> %% Unification -unify({id, _, "_"}, _, _When) -> true; -unify(_, {id, _, "_"}, _When) -> true; -unify(A, B, When) -> - A1 = dereference(unfold_types_in_type(A)), - B1 = dereference(unfold_types_in_type(B)), - unify1(A1, B1, When). +unify(_, {id, _, "_"}, _, _When) -> true; +unify(_, _, {id, _, "_"}, _When) -> true; +unify(Env, A, B, When) -> + A1 = dereference(unfold_types_in_type(Env, A)), + B1 = dereference(unfold_types_in_type(Env, B)), + unify1(Env, A1, B1, When). -unify1({uvar, _, R}, {uvar, _, R}, _When) -> +unify1(_Env, {uvar, _, R}, {uvar, _, R}, _When) -> true; -unify1({uvar, A, R}, T, When) -> +unify1(_Env, {uvar, A, R}, T, When) -> case occurs_check(R, T) of true -> cannot_unify({uvar, A, R}, T, When), @@ -1271,38 +1577,38 @@ unify1({uvar, A, R}, T, When) -> ets_insert(type_vars, {R, T}), true end; -unify1(T, {uvar, A, R}, When) -> - unify1({uvar, A, R}, T, When); -unify1({tvar, _, X}, {tvar, _, X}, _When) -> true; %% Rigid type variables -unify1([A|B], [C|D], When) -> - unify(A, C, When) andalso unify(B, D, When); -unify1(X, X, _When) -> +unify1(Env, T, {uvar, A, R}, When) -> + unify1(Env, {uvar, A, R}, T, When); +unify1(_Env, {tvar, _, X}, {tvar, _, X}, _When) -> true; %% Rigid type variables +unify1(Env, [A|B], [C|D], When) -> + unify(Env, A, C, When) andalso unify(Env, B, D, When); +unify1(_Env, X, X, _When) -> true; -unify1({id, _, Name}, {id, _, Name}, _When) -> +unify1(_Env, {id, _, Name}, {id, _, Name}, _When) -> true; -unify1({con, _, Name}, {con, _, Name}, _When) -> +unify1(_Env, {con, _, Name}, {con, _, Name}, _When) -> true; -unify1({qid, _, Name}, {qid, _, Name}, _When) -> +unify1(_Env, {qid, _, Name}, {qid, _, Name}, _When) -> true; -unify1({qcon, _, Name}, {qcon, _, Name}, _When) -> +unify1(_Env, {qcon, _, Name}, {qcon, _, Name}, _When) -> true; -unify1({fun_t, _, Named1, Args1, Result1}, {fun_t, _, Named2, Args2, Result2}, When) -> - unify(Named1, Named2, When) andalso - unify(Args1, Args2, When) andalso unify(Result1, Result2, When); -unify1({app_t, _, {id, _, F}, Args1}, {app_t, _, {id, _, F}, Args2}, When) +unify1(Env, {fun_t, _, Named1, Args1, Result1}, {fun_t, _, Named2, Args2, Result2}, When) -> + unify(Env, Named1, Named2, When) andalso + unify(Env, Args1, Args2, When) andalso unify(Env, Result1, Result2, When); +unify1(Env, {app_t, _, {id, _, F}, Args1}, {app_t, _, {id, _, F}, Args2}, When) when length(Args1) == length(Args2) -> - unify(Args1, Args2, When); -unify1({tuple_t, _, As}, {tuple_t, _, Bs}, When) + unify(Env, Args1, Args2, When); +unify1(Env, {tuple_t, _, As}, {tuple_t, _, Bs}, When) when length(As) == length(Bs) -> - unify(As, Bs, When); + unify(Env, As, Bs, When); %% The grammar is a bit inconsistent about whether types without %% arguments are represented as applications to an empty list of %% parameters or not. We therefore allow them to unify. -unify1({app_t, _, T, []}, B, When) -> - unify(T, B, When); -unify1(A, {app_t, _, T, []}, When) -> - unify(A, T, When); -unify1(A, B, When) -> +unify1(Env, {app_t, _, T, []}, B, When) -> + unify(Env, T, B, When); +unify1(Env, A, {app_t, _, T, []}, When) -> + unify(Env, A, T, When); +unify1(_Env, A, B, When) -> Ok = case get_option(permissive_address_literals, false) of true -> @@ -1495,6 +1801,9 @@ pp_error({reserved_entrypoint, Name, Def}) -> pp_error({duplicate_definition, Name, Locs}) -> io_lib:format("Duplicate definitions of ~s at\n~s", [Name, [ [" - ", pp_loc(L), "\n"] || L <- Locs ]]); +pp_error({duplicate_scope, Kind, Name, OtherKind, L}) -> + io_lib:format("The ~p ~s (at ~s) has the same name as a ~p at ~s\n", + [Kind, pp(Name), pp_loc(Name), OtherKind, pp_loc(L)]); pp_error(Err) -> io_lib:format("Unknown error: ~p\n", [Err]). diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index 2e00104..196defa 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -19,9 +19,13 @@ convert_typed(TypedTree, Options) -> code(TypedTree, aeso_icode:new(Options)). -code([{contract, _Attribs, {con, _, Name}, Code}|Rest], Icode) -> +code([{contract, _Attribs, Con = {con, _, Name}, Code}|Rest], Icode) -> NewIcode = contract_to_icode(Code, - aeso_icode:set_name(Name, Icode)), + aeso_icode:set_namespace(Con, + aeso_icode:set_name(Name, Icode))), + code(Rest, NewIcode); +code([{namespace, _Ann, Name, Code}|Rest], Icode) -> + NewIcode = contract_to_icode(Code, aeso_icode:enter_namespace(Name, Icode)), code(Rest, NewIcode); code([], Icode) -> add_default_init_function(add_builtins(Icode)). @@ -33,18 +37,24 @@ gen_error(Error) -> %% Create default init function (only if state is unit). add_default_init_function(Icode = #{functions := Funs, state_type := State}) -> - case lists:keymember("init", 1, Funs) of + {_, _, QInit} = aeso_icode:qualify({id, [], "init"}, Icode), + case lists:keymember(QInit, 1, Funs) of true -> Icode; - false when State /= {tuple, []} -> gen_error(missing_init_function); + false when State /= {tuple, []} -> + gen_error(missing_init_function); false -> Type = {tuple, [typerep, {tuple, []}]}, Value = #tuple{ cpts = [type_value({tuple, []}), {tuple, []}] }, - DefaultInit = {"init", [], [], Value, Type}, + DefaultInit = {QInit, [], [], Value, Type}, Icode#{ functions => [DefaultInit | Funs] } end. -spec contract_to_icode(aeso_syntax:ast(), aeso_icode:icode()) -> aeso_icode:icode(). +contract_to_icode([{namespace, _, Name, Defs} | Rest], Icode) -> + NS = aeso_icode:get_namespace(Icode), + Icode1 = contract_to_icode(Defs, aeso_icode:enter_namespace(Name, Icode)), + contract_to_icode(Rest, aeso_icode:set_namespace(NS, Icode1)); contract_to_icode([{type_def, _Attrib, {id, _, Name}, Args, Def} | Rest], Icode = #{ types := Types, constructors := Constructors }) -> TypeDef = make_type_def(Args, Def, Icode), @@ -52,8 +62,9 @@ contract_to_icode([{type_def, _Attrib, {id, _, Name}, Args, Def} | Rest], case Def of {variant_t, Cons} -> Tags = lists:seq(0, length(Cons) - 1), - GetName = fun({constr_t, _, {con, _, C}, _}) -> C end, - maps:from_list([ {GetName(Con), Tag} || {Tag, Con} <- lists:zip(Tags, Cons) ]); + GetName = fun({constr_t, _, C, _}) -> C end, + QName = fun(Con) -> {_, _, Xs} = aeso_icode:qualify(GetName(Con), Icode), Xs end, + maps:from_list([ {QName(Con), Tag} || {Tag, Con} <- lists:zip(Tags, Cons) ]); _ -> #{} end, Icode1 = Icode#{ types := Types#{ Name => TypeDef }, @@ -84,7 +95,8 @@ contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest] {tuple, [typerep, ast_typerep(T, Icode)]}}; _ -> {ast_body(Body, Icode), ast_typerep(T, Icode)} end, - NewIcode = ast_fun_to_icode(FunName, FunAttrs, FunArgs, FunBody, TypeRep, Icode), + QName = aeso_icode:qualify(Name, Icode), + NewIcode = ast_fun_to_icode(ast_id(QName), FunAttrs, FunArgs, FunBody, TypeRep, Icode), contract_to_icode(Rest, NewIcode); contract_to_icode([{letrec,_,Defs}|Rest], Icode) -> %% OBS! This code ignores the letrec structure of the source, @@ -98,7 +110,8 @@ contract_to_icode(_Code, Icode) -> %% TODO debug output for debug("Unhandled code ~p~n",[Code]), Icode. -ast_id({id, _, Id}) -> Id. +ast_id({id, _, Id}) -> Id; +ast_id({qid, _, Id}) -> Id. ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) -> ast_args(Rest, [{ast_id(Name), ast_type(Type, Icode)}| Acc], Icode); @@ -384,7 +397,8 @@ ast_body(?qid_app(["Address", "to_str"], [Addr], _, _), Icode) -> %% Other terms ast_body({id, _, Name}, _Icode) -> - %% TODO Look up id in env + #var_ref{name = Name}; +ast_body({qid, _, Name}, _Icode) -> #var_ref{name = Name}; ast_body({bool, _, Bool}, _Icode) -> %BOOL as ints Value = if Bool -> 1 ; true -> 0 end, @@ -441,9 +455,15 @@ ast_body({proj, _, {typed, _, _, {con, _, Contract}}, {id, _, FunName}}, _Icode) string:join([Contract, FunName], ".")}); ast_body({con, _, Name}, Icode) -> + Tag = aeso_icode:get_constructor_tag([Name], Icode), + #tuple{cpts = [#integer{value = Tag}]}; +ast_body({qcon, _, Name}, Icode) -> Tag = aeso_icode:get_constructor_tag(Name, Icode), #tuple{cpts = [#integer{value = Tag}]}; ast_body({app, _, {typed, _, {con, _, Name}, _}, Args}, Icode) -> + Tag = aeso_icode:get_constructor_tag([Name], Icode), + #tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]}; +ast_body({app, _, {typed, _, {qcon, _, Name}, _}, Args}, Icode) -> Tag = aeso_icode:get_constructor_tag(Name, Icode), #tuple{cpts = [#integer{value = Tag} | [ ast_body(Arg, Icode) || Arg <- Args ]]}; ast_body({app,As,Fun,Args}, Icode) -> diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index e54b8ef..a9f9be3 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -152,7 +152,7 @@ create_calldata(Contract, Function, Argument) when is_map(Contract) -> [FunName | _] -> Args = lists:map(fun($\n) -> 32; (X) -> X end, Argument), %% newline to space CallContract = lists:flatten( - [ "contract Call =\n" + [ "contract MakeCall =\n" , " function ", Function, "\n" , " function __call() = ", FunName, "(", Args, ")" ]), @@ -161,15 +161,15 @@ create_calldata(Contract, Function, Argument) when is_map(Contract) -> get_arg_icode(Funs) -> - [Args] = [ Args || {?CALL_NAME, _, _, {funcall, _, Args}, _} <- Funs ], + [Args] = [ Args || {[_, ?CALL_NAME], _, _, {funcall, _, Args}, _} <- Funs ], Args. get_call_type([{contract, _, _, Defs}]) -> - case [ {FunName, FunType} + case [ {lists:last(QFunName), FunType} || {letfun, _, {id, _, ?CALL_NAME}, [], _Ret, {typed, _, {app, _, - {typed, _, {id, _, FunName}, FunType}, _}, _}} <- Defs ] of + {typed, _, {qid, _, QFunName}, FunType}, _}, _}} <- Defs ] of [Call] -> {ok, Call}; [] -> {error, missing_call_function} end; @@ -228,7 +228,7 @@ to_bytecode([Op|Rest], Options) -> to_bytecode([], _) -> []. extract_type_info(#{functions := Functions} =_Icode) -> - TypeInfo = [aeso_abi:function_type_info(list_to_binary(Name), Args, TypeRep) + TypeInfo = [aeso_abi:function_type_info(list_to_binary(lists:last(Name)), Args, TypeRep) || {Name, Attrs, Args,_Body, TypeRep} <- Functions, not is_tuple(Name), not lists:member(private, Attrs) diff --git a/src/aeso_icode.erl b/src/aeso_icode.erl index 8ee3839..16953da 100644 --- a/src/aeso_icode.erl +++ b/src/aeso_icode.erl @@ -9,7 +9,18 @@ %%%------------------------------------------------------------------- -module(aeso_icode). --export([new/1, pp/1, set_name/2, set_functions/2, map_typerep/2, option_typerep/1, get_constructor_tag/2]). +-export([new/1, + pp/1, + set_name/2, + set_namespace/2, + enter_namespace/2, + get_namespace/1, + qualify/2, + set_functions/2, + map_typerep/2, + option_typerep/1, + get_constructor_tag/2]). + -export_type([icode/0]). -include("aeso_icode.hrl"). @@ -29,12 +40,13 @@ -type icode() :: #{ contract_name => string() , functions => [fun_dec()] + , namespace => aeso_syntax:con() | aeso_syntax:qcon() , env => [bindings()] , state_type => aeso_sophia:type() , event_type => aeso_sophia:type() , types => #{ type_name() => type_def() } , type_vars => #{ string() => aeso_sophia:type() } - , constructors => #{ string() => integer() } %% name to tag + , constructors => #{ [string()] => integer() } %% name to tag , options => [any()] }. @@ -73,10 +85,10 @@ builtin_types() -> }. builtin_constructors() -> - #{ "RelativeTTL" => 0 - , "FixedTTL" => 1 - , "None" => 0 - , "Some" => 1 }. + #{ ["RelativeTTL"] => 0 + , ["FixedTTL"] => 1 + , ["None"] => 0 + , ["Some"] => 1 }. map_typerep(K, V) -> {map, K, V}. @@ -91,11 +103,30 @@ new_env() -> set_name(Name, Icode) -> maps:put(contract_name, Name, Icode). +-spec set_namespace(aeso_syntax:con() | aeso_syntax:qcon(), icode()) -> icode(). +set_namespace(NS, Icode) -> Icode#{ namespace => NS }. + +-spec enter_namespace(aeso_syntax:con(), icode()) -> icode(). +enter_namespace(NS, Icode = #{ namespace := NS1 }) -> + Icode#{ namespace => aeso_syntax:qualify(NS1, NS) }; +enter_namespace(NS, Icode) -> + Icode#{ namespace => NS }. + +-spec get_namespace(icode()) -> false | aeso_syntax:con() | aeso_syntax:qcon(). +get_namespace(Icode) -> maps:get(namespace, Icode, false). + +-spec qualify(aeso_syntax:id() | aeso_syntax:con(), icode()) -> aeso_syntax:id() | aeso_syntax:qid() | aeso_syntax:con() | aeso_syntax:qcon(). +qualify(X, Icode) -> + case get_namespace(Icode) of + false -> X; + NS -> aeso_syntax:qualify(NS, X) + end. + -spec set_functions([fun_dec()], icode()) -> icode(). set_functions(NewFuns, Icode) -> maps:put(functions, NewFuns, Icode). --spec get_constructor_tag(string(), icode()) -> integer(). +-spec get_constructor_tag([string()], icode()) -> integer(). get_constructor_tag(Name, #{constructors := Constructors}) -> case maps:get(Name, Constructors, undefined) of undefined -> error({undefined_constructor, Name}); diff --git a/src/aeso_icode_to_asm.erl b/src/aeso_icode_to_asm.erl index e4a2c50..aa99e2e 100644 --- a/src/aeso_icode_to_asm.erl +++ b/src/aeso_icode_to_asm.erl @@ -17,7 +17,7 @@ i(Code) -> aeb_opcodes:mnemonic(Code). %% We don't track purity or statefulness in the type checker yet. -is_stateful({FName, _, _, _, _}) -> FName /= "init". +is_stateful({FName, _, _, _, _}) -> lists:last(FName) /= "init". is_public({_Name, Attrs, _Args, _Body, _Type}) -> not lists:member(private, Attrs). @@ -105,7 +105,7 @@ make_args(Args) -> fun_hash({FName, _, Args, _, TypeRep}) -> ArgType = {tuple, [T || {_, T} <- Args]}, - <> = aeso_abi:function_type_hash(list_to_binary(FName), ArgType, TypeRep), + <> = aeso_abi:function_type_hash(list_to_binary(lists:last(FName)), ArgType, TypeRep), {integer, Hash}. %% Expects two return addresses below N elements on the stack. Picks the top diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index 57c61cf..7b7e7bd 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -36,7 +36,8 @@ decl() -> ?LAZY_P( choice( %% Contract declaration - [ ?RULE(keyword(contract), con(), tok('='), maybe_block(decl()), {contract, _1, _2, _4}) + [ ?RULE(keyword(contract), con(), tok('='), maybe_block(decl()), {contract, _1, _2, _4}) + , ?RULE(keyword(namespace), con(), tok('='), maybe_block(decl()), {namespace, _1, _2, _4}) %% Type declarations TODO: format annotation for "type bla" vs "type bla()" , ?RULE(keyword(type), id(), {type_decl, _1, _2, []}) diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index ac073c1..1b255fb 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -147,6 +147,8 @@ decl(D, Options) -> -spec decl(aeso_syntax:decl()) -> doc(). decl({contract, _, C, Ds}) -> block(follow(text("contract"), hsep(name(C), text("="))), decls(Ds)); +decl({namespace, _, C, Ds}) -> + block(follow(text("namespace"), hsep(name(C), text("="))), decls(Ds)); decl({type_decl, _, T, Vars}) -> typedecl(alias_t, T, Vars); decl({type_def, _, T, Vars, Def}) -> Kind = element(1, Def), diff --git a/src/aeso_scan.erl b/src/aeso_scan.erl index 17f4153..617285d 100644 --- a/src/aeso_scan.erl +++ b/src/aeso_scan.erl @@ -37,7 +37,7 @@ lexer() -> , {"[^/*]+|[/*]", skip()} ], Keywords = ["contract", "import", "let", "rec", "switch", "type", "record", "datatype", "if", "elif", "else", "function", - "stateful", "true", "false", "and", "mod", "public", "private", "indexed", "internal"], + "stateful", "true", "false", "and", "mod", "public", "private", "indexed", "internal", "namespace"], KW = string:join(Keywords, "|"), Rules = diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index f8dc364..d5e5af0 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -8,13 +8,13 @@ -module(aeso_syntax). --export([get_ann/1, get_ann/2, get_ann/3, set_ann/2]). +-export([get_ann/1, get_ann/2, get_ann/3, set_ann/2, qualify/2]). -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]). --export_type([arg/0, field_t/0, constructor_t/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, pat/0]). -export_type([ast/0]). @@ -35,6 +35,7 @@ -type tvar() :: {tvar, ann(), name()}. -type decl() :: {contract, ann(), con(), [decl()]} + | {namespace, ann(), con(), [decl()]} | {type_decl, ann(), id(), [tvar()]} | {type_def, ann(), id(), [tvar()], typedef()} | {fun_decl, ann(), id(), type()} @@ -140,3 +141,8 @@ get_ann(Key, Node) -> get_ann(Key, Node, Default) -> proplists:get_value(Key, get_ann(Node), Default). + +qualify({con, Ann, N}, X) -> qualify({qcon, Ann, [N]}, X); +qualify({qcon, _, NS}, {con, Ann, C}) -> {qcon, Ann, NS ++ [C]}; +qualify({qcon, _, NS}, {id, Ann, X}) -> {qid, Ann, NS ++ [X]}. + diff --git a/test/aeso_abi_tests.erl b/test/aeso_abi_tests.erl index 382c3d6..c5f507c 100644 --- a/test/aeso_abi_tests.erl +++ b/test/aeso_abi_tests.erl @@ -66,7 +66,7 @@ encode_decode_sophia_test() -> encode_decode_sophia_string(SophiaType, String) -> io:format("String ~p~n", [String]), - Code = [ "contract Call =\n" + Code = [ "contract MakeCall =\n" , " function foo : ", SophiaType, " => _\n" , " function __call() = foo(", String, ")\n" ], {ok, _, {Types, _}, Args} = aeso_compiler:check_call(lists:flatten(Code), []), diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index fced305..434513f 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -150,11 +150,10 @@ failing_contracts() -> <<"Ambiguous record type with field y (at line 13, column 25) could be one of\n" " - r (at line 4, column 10)\n" " - r' (at line 5, column 10)">>, - <<"Record type r2 does not have field y (at line 15, column 22)">>, - <<"The field z is missing when constructing an element of type r2 (at line 15, column 24)">>, <<"Repeated name x in pattern\n" " x :: x (at line 26, column 7)">>, - <<"No record type with fields y, z (at line 14, column 22)">>]} + <<"No record type with fields y, z (at line 14, column 22)">>, + <<"No record type with fields y, w (at line 15, column 22)">>]} , {"init_type_error", [<<"Cannot unify string\n" " and map(int, int)\n" @@ -166,5 +165,7 @@ failing_contracts() -> , {"missing_fields_in_record_expression", [<<"The field x is missing when constructing an element of type r('a) (at line 7, column 40)">>, <<"The field y is missing when constructing an element of type r(int) (at line 8, column 40)">>, - <<"The fields y, z are missing when constructing an element of type r('1) (at line 6, column 40)">>]} + <<"The fields y, z are missing when constructing an element of type r('a) (at line 6, column 40)">>]} + , {"namespace_clash", + [<<"The contract Call (at line 4, column 10) has the same name as a namespace at (builtin location)">>]} ]. diff --git a/test/contracts/chain.aes b/test/contracts/chain.aes index 6a5cd8a..9063a5e 100644 --- a/test/contracts/chain.aes +++ b/test/contracts/chain.aes @@ -1,6 +1,6 @@ // Test more advanced chain interactions -contract Chain = +contract ChainTest = record state = { last_bf : address } @@ -10,4 +10,4 @@ contract Chain = function miner() = Chain.coinbase function save_coinbase() = - put(state{last_bf = Chain.coinbase}) \ No newline at end of file + put(state{last_bf = Chain.coinbase}) diff --git a/test/contracts/namespace_clash.aes b/test/contracts/namespace_clash.aes new file mode 100644 index 0000000..e56531b --- /dev/null +++ b/test/contracts/namespace_clash.aes @@ -0,0 +1,5 @@ + +// You can't shadow existing contracts or namespaces. + +contract Call = + function whatever() = () diff --git a/test/contracts/namespaces.aes b/test/contracts/namespaces.aes new file mode 100644 index 0000000..7a61575 --- /dev/null +++ b/test/contracts/namespaces.aes @@ -0,0 +1,31 @@ + +namespace Lib = + + // namespace Internal = + // function rev(xs, ys) = + // switch(xs) + // [] => ys + // x :: xs => rev(xs, x :: ys) + private + function rev(xs, ys) = + switch(xs) + [] => ys + x :: xs => rev(xs, x :: ys) + + function reverse(xs : list('a)) : list('a) = rev(xs, []) + + function eqlist(xs : list(int), ys : list(int)) = + switch((xs, ys)) + ([], []) => true + (x :: xs, y :: ys) => x == y && eqlist(xs, ys) + _ => false + +contract TestNamespaces = + + record state = { x : int } + + function init() = { x = 0 } + + function palindrome(xs : list(int)) : bool = + Lib.eqlist(xs, Lib.reverse(xs)) + From e6c9d0fac160af33f6160fc4386175a8edfff793 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 4 Feb 2019 10:39:36 +0100 Subject: [PATCH 02/18] Put event index information in constructor annotation instead of in argument types --- src/aeso_ast_infer_types.erl | 161 ++++++++--------------------------- src/aeso_builtins.erl | 28 +++--- 2 files changed, 49 insertions(+), 140 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 86d3c3c..55f3730 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -207,10 +207,7 @@ lookup_name(Env, Name) -> -spec lookup_type(env(), type_id()) -> false | {qname(), type_info()}. lookup_type(Env, Id) -> - case lookup_env(Env, type, qname(Id)) of - false -> false; - {QId, Type} -> {QId, unfold_types_in_type(Env, push_anns(Id, Type))} - end. + lookup_env(Env, type, qname(Id)). -spec lookup_env(env(), term, qname()) -> false | {qname(), fun_info()}; (env(), type, qname()) -> false | {qname(), type_info()}. @@ -562,27 +559,27 @@ check_typedefs(Env, Defs) -> TypeMap = maps:from_list([ {GetName(Def), Def} || Def <- Defs ]), DepGraph = maps:map(fun(_, Def) -> aeso_syntax_utils:used_types(Def) end, TypeMap), SCCs = aeso_utils:scc(DepGraph), - %% io:format("Dependency sorted types:\n ~p\n", [SCCs]), - Env1 = check_typedef_sccs(Env, TypeMap, SCCs), + {Env1, Defs1} = check_typedef_sccs(Env, TypeMap, SCCs, []), destroy_and_report_type_errors(), - SCCNames = fun({cyclic, Xs}) -> Xs; ({acyclic, X}) -> [X] end, - {Env1, [ Def || SCC <- SCCs, Name <- SCCNames(SCC), - Def <- [maps:get(Name, TypeMap, undefined)], Def /= undefined ]}. + {Env1, Defs1}. --spec check_typedef_sccs(env(), #{ name() => aeso_syntax:decl() }, [{acyclic, name()} | {cyclic, [name()]}]) -> - env(). -check_typedef_sccs(Env, _TypeMap, []) -> Env; -check_typedef_sccs(Env, TypeMap, [{acyclic, Name} | SCCs]) -> +-spec check_typedef_sccs(env(), #{ name() => aeso_syntax:decl() }, + [{acyclic, name()} | {cyclic, [name()]}], [aeso_syntax:decl()]) -> + {env(), [aeso_syntax:decl()]}. +check_typedef_sccs(Env, _TypeMap, [], Acc) -> {Env, lists:reverse(Acc)}; +check_typedef_sccs(Env, TypeMap, [{acyclic, Name} | SCCs], Acc) -> case maps:get(Name, TypeMap, undefined) of - undefined -> check_typedef_sccs(Env, TypeMap, SCCs); %% Builtin type - {type_def, Ann, D, Xs, Def} -> + undefined -> check_typedef_sccs(Env, TypeMap, SCCs, Acc); %% Builtin type + {type_def, Ann, D, Xs, Def0} -> + Def = check_event(Env, Name, Ann, Def0), + Acc1 = [{type_def, Ann, D, Xs, Def} | Acc], Env1 = bind_type(Name, Ann, {Xs, Def}, Env), case Def of - {alias_t, _} -> check_typedef_sccs(Env1, TypeMap, SCCs); %% TODO: check these + {alias_t, _} -> check_typedef_sccs(Env1, TypeMap, SCCs, Acc1); %% TODO: check these {record_t, Fields} -> RecTy = app_t(Ann, D, Xs), Env2 = check_fields(Env1, TypeMap, RecTy, Fields), - check_typedef_sccs(Env2, TypeMap, SCCs); + check_typedef_sccs(Env2, TypeMap, SCCs, Acc1); {variant_t, Cons} -> Target = app_t(Ann, D, Xs), ConType = fun([]) -> Target; (Args) -> {type_sig, Ann, [], Args, Target} end, @@ -592,14 +589,13 @@ check_typedef_sccs(Env, TypeMap, [{acyclic, Name} | SCCs]) -> end || ConDef <- Cons ], check_repeated_constructors([ {Con, ConType(Args)} || {constr_t, _, Con, Args} <- Cons ]), [ check_constructor_overlap(Env1, Con, Target) || {constr_t, _, Con, _} <- Cons ], - [ check_event(Cons) || Name == "event" ], - check_typedef_sccs(bind_funs(ConTypes, Env1), TypeMap, SCCs) + check_typedef_sccs(bind_funs(ConTypes, Env1), TypeMap, SCCs, Acc1) end end; -check_typedef_sccs(Env, TypeMap, [{cyclic, Names} | SCCs]) -> +check_typedef_sccs(Env, TypeMap, [{cyclic, Names} | SCCs], Acc) -> Id = fun(X) -> {type_def, _, D, _, _} = maps:get(X, TypeMap), D end, type_error({recursive_types_not_implemented, lists:map(Id, Names)}), - check_typedef_sccs(Env, TypeMap, SCCs). + check_typedef_sccs(Env, TypeMap, SCCs, Acc). -spec check_fields(env(), #{ name() => aeso_syntax:decl() }, type(), [aeso_syntax:field_t()]) -> env(). check_fields(Env, _TypeMap, _, []) -> Env; @@ -607,18 +603,26 @@ check_fields(Env, TypeMap, RecTy, [{field_t, Ann, Id, Type} | Fields]) -> Env1 = bind_field(name(Id), #field_info{ ann = Ann, kind = record, field_t = Type, record_t = RecTy }, Env), check_fields(Env1, TypeMap, RecTy, Fields). -check_event(Cons) -> - [ check_event(Name, Types) || {constr_t, _, {con, _, Name}, Types} <- Cons ]. +check_event(Env, "event", Ann, Def) -> + case Def of + {variant_t, Cons} -> + {variant_t, [ check_event_con(Env, Con) || Con <- Cons ]}; + _ -> type_error({event_must_be_variant_type, Ann}) + end; +check_event(_Env, _Name, _Ann, Def) -> Def. -%% Initially we limit the type of an event, it can have 0-3 topics/indexed "words" -%% and 0-1 strings as payload. -check_event(Name, Types) -> - IsIndexed = fun(T) -> aeso_syntax:get_ann(indexed, T, false) end, - Indexed = [ T || T <- Types, IsIndexed(T) ], - NonIndexed = Types -- Indexed, +check_event_con(_Env, {constr_t, Ann, Con, Args}) -> + IsIndexed = fun(T) -> case aeso_syntax:get_ann(indexed, T, false) of + true -> indexed; + false -> notindexed + end end, + Indices = lists:map(IsIndexed, Args), + Indexed = [ T || T <- Args, IsIndexed(T) == indexed ], + NonIndexed = Args -- Indexed, %% TODO: Is is possible to check also the types of arguments in a sensible way? - [ type_error({event_0_to_3_indexed_values, Name}) || length(Indexed) > 3 ], - [ type_error({event_0_to_1_string_values, Name}) || length(NonIndexed) > 1 ]. + [ type_error({event_0_to_3_indexed_values, Con}) || length(Indexed) > 3 ], + [ type_error({event_0_to_1_string_values, Con}) || length(NonIndexed) > 1 ], + {constr_t, [{indices, Indices} | Ann], Con, Args}. -spec check_constructor_overlap(env(), aeso_syntax:con(), type()) -> ok | no_return(). check_constructor_overlap(Env, Con = {con, _, Name}, NewType) -> @@ -1113,101 +1117,6 @@ get_option(Key, Default) -> when_option(Opt, Do) -> get_option(Opt, false) andalso Do(). -%% Record types - -%% create_type_defs(Defs) -> -%% %% A map from type names to definitions -%% ets_new(type_defs, [set]), -%% %% A relation from field names to types -%% ets_new(record_fields, [bag]), -%% [ case Def of -%% {type_def, _Attrs, Id, Args, Typedef} -> -%% insert_typedef(Id, Args, Typedef); -%% {contract, _Attrs, Id, Contents} -> -%% insert_contract(Id, Contents); -%% _ -> ok -%% end || Def <- Defs], -%% ok. - -%% destroy_type_defs() -> -%% ets_delete(type_defs), -%% ets_delete(record_fields). - -%% Key used in type_defs ets table. -%% -spec type_key(type_id()) -> [string()]. -%% type_key({Tag, _, Name}) when Tag =:= id; Tag =:= con -> [Name]; -%% type_key({Tag, _, QName}) when Tag =:= qid; Tag =:= qcon -> QName. - -%% Contract entrypoints take two named arguments (gas : int = Call.gas_left(), value : int = 0). -%% contract_call_type({fun_t, Ann, [], Args, Ret}) -> -%% Id = fun(X) -> {id, Ann, X} end, -%% Int = Id("int"), -%% Typed = fun(E, T) -> {typed, Ann, E, T} end, -%% Named = fun(Name, Default) -> {named_arg_t, Ann, Id(Name), Int, Default} end, -%% {fun_t, Ann, [Named("gas", Typed({app, Ann, Typed({qid, Ann, ["Call", "gas_left"]}, -%% {fun_t, Ann, [], [], Int}), -%% []}, Int)), -%% Named("value", Typed({int, Ann, 0}, Int))], Args, Ret}. - -%% insert_contract(Id, Contents) -> -%% Key = type_key(Id), -%% Sys = [{origin, system}], -%% Fields = [ {field_t, Ann, Entrypoint, contract_call_type(Type)} -%% || {fun_decl, Ann, Entrypoint, Type} <- Contents ] ++ -%% %% Predefined fields -%% [ {field_t, Sys, {id, Sys, "address"}, {id, Sys, "address"}} ], -%% ets_insert(type_defs, {Key, [], {contract_t, Fields}}), -%% %% TODO: types defined in other contracts -%% [insert_record_field(Entrypoint, #field_info{ kind = contract, -%% field_t = Type, -%% record_t = Id }) -%% || {field_t, _, {id, _, Entrypoint}, Type} <- Fields ]. - -%% -spec insert_typedef(type_id(), [aeso_syntax:tvar()], aeso_syntax:typedef()) -> ok. -%% insert_typedef(Id, Args, Typedef) -> -%% Attrs = aeso_syntax:get_ann(Id), -%% Key = type_key(Id), -%% ets_insert(type_defs, {Key, Args, Typedef}), -%% case Typedef of -%% {record_t, Fields} -> -%% [insert_record_field(FieldName, #field_info{ kind = record, -%% field_t = FieldType, -%% record_t = {app_t, Attrs, Id, Args} }) -%% || {field_t, _, {id, _, FieldName}, FieldType} <- Fields], -%% ok; -%% {variant_t, _} -> ok; -%% {alias_t, _} -> ok -%% end. - -%% -spec lookup_type(type_id()) -> false | {[aeso_syntax:tvar()], aeso_syntax:typedef()}. -%% lookup_type(Id) -> -%% case ets_lookup(type_defs, type_key(Id)) of -%% [] -> false; -%% [{_Key, Params, Typedef}] -> -%% {Params, unfold_types_in_type(push_anns(Id, Typedef))} -%% end. - -push_anns(T1, {Ann, {Args, {alias_t, Id}}}) -> - As1 = aeso_syntax:get_ann(T1), - As2 = aeso_syntax:get_ann(Id), - As = umerge(lists:sort(As2), lists:sort(As1)), - {Ann, {Args, {alias_t, aeso_syntax:set_ann(As, Id)}}}; -push_anns(_, T) -> T. - -umerge([], Ls2) -> Ls2; -umerge(Ls1, []) -> Ls1; -umerge([E = {K, _V1} | Ls1], [{K, _V2} | Ls2]) -> - [E | umerge(Ls1, Ls2)]; -umerge([E = {K1, _V1} | Ls1], Ls2 = [{K2, _V2} | _]) when K1 < K2 -> - [E | umerge(Ls1, Ls2)]; -umerge(Ls1 = [{K1, _V1} | _], [E = {K2, _V2} | Ls2]) when K2 < K1 -> - [E | umerge(Ls1, Ls2)]. - - -%% -spec insert_record_field(string(), field_info()) -> true. -%% insert_record_field(FieldName, FieldInfo) -> -%% ets_insert(record_fields, {FieldName, FieldInfo}). - %% -- Constraints -- create_constraints() -> diff --git a/src/aeso_builtins.erl b/src/aeso_builtins.erl index 383fcf4..dfb2258 100644 --- a/src/aeso_builtins.erl +++ b/src/aeso_builtins.erl @@ -106,21 +106,22 @@ check_event_type(Icode) -> end. check_event_type(Evts, Icode) -> - [ check_event_type(Name, T, Icode) - || {constr_t, _, {con, _, Name}, Types} <- Evts, T <- Types ]. + [ check_event_type(Name, Ix, T, Icode) + || {constr_t, Ann, {con, _, Name}, Types} <- Evts, + {Ix, T} <- lists:zip(aeso_syntax:get_ann(indices, Ann), Types) ]. -check_event_type(EvtName, Type, Icode) -> +check_event_type(EvtName, Ix, Type, Icode) -> VMType = try aeso_ast_to_icode:ast_typerep(Type, Icode) catch _:_ -> error({EvtName, could_not_resolve_type, Type}) end, - case aeso_syntax:get_ann(indexed, Type, false) of - true when VMType == word -> ok; - false when VMType == string -> ok; - true -> error({EvtName, indexed_field_should_be_word, is, VMType}); - false -> error({EvtName, payload_should_be_string, is, VMType}) + case {Ix, VMType} of + {indexed, word} -> ok; + {notindexed, string} -> ok; + {indexed, _} -> error({EvtName, indexed_field_should_be_word, is, VMType}); + {notindexed, _} -> error({EvtName, payload_should_be_string, is, VMType}) end. bfun(B, {IArgs, IExpr, IRet}) -> @@ -169,16 +170,15 @@ builtin_event(EventT) -> A = fun(X) -> aeb_opcodes:mnemonic(X) end, VIx = fun(Ix) -> v(lists:concat(["v", Ix])) end, ArgPats = fun(Ts) -> [ VIx(Ix) || Ix <- lists:seq(0, length(Ts) - 1) ] end, - IsIndexed = fun(T) -> aeso_syntax:get_ann(indexed, T, false) end, Payload = %% Should put data ptr, length on stack. fun([]) -> {inline_asm, [A(?PUSH1), 0, A(?PUSH1), 0]}; ([V]) -> {seq, [V, {inline_asm, [A(?DUP1), A(?MLOAD), %% length, ptr A(?SWAP1), A(?PUSH1), 32, A(?ADD)]}]} %% ptr+32, length end, Clause = - fun(_Tag, {con, _, Con}, Types) -> - Indexed = [ Var || {Var, Type} <- lists:zip(ArgPats(Types), Types), - IsIndexed(Type) ], + fun(_Tag, {con, _, Con}, IxTypes) -> + Types = [ T || {_Ix, T} <- IxTypes ], + Indexed = [ Var || {Var, {indexed, _Type}} <- lists:zip(ArgPats(Types), IxTypes) ], EvtIndex = {unop, 'sha3', str_to_icode(Con)}, {event, lists:reverse(Indexed) ++ [EvtIndex], Payload(ArgPats(Types) -- Indexed)} end, @@ -189,8 +189,8 @@ builtin_event(EventT) -> {[{"e", event}], {switch, v(e), - [{Pat(Tag, Types), Clause(Tag, Con, Types)} - || {Tag, {constr_t, _, Con, Types}} <- lists:zip(Tags, Cons) ]}, + [{Pat(Tag, Types), Clause(Tag, Con, lists:zip(aeso_syntax:get_ann(indices, Ann), Types))} + || {Tag, {constr_t, Ann, Con, Types}} <- lists:zip(Tags, Cons) ]}, {tuple, []}}. %% Abort primitive. From 10be09fe3038c9547e6e7d02297d08f1c5c41d74 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 4 Feb 2019 11:56:06 +0100 Subject: [PATCH 03/18] Add checks on event constructor arguments to type checker --- src/aeso_ast_infer_types.erl | 46 ++++++++++++++++++++++++++++--- test/aeso_compiler_tests.erl | 16 ++++++----- test/contract_tests.erl | 28 ------------------- test/contracts/bad_events.aes | 25 +++++++++++++++++ test/contracts/bad_events2.aes | 23 ++++++++++++++++ test/contracts/simple_storage.aes | 1 - 6 files changed, 99 insertions(+), 40 deletions(-) delete mode 100644 test/contract_tests.erl create mode 100644 test/contracts/bad_events.aes create mode 100644 test/contracts/bad_events2.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 55f3730..6d3d7c7 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -607,11 +607,13 @@ check_event(Env, "event", Ann, Def) -> case Def of {variant_t, Cons} -> {variant_t, [ check_event_con(Env, Con) || Con <- Cons ]}; - _ -> type_error({event_must_be_variant_type, Ann}) + _ -> + type_error({event_must_be_variant_type, Ann}), + Def end; check_event(_Env, _Name, _Ann, Def) -> Def. -check_event_con(_Env, {constr_t, Ann, Con, Args}) -> +check_event_con(Env, {constr_t, Ann, Con, Args}) -> IsIndexed = fun(T) -> case aeso_syntax:get_ann(indexed, T, false) of true -> indexed; false -> notindexed @@ -619,11 +621,31 @@ check_event_con(_Env, {constr_t, Ann, Con, Args}) -> Indices = lists:map(IsIndexed, Args), Indexed = [ T || T <- Args, IsIndexed(T) == indexed ], NonIndexed = Args -- Indexed, + [ check_event_arg_type(Env, Ix, Type) || {Ix, Type} <- lists:zip(Indices, Args) ], %% TODO: Is is possible to check also the types of arguments in a sensible way? [ type_error({event_0_to_3_indexed_values, Con}) || length(Indexed) > 3 ], [ type_error({event_0_to_1_string_values, Con}) || length(NonIndexed) > 1 ], {constr_t, [{indices, Indices} | Ann], Con, Args}. +check_event_arg_type(Env, Ix, Type0) -> + Type = unfold_types_in_type(Env, Type0), + case Ix of + indexed -> [ type_error({indexed_type_must_be_word, Type0, Type}) || not is_word_type(Type) ]; + notindexed -> [ type_error({payload_type_must_be_string, Type0, Type}) || not is_string_type(Type) ] + end. + +%% Not so nice. +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({con, _, _}) -> true; +is_word_type({qcon, _, _}) -> true; +is_word_type(_) -> false. + +is_string_type({id, _, "string"}) -> true; +is_string_type(_) -> false. + -spec check_constructor_overlap(env(), aeso_syntax:con(), type()) -> ok | no_return(). check_constructor_overlap(Env, Con = {con, _, Name}, NewType) -> case lookup_name(Env, Name) of @@ -1686,10 +1708,26 @@ pp_error({recursive_types_not_implemented, Types}) -> true -> " is" end, io_lib:format("The following type~s recursive, which is not yet supported:\n~s", [S, [io_lib:format(" - ~s (at ~s)\n", [pp(T), pp_loc(T)]) || T <- Types]]); +pp_error({event_must_be_variant_type, Where}) -> + io_lib:format("The event type must be a variant type (at ~s)\n", [pp_loc(Where)]); +pp_error({indexed_type_must_be_word, Type, Type}) -> + io_lib:format("The indexed type ~s (at ~s) is not a word type\n", + [pp_type("", Type), pp_loc(Type)]); +pp_error({indexed_type_must_be_word, Type, Type1}) -> + io_lib:format("The indexed type ~s (at ~s) equals ~s which is not a word type\n", + [pp_type("", Type), pp_loc(Type), pp_type("", Type1)]); +pp_error({payload_type_must_be_string, Type, Type}) -> + io_lib:format("The payload type ~s (at ~s) should be string\n", + [pp_type("", Type), pp_loc(Type)]); +pp_error({payload_type_must_be_string, Type, Type1}) -> + io_lib:format("The payload type ~s (at ~s) equals ~s but it should be string\n", + [pp_type("", Type), pp_loc(Type), pp_type("", Type1)]); pp_error({event_0_to_3_indexed_values, Constr}) -> - io_lib:format("The event constructor ~s has too many indexed values (max 3)\n", [Constr]); + io_lib:format("The event constructor ~s (at ~s) has too many indexed values (max 3)\n", + [name(Constr), pp_loc(Constr)]); pp_error({event_0_to_1_string_values, Constr}) -> - io_lib:format("The event constructor ~s has too many string values (max 1)\n", [Constr]); + io_lib:format("The event constructor ~s (at ~s) has too many string values (max 1)\n", + [name(Constr), pp_loc(Constr)]); pp_error({repeated_constructor, Cs}) -> io_lib:format("Variant types must have distinct constructor names\n~s", [[ io_lib:format("~s (at ~s)\n", [pp_typed(" - ", C, T), pp_loc(C)]) || {C, T} <- Cs ]]); diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 434513f..0880017 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -10,15 +10,10 @@ -include_lib("eunit/include/eunit.hrl"). -%% simple_compile_test_() -> ok. %% Very simply test compile the given contracts. Only basic checks %% are made on the output, just that it is a binary which indicates %% that the compilation worked. - simple_compile_test_() -> - {setup, - fun () -> ok end, %Setup - fun (_) -> ok end, %Cleanup [ {"Testing the " ++ ContractName ++ " contract", fun() -> #{byte_code := ByteCode, @@ -31,8 +26,7 @@ simple_compile_test_() -> <<"Type errors\n",ErrorString/binary>> = compile(ContractName), check_errors(lists:sort(ExpectedErrors), ErrorString) end} || - {ContractName, ExpectedErrors} <- failing_contracts() ] - }. + {ContractName, ExpectedErrors} <- failing_contracts() ]. check_errors(Expect, ErrorString) -> %% This removes the final single \n as well. @@ -168,4 +162,12 @@ failing_contracts() -> <<"The fields y, z are missing when constructing an element of type r('a) (at line 6, column 40)">>]} , {"namespace_clash", [<<"The contract Call (at line 4, column 10) has the same name as a namespace at (builtin location)">>]} + , {"bad_events", + [<<"The payload type int (at line 10, column 30) should be string">>, + <<"The payload type alias_address (at line 12, column 30) equals address but it should be string">>, + <<"The indexed type string (at line 9, column 25) is not a word type">>, + <<"The indexed type alias_string (at line 11, column 25) equals string which is not a word type">>]} + , {"bad_events2", + [<<"The event constructor BadEvent1 (at line 9, column 7) has too many string values (max 1)">>, + <<"The event constructor BadEvent2 (at line 10, column 7) has too many indexed values (max 3)">>]} ]. diff --git a/test/contract_tests.erl b/test/contract_tests.erl deleted file mode 100644 index 5f1762f..0000000 --- a/test/contract_tests.erl +++ /dev/null @@ -1,28 +0,0 @@ --module(contract_tests). - --include_lib("eunit/include/eunit.hrl"). - -make_cmd() -> "make -C " ++ aeso_test_utils:contract_path(). - -contracts_test_() -> - {setup, - fun() -> os:cmd(make_cmd()) end, - fun(_) -> os:cmd(make_cmd() ++ " clean") end, - [ {"Testing the " ++ Contract ++ " contract", - fun() -> - ?assertCmdOutput(Expected, filename:join(aeso_test_utils:contract_path(), Contract ++ "_test")) - end} || {Contract, Expected} <- contracts() ]}. - -contracts() -> - []. - %% [{"voting", - %% "Delegate before vote\n" - %% "Cake: 1\n" - %% "Beer: 2\n" - %% "Winner: Beer\n" - %% "Delegate after vote\n" - %% "Cake: 1\n" - %% "Beer: 2\n" - %% "Winner: Beer\n" - %% }]. - diff --git a/test/contracts/bad_events.aes b/test/contracts/bad_events.aes new file mode 100644 index 0000000..5f0d17c --- /dev/null +++ b/test/contracts/bad_events.aes @@ -0,0 +1,25 @@ +contract Events = + type alias_int = int + type alias_address = address + type alias_string = string + + datatype event = + Event1(indexed alias_int, indexed int, string) + | Event2(alias_string, indexed alias_address) + | BadEvent1(indexed string, string) + | BadEvent2(indexed int, int) + | BadEvent3(indexed alias_string, string) + | BadEvent4(indexed int, alias_address) + + function f1(x : int, y : string) = + Chain.event(Event1(x, x+1, y)) + + function f2(s : string) = + Chain.event(Event2(s, Call.caller)) + + function f3(x : int) = + Chain.event(Event1(x, x + 2, Int.to_str(x + 7))) + + function i2s(i : int) = Int.to_str(i) + function a2s(a : address) = Address.to_str(a) + diff --git a/test/contracts/bad_events2.aes b/test/contracts/bad_events2.aes new file mode 100644 index 0000000..02842e3 --- /dev/null +++ b/test/contracts/bad_events2.aes @@ -0,0 +1,23 @@ +contract Events = + type alias_int = int + type alias_address = address + type alias_string = string + + datatype event = + Event1(indexed alias_int, indexed int, string) + | Event2(alias_string, indexed alias_address) + | BadEvent1(string, string) + | BadEvent2(indexed int, indexed int, indexed int, indexed address) + + function f1(x : int, y : string) = + Chain.event(Event1(x, x+1, y)) + + function f2(s : string) = + Chain.event(Event2(s, Call.caller)) + + function f3(x : int) = + Chain.event(Event1(x, x + 2, Int.to_str(x + 7))) + + function i2s(i : int) = Int.to_str(i) + function a2s(a : address) = Address.to_str(a) + diff --git a/test/contracts/simple_storage.aes b/test/contracts/simple_storage.aes index 3b1a9e9..2c45a53 100644 --- a/test/contracts/simple_storage.aes +++ b/test/contracts/simple_storage.aes @@ -18,7 +18,6 @@ contract SimpleStorage = - type event = int record state = { data : int } function init(value : int) : state = { data = value } From 478da2af3309b5cbb12442ee413640c13cbef10e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 4 Feb 2019 12:27:08 +0100 Subject: [PATCH 04/18] Don't expose namespace functions as entrypoints --- src/aeso_ast_to_icode.erl | 24 +++++++++++++++++------- test/contracts/namespaces.aes | 4 ---- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index 196defa..794cbd5 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -17,12 +17,14 @@ -spec convert_typed(aeso_syntax:ast(), list()) -> aeso_icode:icode(). convert_typed(TypedTree, Options) -> - code(TypedTree, aeso_icode:new(Options)). + Name = case lists:last(TypedTree) of + {contract, _, {con, _, Con}, _} -> Con; + _ -> gen_error(last_declaration_must_be_contract) + end, + code(TypedTree, aeso_icode:set_name(Name, aeso_icode:new(Options))). -code([{contract, _Attribs, Con = {con, _, Name}, Code}|Rest], Icode) -> - NewIcode = contract_to_icode(Code, - aeso_icode:set_namespace(Con, - aeso_icode:set_name(Name, Icode))), +code([{contract, _Attribs, Con, Code}|Rest], Icode) -> + NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Con, Icode)), code(Rest, NewIcode); code([{namespace, _Ann, Name, Code}|Rest], Icode) -> NewIcode = contract_to_icode(Code, aeso_icode:enter_namespace(Name, Icode)), @@ -79,8 +81,7 @@ contract_to_icode([{type_def, _Attrib, {id, _, Name}, Args, Def} | Rest], contract_to_icode(Rest, Icode2); contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest], Icode) -> FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++ - [ private || proplists:get_value(private, Attrib, false) orelse - proplists:get_value(internal, Attrib, false) ], + [ private || is_private(Attrib, Icode) ], %% TODO: Handle types FunName = ast_id(Name), %% TODO: push funname to env @@ -765,6 +766,15 @@ has_maps({list, T}) -> has_maps(T); has_maps({tuple, Ts}) -> lists:any(fun has_maps/1, Ts); has_maps({variant, Cs}) -> lists:any(fun has_maps/1, lists:append(Cs)). +%% A function is private if marked 'private' or 'internal', or if it's not +%% defined in the main contract name space. (NOTE: changes when we introduce +%% inheritance). +is_private(Ann, #{ contract_name := MainContract } = Icode) -> + {_, _, CurrentNamespace} = aeso_icode:get_namespace(Icode), + proplists:get_value(private, Ann, false) orelse + proplists:get_value(internal, Ann, false) orelse + MainContract /= CurrentNamespace. + %% ------------------------------------------------------------------- %% Builtins %% ------------------------------------------------------------------- diff --git a/test/contracts/namespaces.aes b/test/contracts/namespaces.aes index 7a61575..09d0a2e 100644 --- a/test/contracts/namespaces.aes +++ b/test/contracts/namespaces.aes @@ -22,10 +22,6 @@ namespace Lib = contract TestNamespaces = - record state = { x : int } - - function init() = { x = 0 } - function palindrome(xs : list(int)) : bool = Lib.eqlist(xs, Lib.reverse(xs)) From dfa286d43c7bf69c4f48a1da481e32cf9e05648f Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 4 Feb 2019 14:08:26 +0100 Subject: [PATCH 05/18] Deadcode elimination (icode post pass) --- src/aeso_ast_to_icode.erl | 39 ++++++++++++++++++++++++++++++++++- src/aeso_icode.hrl | 2 +- test/aeso_compiler_tests.erl | 15 ++++++++++++-- test/contracts/deadcode.aes | 21 +++++++++++++++++++ test/contracts/nodeadcode.aes | 21 +++++++++++++++++++ 5 files changed, 94 insertions(+), 4 deletions(-) create mode 100644 test/contracts/deadcode.aes create mode 100644 test/contracts/nodeadcode.aes diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index 794cbd5..4713275 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -21,7 +21,8 @@ convert_typed(TypedTree, Options) -> {contract, _, {con, _, Con}, _} -> Con; _ -> gen_error(last_declaration_must_be_contract) end, - code(TypedTree, aeso_icode:set_name(Name, aeso_icode:new(Options))). + Icode = code(TypedTree, aeso_icode:set_name(Name, aeso_icode:new(Options))), + deadcode_elimination(Icode). code([{contract, _Attribs, Con, Code}|Rest], Icode) -> NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Con, Icode)), @@ -786,3 +787,39 @@ builtin_call(Builtin, Args) -> add_builtins(Icode = #{functions := Funs}) -> Builtins = aeso_builtins:used_builtins(Funs), Icode#{functions := [ aeso_builtins:builtin_function(B) || B <- Builtins ] ++ Funs}. + + +%% ------------------------------------------------------------------- +%% Deadcode elimination +%% ------------------------------------------------------------------- + +deadcode_elimination(Icode = #{ functions := Funs }) -> + PublicNames = [ Name || {Name, Ann, _, _, _} <- Funs, not lists:member(private, Ann) ], + ArgsToPat = fun(Args) -> [ #var_ref{ name = X } || {X, _} <- Args ] end, + Defs = maps:from_list([ {Name, {binder, ArgsToPat(Args), Body}} || {Name, _, Args, Body, _} <- Funs ]), + UsedNames = chase_names(Defs, PublicNames, #{}), + UsedFuns = [ Def || Def = {Name, _, _, _, _} <- Funs, maps:is_key(Name, UsedNames) ], + Icode#{ functions := UsedFuns }. + +chase_names(_Defs, [], Used) -> Used; +chase_names(Defs, [X | Xs], Used) -> + %% can happen when compiling __call contracts + case maps:is_key(X, Used) orelse not maps:is_key(X, Defs) of + true -> chase_names(Defs, Xs, Used); %% already chased + false -> + Def = maps:get(X, Defs), + Vars = maps:keys(free_vars(Def)), + chase_names(Defs, Vars ++ Xs, Used#{ X => true }) + end. + +free_vars(#var_ref{ name = X }) -> #{ X => true }; +free_vars(#arg{ name = X }) -> #{ X => true }; +free_vars({binder, Pat, Body}) -> + maps:without(maps:keys(free_vars(Pat)), free_vars(Body)); +free_vars(#switch{ expr = E, cases = Cases }) -> + free_vars([E | [{binder, P, B} || {P, B} <- Cases]]); +free_vars(#lambda{ args = Xs, body = E }) -> + free_vars({binder, Xs, E}); +free_vars(T) when is_tuple(T) -> free_vars(tuple_to_list(T)); +free_vars([H | T]) -> maps:merge(free_vars(H), free_vars(T)); +free_vars(_) -> #{}. diff --git a/src/aeso_icode.hrl b/src/aeso_icode.hrl index 2fdabf5..56da80a 100644 --- a/src/aeso_icode.hrl +++ b/src/aeso_icode.hrl @@ -20,7 +20,7 @@ , args :: arg_list() , body :: expr()}). --record(var_ref, { name :: string() | {builtin, atom() | tuple()}}). +-record(var_ref, { name :: string() | list(string()) | {builtin, atom() | tuple()}}). -record(prim_call_contract, { gas :: expr() diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 0880017..eccb6a0 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -26,7 +26,16 @@ simple_compile_test_() -> <<"Type errors\n",ErrorString/binary>> = compile(ContractName), check_errors(lists:sort(ExpectedErrors), ErrorString) end} || - {ContractName, ExpectedErrors} <- failing_contracts() ]. + {ContractName, ExpectedErrors} <- failing_contracts() ] ++ + [ {"Testing deadcode elimination", + fun() -> + #{ byte_code := NoDeadCode } = compile("nodeadcode"), + #{ byte_code := DeadCode } = compile("deadcode"), + SizeNoDeadCode = byte_size(NoDeadCode), + SizeDeadCode = byte_size(DeadCode), + ?assertMatch({_, _, true}, {SizeDeadCode, SizeNoDeadCode, SizeDeadCode + 40 < SizeNoDeadCode}), + ok + end} ]. check_errors(Expect, ErrorString) -> %% This removes the final single \n as well. @@ -64,7 +73,9 @@ compilable_contracts() -> "stack", "test", "builtin_bug", - "builtin_map_get_bug" + "builtin_map_get_bug", + "nodeadcode", + "deadcode" ]. %% Contracts that should produce type errors diff --git a/test/contracts/deadcode.aes b/test/contracts/deadcode.aes new file mode 100644 index 0000000..b96bf34 --- /dev/null +++ b/test/contracts/deadcode.aes @@ -0,0 +1,21 @@ + +namespace List = + + function map1(f : 'a => 'b, xs : list('a)) = + switch(xs) + [] => [] + x :: xs => f(x) :: map1(f, xs) + + function map2(f : 'a => 'b, xs : list('a)) = + switch(xs) + [] => [] + x :: xs => f(x) :: map2(f, xs) + +contract Deadcode = + + function inc1(xs : list(int)) : list(int) = + List.map1((x) => x + 1, xs) + + function inc2(xs : list(int)) : list(int) = + List.map1((x) => x + 1, xs) + diff --git a/test/contracts/nodeadcode.aes b/test/contracts/nodeadcode.aes new file mode 100644 index 0000000..90774c4 --- /dev/null +++ b/test/contracts/nodeadcode.aes @@ -0,0 +1,21 @@ + +namespace List = + + function map1(f : 'a => 'b, xs : list('a)) = + switch(xs) + [] => [] + x :: xs => f(x) :: map1(f, xs) + + function map2(f : 'a => 'b, xs : list('a)) = + switch(xs) + [] => [] + x :: xs => f(x) :: map2(f, xs) + +contract Deadcode = + + function inc1(xs : list(int)) : list(int) = + List.map1((x) => x + 1, xs) + + function inc2(xs : list(int)) : list(int) = + List.map2((x) => x + 1, xs) + From d9188d58a722a7c3d62d1d0426a3a7474299f913 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 4 Feb 2019 18:01:47 +0100 Subject: [PATCH 06/18] Proper checking of types --- src/aeso_ast_infer_types.erl | 187 ++++++++++++++++++++++++++-------- src/aeso_ast_to_icode.erl | 19 ++-- src/aeso_compiler.erl | 6 +- src/aeso_pretty.erl | 6 +- test/aeso_compiler_tests.erl | 10 +- test/contracts/type_clash.aes | 13 +++ 6 files changed, 187 insertions(+), 54 deletions(-) create mode 100644 test/contracts/type_clash.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 6d3d7c7..c1ee415 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -95,6 +95,7 @@ -record(env, { scopes = #{ [] => #scope{}} :: #{ qname() => scope() } , vars = [] :: [{name(), var_info()}] + , typevars = unrestricted :: unrestricted | [name()] , fields = #{} :: #{ name() => [field_info()] } %% fields are global , namespace = [] :: qname() }). @@ -135,6 +136,18 @@ bind_vars([], Env) -> Env; bind_vars([{X, T} | Vars], Env) -> bind_vars(Vars, bind_var(X, T, Env)). +-spec bind_tvars([aeso_syntax:tvar()], env()) -> env(). +bind_tvars(Xs, Env) -> + Env#env{ typevars = [X || {tvar, _, X} <- Xs] }. + +-spec check_tvar(env(), aeso_syntax:tvar()) -> aeso_syntax:tvar() | no_return(). +check_tvar(#env{ typevars = TVars}, T = {tvar, _, X}) -> + case TVars == unrestricted orelse lists:member(X, TVars) of + true -> ok; + false -> type_error({unbound_type_variable, T}) + end, + T. + -spec bind_fun(name(), type() | typesig(), env()) -> env(). bind_fun(X, Type, Env) -> Ann = aeso_syntax:get_ann(Type), @@ -159,6 +172,19 @@ bind_type(X, Ann, Def, Env) -> Scope#scope{ types = [{X, {Ann, Def}} | Types] } end). +%% Bind state primitives +-spec bind_state(env()) -> env(). +bind_state(Env) -> + Ann = [{origin, system}], + Unit = {tuple_t, Ann, []}, + State = + case lookup_type(Env, {id, Ann, "state"}) of + {S, _} -> {qid, Ann, S}; + false -> Unit + end, + bind_funs([{"state", State}, + {"put", {fun_t, Ann, [], [State], Unit}}], Env). + -spec bind_field(name(), field_info(), env()) -> env(). bind_field(X, Info, Env = #env{ fields = Fields }) -> Fields1 = maps:update_with(X, fun(Infos) -> [Info | Infos] end, [Info], Fields), @@ -300,7 +326,6 @@ global_env() -> String = {id, Ann, "string"}, Address = {id, Ann, "address"}, Event = {id, Ann, "event"}, - State = {id, Ann, "state"}, Hash = {id, Ann, "hash"}, Bits = {id, Ann, "bits"}, Oracle = fun(Q, R) -> {app_t, Ann, {id, Ann, "oracle"}, [Q, R]} end, @@ -331,9 +356,6 @@ global_env() -> %% TTL constructors {"RelativeTTL", Fun1(Int, TTL)}, {"FixedTTL", Fun1(Int, TTL)}, - %% State - {"state", State}, - {"put", Fun1(State, Unit)}, %% Abort {"abort", Fun1(String, A)}]) , types = MkDefs( @@ -356,7 +378,7 @@ global_env() -> {"difficulty", Int}, {"gas_limit", Int}, {"event", Fun1(Event, Unit)}]) - , types = MkDefs([{"TTL", 0}]) }, + , types = MkDefs([{"ttl", 0}]) }, ContractScope = #scope { funs = MkDefs( @@ -488,17 +510,17 @@ infer(Contracts, Options) -> -spec infer1(env(), [aeso_syntax:decl()], [aeso_syntax:decl()]) -> [aeso_syntax:decl()]. infer1(_, [], Acc) -> lists:reverse(Acc); -infer1(Env, [Contract = {contract, Ann, ConName, Code} | Rest], Acc) -> +infer1(Env, [{contract, Ann, ConName, Code} | Rest], Acc) -> %% do type inference on each contract independently. check_scope_name_clash(Env, contract, ConName), - {Env1, Code1} = infer_contract_top(push_scope(contract, ConName, Env), Code), + {Env1, Code1} = infer_contract_top(push_scope(contract, ConName, Env), contract, Code), Contract1 = {contract, Ann, ConName, Code1}, Env2 = pop_scope(Env1), - Env3 = bind_contract(Contract, Env2), + Env3 = bind_contract(Contract1, Env2), infer1(Env3, Rest, [Contract1 | Acc]); infer1(Env, [{namespace, Ann, Name, Code} | Rest], Acc) -> check_scope_name_clash(Env, namespace, Name), - {Env1, Code1} = infer_contract_top(push_scope(namespace, Name, Env), Code), + {Env1, Code1} = infer_contract_top(push_scope(namespace, Name, Env), namespace, Code), Namespace1 = {namespace, Ann, Name, Code1}, infer1(pop_scope(Env1), Rest, [Namespace1 | Acc]). @@ -508,13 +530,13 @@ check_scope_name_clash(Env, Kind, Name) -> #scope{ kind = K, ann = Ann } -> create_type_errors(), type_error({duplicate_scope, Kind, Name, K, Ann}), - destroy_and_report_type_errors() + destroy_and_report_type_errors(Env) end. --spec infer_contract_top(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. -infer_contract_top(Env, Defs0) -> +-spec infer_contract_top(env(), contract | namespace, [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. +infer_contract_top(Env, Kind, Defs0) -> Defs = desugar(Defs0), - {Env1, Defs1} = infer_contract(Env, Defs), + {Env1, Defs1} = infer_contract(Env, Kind, Defs), Env2 = on_current_scope(Env1, fun(Scope) -> unfold_record_types(Env1, Scope) end), Defs2 = unfold_record_types(Env2, Defs1), {Env2, Defs2}. @@ -528,17 +550,22 @@ infer_constant({letval, Attrs,_Pattern, Type, E}) -> %% infer_contract takes a proplist mapping global names to types, and %% a list of definitions. --spec infer_contract(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. -infer_contract(Env, Defs) -> +-spec infer_contract(env(), contract | namespace, [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. +infer_contract(Env, What, Defs) -> Kind = fun({type_def, _, _, _, _}) -> type; ({letfun, _, _, _, _, _}) -> function; ({fun_decl, _, _, _}) -> prototype end, Get = fun(K) -> [ Def || Def <- Defs, Kind(Def) == K ] end, {Env1, TypeDefs} = check_typedefs(Env, Get(type)), - ProtoSigs = [ check_fundecl(Env1, Decl) || Decl <- Get(prototype) ], + Env2 = + case What of + namespace -> Env1; + contract -> bind_state(Env1) %% bind state and put + end, + {ProtoSigs, Decls} = lists:unzip([ check_fundecl(Env1, Decl) || Decl <- Get(prototype) ]), create_type_errors(), - Env2 = bind_funs(ProtoSigs, Env1), + Env3 = bind_funs(ProtoSigs, Env2), Functions = Get(function), %% Check for duplicates in Functions (we turn it into a map below) _ = bind_funs([{Fun, {tuple_t, Ann, []}} || {letfun, Ann, {id, _, Fun}, _, _, _} <- Functions], @@ -548,9 +575,9 @@ infer_contract(Env, Defs) -> DepGraph = maps:map(fun(_, Def) -> aeso_syntax_utils:used_ids(Def) end, FunMap), SCCs = aeso_utils:scc(DepGraph), %% io:format("Dependency sorted functions:\n ~p\n", [SCCs]), - {Env3, Defs1} = check_sccs(Env2, FunMap, SCCs, []), - destroy_and_report_type_errors(), - {Env3, TypeDefs ++ Defs1}. + {Env4, Defs1} = check_sccs(Env3, FunMap, SCCs, []), + destroy_and_report_type_errors(Env4), + {Env4, TypeDefs ++ Decls ++ Defs1}. -spec check_typedefs(env(), [aeso_syntax:decl()]) -> {env(), [aeso_syntax:decl()]}. check_typedefs(Env, Defs) -> @@ -560,7 +587,7 @@ check_typedefs(Env, Defs) -> DepGraph = maps:map(fun(_, Def) -> aeso_syntax_utils:used_types(Def) end, TypeMap), SCCs = aeso_utils:scc(DepGraph), {Env1, Defs1} = check_typedef_sccs(Env, TypeMap, SCCs, []), - destroy_and_report_type_errors(), + destroy_and_report_type_errors(Env), {Env1, Defs1}. -spec check_typedef_sccs(env(), #{ name() => aeso_syntax:decl() }, @@ -571,17 +598,18 @@ check_typedef_sccs(Env, TypeMap, [{acyclic, Name} | SCCs], Acc) -> case maps:get(Name, TypeMap, undefined) of undefined -> check_typedef_sccs(Env, TypeMap, SCCs, Acc); %% Builtin type {type_def, Ann, D, Xs, Def0} -> - Def = check_event(Env, Name, Ann, Def0), + Def = check_event(Env, Name, Ann, check_typedef(bind_tvars(Xs, Env), Def0)), Acc1 = [{type_def, Ann, D, Xs, Def} | Acc], Env1 = bind_type(Name, Ann, {Xs, Def}, Env), case Def of - {alias_t, _} -> check_typedef_sccs(Env1, TypeMap, SCCs, Acc1); %% TODO: check these + {alias_t, _} -> check_typedef_sccs(Env1, TypeMap, SCCs, Acc1); {record_t, Fields} -> - RecTy = app_t(Ann, D, Xs), + %% check_type to get qualified name + RecTy = check_type(Env1, app_t(Ann, D, Xs)), Env2 = check_fields(Env1, TypeMap, RecTy, Fields), check_typedef_sccs(Env2, TypeMap, SCCs, Acc1); {variant_t, Cons} -> - Target = app_t(Ann, D, Xs), + Target = check_type(Env1, app_t(Ann, D, Xs)), ConType = fun([]) -> Target; (Args) -> {type_sig, Ann, [], Args, Target} end, ConTypes = [ begin {constr_t, _, {con, _, Con}, Args} = ConDef, @@ -597,6 +625,65 @@ check_typedef_sccs(Env, TypeMap, [{cyclic, Names} | SCCs], Acc) -> type_error({recursive_types_not_implemented, lists:map(Id, Names)}), check_typedef_sccs(Env, TypeMap, SCCs, Acc). +-spec check_typedef(env(), aeso_syntax:typedef()) -> aeso_syntax:typedef(). +check_typedef(Env, {alias_t, Type}) -> + {alias_t, check_type(Env, Type)}; +check_typedef(Env, {record_t, Fields}) -> + {record_t, [ {field_t, Ann, Id, check_type(Env, Type)} || {field_t, Ann, Id, Type} <- Fields ]}; +check_typedef(Env, {variant_t, Cons}) -> + {variant_t, [ {constr_t, Ann, Con, [ check_type(Env, Arg) || Arg <- Args ]} + || {constr_t, Ann, Con, Args} <- Cons ]}. + +-spec check_type(env(), aeso_syntax:type()) -> aeso_syntax:type(). +check_type(Env, T) -> + check_type(Env, T, 0). + +%% Check a type against an arity. +-spec check_type(env(), utype(), non_neg_integer()) -> utype(). +check_type(Env, T = {tvar, _, _}, Arity) -> + [ type_error({higher_kinded_typevar, T}) || Arity /= 0 ], + check_tvar(Env, T); +check_type(_Env, X = {id, _, "_"}, Arity) -> + ensure_base_type(X, Arity), + X; +check_type(Env, X = {Tag, _, _}, Arity) when Tag == con; Tag == qcon; Tag == id; Tag == qid -> + case lookup_type(Env, X) of + {Q, {_, Def}} -> + Arity1 = case Def of + {builtin, Ar} -> Ar; + {Args, _} -> length(Args) + end, + [ type_error({wrong_type_arguments, X, Arity, Arity1}) || Arity /= Arity1 ], + set_qname(Q, X); + false -> type_error({unbound_type, X}), X + end; +check_type(Env, Type = {tuple_t, Ann, Types}, Arity) -> + ensure_base_type(Type, Arity), + {tuple_t, Ann, [ check_type(Env, T, 0) || T <- Types ]}; +check_type(Env, {app_t, Ann, Type, Types}, Arity) -> + Types1 = [ check_type(Env, T, 0) || T <- Types ], + Type1 = check_type(Env, Type, Arity + length(Types)), + {app_t, Ann, Type1, Types1}; +check_type(Env, Type = {fun_t, Ann, NamedArgs, Args, Ret}, Arity) -> + ensure_base_type(Type, Arity), + NamedArgs1 = [ check_named_arg(Env, NamedArg) || NamedArg <- NamedArgs ], + Args1 = [ check_type(Env, Arg, 0) || Arg <- Args ], + Ret1 = check_type(Env, Ret, 0), + {fun_t, Ann, NamedArgs1, Args1, Ret1}; +check_type(_Env, Type = {uvar, _, _}, Arity) -> + ensure_base_type(Type, Arity), + Type. + +ensure_base_type(Type, Arity) -> + [ type_error({wrong_type_arguments, Type, Arity, 0}) || Arity /= 0 ], + ok. + +-spec check_named_arg(env(), aeso_syntax:named_arg_t()) -> aeso_syntax:named_arg_t(). +check_named_arg(Env, {named_arg_t, Ann, Id, Type, Default}) -> + Type1 = check_type(Env, Type), + {typed, _, Default1, _} = check_expr(Env, Default, Type1), + {named_arg_t, Ann, Id, Type1, Default1}. + -spec check_fields(env(), #{ name() => aeso_syntax:decl() }, type(), [aeso_syntax:field_t()]) -> env(). check_fields(Env, _TypeMap, _, []) -> Env; check_fields(Env, TypeMap, RecTy, [{field_t, Ann, Id, Type} | Fields]) -> @@ -622,7 +709,6 @@ check_event_con(Env, {constr_t, Ann, Con, Args}) -> Indexed = [ T || T <- Args, IsIndexed(T) == indexed ], NonIndexed = Args -- Indexed, [ check_event_arg_type(Env, Ix, Type) || {Ix, Type} <- lists:zip(Indices, Args) ], - %% TODO: Is is possible to check also the types of arguments in a sensible way? [ type_error({event_0_to_3_indexed_values, Con}) || length(Indexed) > 3 ], [ type_error({event_0_to_1_string_values, Con}) || length(NonIndexed) > 1 ], {constr_t, [{indices, Indices} | Ann], Con, Args}. @@ -690,9 +776,10 @@ check_reserved_entrypoints(Funs) -> || {Name, Def} <- maps:to_list(Funs), lists:member(Name, Reserved) ], ok. --spec check_fundecl(env(), aeso_syntax:decl()) -> {name(), typesig()}. -check_fundecl(_Env, {fun_decl, Ann, {id, _, Name}, {fun_t, _, Named, Args, Ret}}) -> - {Name, {type_sig, Ann, Named, Args, Ret}}; %% TODO: actually check that the type makes sense! +-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, Named, Args, Ret}}, {fun_decl, Ann, Id, Type1}}; check_fundecl(_, {fun_decl, _Attrib, {id, _, Name}, Type}) -> error({fundecl_must_have_funtype, Name, Type}). @@ -712,8 +799,8 @@ check_special_funs(Env, {{"init", Type}, _}) -> State = %% We might have implicit (no) state. case lookup_type(Env, {id, [], "state"}) of - false -> {tuple_t, [{origin, system}], []}; - _ -> {id, [{origin, system}], "state"} + false -> {tuple_t, [{origin, system}], []}; + {S, _} -> {qid, [], S} end, unify(Env, Res, State, {checking_init_type, Ann}); check_special_funs(_, _) -> ok. @@ -743,8 +830,8 @@ infer_letrec(Env, {letrec, Attrs, Defs}) -> {TypeSigs, {letrec, Attrs, NewDefs}}. infer_letfun(Env, {letfun, Attrib, {id, NameAttrib, Name}, Args, What, Body}) -> - ArgTypes = [{ArgName, arg_type(T)} || {arg, _, ArgName, T} <- Args], - ExpectedType = arg_type(What), + ArgTypes = [{ArgName, check_type(Env, arg_type(T))} || {arg, _, ArgName, T} <- Args], + ExpectedType = check_type(Env, arg_type(What)), NewBody={typed, _, _, ResultType} = check_expr(bind_vars(ArgTypes, Env), Body, ExpectedType), NewArgs = [{arg, A1, {id, A2, ArgName}, T} || {{_, T}, {arg, A1, {id, A2, ArgName}, _}} <- lists:zip(ArgTypes, Args)], @@ -822,7 +909,8 @@ infer_expr(Env, {list, As, Elems}) -> NewElems = [check_expr(Env, X, ElemType) || X <- Elems], {typed, As, {list, As, NewElems}, {app_t, As, {id, As, "list"}, [ElemType]}}; infer_expr(Env, {typed, As, Body, Type}) -> - {typed, _, NewBody, NewType} = check_expr(Env, Body, Type), + Type1 = check_type(Env, Type), + {typed, _, NewBody, NewType} = check_expr(Env, Body, Type1), {typed, As, NewBody, NewType}; infer_expr(Env, {app, Ann, Fun, Args0}) -> %% TODO: fix parser to give proper annotation for normal applications! @@ -925,7 +1013,7 @@ infer_expr(Env, {block, Attrs, Stmts}) -> {typed, Attrs, {block, Attrs, NewStmts}, BlockType}; infer_expr(Env, {lam, Attrs, Args, Body}) -> ArgTypes = [fresh_uvar(As) || {arg, As, _, _} <- Args], - ArgPatterns = [{typed, As, Pat, T} || {arg, As, Pat, T} <- Args], + ArgPatterns = [{typed, As, Pat, check_type(Env, T)} || {arg, As, Pat, T} <- Args], ResultType = fresh_uvar(Attrs), {'case', _, {typed, _, {tuple, _, NewArgPatterns}, _}, NewBody} = infer_case(Env, Attrs, {tuple, Attrs, ArgPatterns}, {tuple_t, Attrs, ArgTypes}, Body, ResultType), @@ -1526,8 +1614,8 @@ unify1(_Env, {qcon, _, Name}, {qcon, _, Name}, _When) -> unify1(Env, {fun_t, _, Named1, Args1, Result1}, {fun_t, _, Named2, Args2, Result2}, When) -> unify(Env, Named1, Named2, When) andalso unify(Env, Args1, Args2, When) andalso unify(Env, Result1, Result2, When); -unify1(Env, {app_t, _, {id, _, F}, Args1}, {app_t, _, {id, _, F}, Args2}, When) - when length(Args1) == length(Args2) -> +unify1(Env, {app_t, _, {Tag, _, F}, Args1}, {app_t, _, {Tag, _, F}, Args2}, When) + when length(Args1) == length(Args2), Tag == id orelse Tag == qid -> unify(Env, Args1, Args2, When); unify1(Env, {tuple_t, _, As}, {tuple_t, _, Bs}, When) when length(As) == length(Bs) -> @@ -1662,14 +1750,31 @@ type_error(Err) -> create_type_errors() -> ets_new(type_errors, [bag]). -destroy_and_report_type_errors() -> +destroy_and_report_type_errors(Env) -> Errors = ets_tab2list(type_errors), %% io:format("Type errors now: ~p\n", [Errors]), - PPErrors = [ pp_error(Err) || Err <- Errors ], + PPErrors = [ pp_error(unqualify(Env, Err)) || Err <- Errors ], ets_delete(type_errors), Errors /= [] andalso error({type_errors, [lists:flatten(Err) || Err <- PPErrors]}). +%% Strip current namespace from error message for nicer printing. +unqualify(#env{ namespace = NS }, {qid, Ann, Xs}) -> + qid(Ann, unqualify1(NS, Xs)); +unqualify(#env{ namespace = NS }, {qcon, Ann, Xs}) -> + qcon(Ann, unqualify1(NS, Xs)); +unqualify(Env, T) when is_tuple(T) -> + list_to_tuple(unqualify(Env, tuple_to_list(T))); +unqualify(Env, [H | T]) -> [unqualify(Env, H) | unqualify(Env, T)]; +unqualify(_Env, X) -> X. + +unqualify1(NS, Xs) -> + try lists:split(length(NS), Xs) of + {NS, Ys} -> Ys; + _ -> Xs + catch _:_ -> Xs + end. + pp_error({cannot_unify, A, B, When}) -> io_lib:format("Cannot unify ~s\n" " and ~s\n" @@ -1907,8 +2012,8 @@ pp({tuple_t, _, Cpts}) -> ["(", pp(Cpts), ")"]; pp({app_t, _, T, []}) -> pp(T); -pp({app_t, _, {id, _, Name}, Args}) -> - [Name, "(", pp(Args), ")"]; +pp({app_t, _, Type, Args}) -> + [pp(Type), "(", pp(Args), ")"]; pp({named_arg_t, _, Name, Type, Default}) -> [pp(Name), " : ", pp(Type), " = ", pp(Default)]; pp({fun_t, _, Named = {uvar, _, _}, As, B}) -> diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index 4713275..ffcb48a 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -58,7 +58,7 @@ contract_to_icode([{namespace, _, Name, Defs} | Rest], Icode) -> NS = aeso_icode:get_namespace(Icode), Icode1 = contract_to_icode(Defs, aeso_icode:enter_namespace(Name, Icode)), contract_to_icode(Rest, aeso_icode:set_namespace(NS, Icode1)); -contract_to_icode([{type_def, _Attrib, {id, _, Name}, Args, Def} | Rest], +contract_to_icode([{type_def, _Attrib, Id = {id, _, Name}, Args, Def} | Rest], Icode = #{ types := Types, constructors := Constructors }) -> TypeDef = make_type_def(Args, Def, Icode), NewConstructors = @@ -70,7 +70,8 @@ contract_to_icode([{type_def, _Attrib, {id, _, Name}, Args, Def} | Rest], maps:from_list([ {QName(Con), Tag} || {Tag, Con} <- lists:zip(Tags, Cons) ]); _ -> #{} end, - Icode1 = Icode#{ types := Types#{ Name => TypeDef }, + {_, _, TName} = aeso_icode:qualify(Id, Icode), + Icode1 = Icode#{ types := Types#{ TName => TypeDef }, constructors := maps:merge(Constructors, NewConstructors) }, Icode2 = case Name of "state" when Args == [] -> Icode1#{ state_type => ast_typerep(Def, Icode) }; @@ -108,9 +109,11 @@ contract_to_icode([{letrec,_,Defs}|Rest], Icode) -> %% just to parse a list of (mutually recursive) definitions. contract_to_icode(Defs++Rest, Icode); contract_to_icode([], Icode) -> Icode; -contract_to_icode(_Code, Icode) -> - %% TODO debug output for debug("Unhandled code ~p~n",[Code]), - Icode. +contract_to_icode([{fun_decl, _, _, _} | Code], Icode) -> + contract_to_icode(Code, Icode); +contract_to_icode([Decl | Code], Icode) -> + io:format("Unhandled declaration: ~p\n", [Decl]), + contract_to_icode(Code, Icode). ast_id({id, _, Id}) -> Id; ast_id({qid, _, Id}) -> Id. @@ -167,10 +170,10 @@ ast_body({qid, _, ["Chain", "spend"]}, _Icode) -> gen_error({underapplied_primitive, 'Chain.spend'}); %% State -ast_body({id, _, "state"}, _Icode) -> prim_state; -ast_body(?id_app("put", [NewState], _, _), Icode) -> +ast_body({qid, _, [Con, "state"]}, #{ contract_name := Con }) -> prim_state; +ast_body(?qid_app([Con, "put"], [NewState], _, _), Icode = #{ contract_name := Con }) -> #prim_put{ state = ast_body(NewState, Icode) }; -ast_body({id, _, "put"}, _Icode) -> +ast_body({qid, _, [Con, "put"]}, #{ contract_name := Con }) -> gen_error({underapplied_primitive, put}); %% TODO: eta %% Abort diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index a9f9be3..47937ab 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -161,8 +161,10 @@ create_calldata(Contract, Function, Argument) when is_map(Contract) -> get_arg_icode(Funs) -> - [Args] = [ Args || {[_, ?CALL_NAME], _, _, {funcall, _, Args}, _} <- Funs ], - Args. + case [ Args || {[_, ?CALL_NAME], _, _, {funcall, _, Args}, _} <- Funs ] of + [Args] -> Args; + [] -> error({missing_call_function, Funs}) + end. get_call_type([{contract, _, _, Defs}]) -> case [ {lists:last(QFunName), FunType} diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 1b255fb..8e90693 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -236,8 +236,10 @@ type({app_t, _, Type, Args}) -> beside(type(Type), tuple_type(Args)); type({tuple_t, _, Args}) -> tuple_type(Args); -type({named_arg_t, _, Name, Type, Default}) -> - follow(hsep(typed(name(Name), Type), text("=")), expr(Default)); +type({named_arg_t, _, Name, Type, _Default}) -> + %% Drop the default value + %% follow(hsep(typed(name(Name), Type), text("=")), expr(Default)); + typed(name(Name), Type); type(R = {record_t, _}) -> typedef(R); type(T = {id, _, _}) -> name(T); diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index eccb6a0..9f6f9d4 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -75,7 +75,8 @@ compilable_contracts() -> "builtin_bug", "builtin_map_get_bug", "nodeadcode", - "deadcode" + "deadcode", + "variant_types" ]. %% Contracts that should produce type errors @@ -181,4 +182,11 @@ failing_contracts() -> , {"bad_events2", [<<"The event constructor BadEvent1 (at line 9, column 7) has too many string values (max 1)">>, <<"The event constructor BadEvent2 (at line 10, column 7) has too many indexed values (max 3)">>]} + , {"type_clash", + [<<"Cannot unify int\n" + " and string\n" + "when checking the record projection at line 12, column 40\n" + " r.foo : (gas : int, value : int) => Remote.themap\n" + "against the expected type\n" + " (gas : int, value : int) => map(string, int)">>]} ]. diff --git a/test/contracts/type_clash.aes b/test/contracts/type_clash.aes new file mode 100644 index 0000000..5690a41 --- /dev/null +++ b/test/contracts/type_clash.aes @@ -0,0 +1,13 @@ + +contract Remote = + + type themap = map(int, string) + function foo : () => themap + +contract Main = + + type themap = map(string, int) + + // Should fail + function foo(r : Remote) : themap = r.foo() + From e6f01481bf8166826e3ec6a7ca7f137aedbf1ef2 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 4 Feb 2019 18:28:46 +0100 Subject: [PATCH 07/18] Bind state and event primitives only in contracts (and with the right types) --- src/aeso_ast_infer_types.erl | 40 ++++++++++++++++++++----------- test/aeso_compiler_tests.erl | 4 +++- test/contracts/state_handling.aes | 23 ++++++++++-------- 3 files changed, 42 insertions(+), 25 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index c1ee415..0470f07 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -150,17 +150,20 @@ check_tvar(#env{ typevars = TVars}, T = {tvar, _, X}) -> -spec bind_fun(name(), type() | typesig(), env()) -> env(). bind_fun(X, Type, Env) -> - Ann = aeso_syntax:get_ann(Type), case lookup_name(Env, [X]) of - false -> - on_current_scope(Env, fun(Scope = #scope{ funs = Funs }) -> - Scope#scope{ funs = [{X, {Ann, Type}} | Funs] } - end); + false -> force_bind_fun(X, Type, Env); {_QId, {Ann1, _}} -> - type_error({duplicate_definition, X, [Ann1, Ann]}), + type_error({duplicate_definition, X, [Ann1, aeso_syntax:get_ann(Type)]}), Env end. +-spec force_bind_fun(name(), type() | typesig(), env()) -> env(). +force_bind_fun(X, Type, Env) -> + Ann = aeso_syntax:get_ann(Type), + on_current_scope(Env, fun(Scope = #scope{ funs = Funs }) -> + Scope#scope{ funs = [{X, {Ann, Type}} | Funs] } + end). + -spec bind_funs([{name(), type() | typesig()}], env()) -> env(). bind_funs([], Env) -> Env; bind_funs([{Id, Type} | Rest], Env) -> @@ -182,8 +185,18 @@ bind_state(Env) -> {S, _} -> {qid, Ann, S}; false -> Unit end, - bind_funs([{"state", State}, - {"put", {fun_t, Ann, [], [State], Unit}}], Env). + Event = + case lookup_type(Env, {id, Ann, "event"}) of + {E, _} -> {qid, Ann, E}; + false -> {id, Ann, "event"} %% will cause type error if used(?) + end, + Env1 = bind_funs([{"state", State}, + {"put", {fun_t, Ann, [], [State], Unit}}], Env), + + %% A bit of a hack: we bind Chain.event with the local event type. + Env2 = force_bind_fun("event", {fun_t, Ann, [], [Event], Unit}, + Env1#env{ namespace = ["Chain"] }), + Env2#env{ namespace = Env1#env.namespace }. -spec bind_field(name(), field_info(), env()) -> env(). bind_field(X, Info, Env = #env{ fields = Fields }) -> @@ -325,7 +338,6 @@ global_env() -> Bool = {id, Ann, "bool"}, String = {id, Ann, "string"}, Address = {id, Ann, "address"}, - Event = {id, Ann, "event"}, Hash = {id, Ann, "hash"}, Bits = {id, Ann, "bits"}, Oracle = fun(Q, R) -> {app_t, Ann, {id, Ann, "oracle"}, [Q, R]} end, @@ -376,8 +388,7 @@ global_env() -> {"timestamp", Int}, {"block_height", Int}, {"difficulty", Int}, - {"gas_limit", Int}, - {"event", Fun1(Event, Unit)}]) + {"gas_limit", Int}]) , types = MkDefs([{"ttl", 0}]) }, ContractScope = #scope @@ -558,13 +569,13 @@ infer_contract(Env, What, Defs) -> end, Get = fun(K) -> [ Def || Def <- Defs, Kind(Def) == K ] end, {Env1, TypeDefs} = check_typedefs(Env, Get(type)), + create_type_errors(), Env2 = case What of namespace -> Env1; contract -> bind_state(Env1) %% bind state and put end, {ProtoSigs, Decls} = lists:unzip([ check_fundecl(Env1, Decl) || Decl <- Get(prototype) ]), - create_type_errors(), Env3 = bind_funs(ProtoSigs, Env2), Functions = Get(function), %% Check for duplicates in Functions (we turn it into a map below) @@ -780,8 +791,9 @@ check_reserved_entrypoints(Funs) -> 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, Named, Args, Ret}}, {fun_decl, Ann, Id, Type1}}; -check_fundecl(_, {fun_decl, _Attrib, {id, _, Name}, Type}) -> - error({fundecl_must_have_funtype, Name, Type}). +check_fundecl(Env, {fun_decl, Ann, Id = {id, _, Name}, Type}) -> + type_error({fundecl_must_have_funtype, Ann, Id, Type}), + {{Name, {type_sig, Ann, [], [], Type}}, check_type(Env, Type)}. infer_nonrec(Env, LetFun) -> create_constraints(), diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 9f6f9d4..d558b5d 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -76,7 +76,9 @@ compilable_contracts() -> "builtin_map_get_bug", "nodeadcode", "deadcode", - "variant_types" + "variant_types", + "state_handling", + "events" ]. %% Contracts that should produce type errors diff --git a/test/contracts/state_handling.aes b/test/contracts/state_handling.aes index 737e644..7fdd196 100644 --- a/test/contracts/state_handling.aes +++ b/test/contracts/state_handling.aes @@ -1,19 +1,22 @@ contract Remote = - function look_at : (state) => () + record rstate = { i : int, s : string, m : map(int, int) } + + function look_at : (rstate) => () function return_s : (bool) => string function return_m : (bool) => map(int, int) - function get : (state) => state - function get_i : (state) => int - function get_s : (state) => string - function get_m : (state) => map(int, int) + function get : (rstate) => rstate + function get_i : (rstate) => int + function get_s : (rstate) => string + function get_m : (rstate) => map(int, int) - function fun_update_i : (state, int) => state - function fun_update_s : (state, string) => state - function fun_update_m : (state, map(int, int)) => state - function fun_update_mk : (state, int, int) => state + function fun_update_i : (rstate, int) => rstate + function fun_update_s : (rstate, string) => rstate + function fun_update_m : (rstate, map(int, int)) => rstate + function fun_update_mk : (rstate, int, int) => rstate contract StateHandling = - record state = { i : int, s : string, m : map(int, int) } + + type state = Remote.rstate function init(r : Remote, i : int) = let state0 = { i = 0, s = "undefined", m = {} } From 8262d7780f06a9ec69fbb0b813b784661e8e9076 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 5 Feb 2019 08:58:27 +0100 Subject: [PATCH 08/18] Fix some issues pointed out by dialyzer --- src/aeso_ast_infer_types.erl | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 0470f07..58a4050 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -68,7 +68,7 @@ -type access() :: public | private | internal. --type typedef() :: {[aeso_syntax:tvar()], aeso_syntax:type_def() | {contract_t, [aeso_syntax:field_t()]}} +-type typedef() :: {[aeso_syntax:tvar()], aeso_syntax:typedef() | {contract_t, [aeso_syntax:field_t()]}} | {builtin, non_neg_integer()}. -type type() :: aeso_syntax:type(). @@ -227,10 +227,11 @@ bind_contract({contract, Ann, Id, Contents}, Env) -> || {fun_decl, AnnF, Entrypoint, Type} <- Contents ] ++ %% Predefined fields [ {field_t, Sys, {id, Sys, "address"}, {id, Sys, "address"}} ], - FieldInfo = [ {Entrypoint, #field_info{ kind = contract, + FieldInfo = [ {Entrypoint, #field_info{ ann = FieldAnn, + kind = contract, field_t = Type, record_t = Id }} - || {field_t, _, {id, _, Entrypoint}, Type} <- Fields ], + || {field_t, _, {id, FieldAnn, Entrypoint}, Type} <- Fields ], bind_type(Key, Ann, {[], {contract_t, Fields}}, bind_fields(FieldInfo, Env)). @@ -296,7 +297,7 @@ lookup_record_field(Env, FieldName) -> maps:get(FieldName, Env#env.fields, []). %% For 'create' or 'update' constraints we don't consider contract types. --spec lookup_record_field(env(), name(), contract | record) -> [field_info()]. +-spec lookup_record_field(env(), name(), create | project | update) -> [field_info()]. lookup_record_field(Env, FieldName, Kind) -> [ Fld || Fld = #field_info{ kind = K } <- lookup_record_field(Env, FieldName), Kind == project orelse K /= contract ]. @@ -1357,7 +1358,7 @@ solve_field_constraints(Env, Constraints) -> [] -> type_error({undefined_field, Field}), false; - [{FieldName, #field_info{field_t = FldType, record_t = RecType}}] -> + [#field_info{field_t = FldType, record_t = RecType}] -> create_freshen_tvars(), FreshFldType = freshen(FldType), FreshRecType = freshen(RecType), From 6cdba58e3529728f83c57368964562e7ee095e39 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 5 Feb 2019 09:04:08 +0100 Subject: [PATCH 09/18] Update error messages --- test/aeso_compiler_tests.erl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index d558b5d..0c92123 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -161,7 +161,8 @@ failing_contracts() -> <<"Repeated name x in pattern\n" " x :: x (at line 26, column 7)">>, <<"No record type with fields y, z (at line 14, column 22)">>, - <<"No record type with fields y, w (at line 15, column 22)">>]} + <<"The field z is missing when constructing an element of type r2 (at line 15, column 24)">>, + <<"Record type r2 does not have field y (at line 15, column 22)">>]} , {"init_type_error", [<<"Cannot unify string\n" " and map(int, int)\n" @@ -173,7 +174,7 @@ failing_contracts() -> , {"missing_fields_in_record_expression", [<<"The field x is missing when constructing an element of type r('a) (at line 7, column 40)">>, <<"The field y is missing when constructing an element of type r(int) (at line 8, column 40)">>, - <<"The fields y, z are missing when constructing an element of type r('a) (at line 6, column 40)">>]} + <<"The fields y, z are missing when constructing an element of type r('1) (at line 6, column 40)">>]} , {"namespace_clash", [<<"The contract Call (at line 4, column 10) has the same name as a namespace at (builtin location)">>]} , {"bad_events", From 0a5b80668f8b1018ca7260aff32a57c834add32b Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 09:14:39 +0100 Subject: [PATCH 10/18] Don't mess up on multiple namespaces in icode compiler --- src/aeso_ast_to_icode.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index ffcb48a..e9dd732 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -28,7 +28,8 @@ code([{contract, _Attribs, Con, Code}|Rest], Icode) -> NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Con, Icode)), code(Rest, NewIcode); code([{namespace, _Ann, Name, Code}|Rest], Icode) -> - NewIcode = contract_to_icode(Code, aeso_icode:enter_namespace(Name, Icode)), + %% TODO: nested namespaces + NewIcode = contract_to_icode(Code, aeso_icode:set_namespace(Name, Icode)), code(Rest, NewIcode); code([], Icode) -> add_default_init_function(add_builtins(Icode)). From 2b7490776eeb5e1deebbc3c2ac73afff9cc369dc Mon Sep 17 00:00:00 2001 From: Hans Svensson Date: Tue, 5 Feb 2019 08:52:40 +0100 Subject: [PATCH 11/18] Add include directive Add an include directive to include namespaces into a contract. Only allowed at the top level. To allow includes, either call through aeso_compiler:file or set the option `allow_include` (and add `include_path`(s)). --- .gitignore | 1 + src/aeso_compiler.erl | 43 ++++++++++++----- src/aeso_parse_lib.erl | 2 +- src/aeso_parser.erl | 93 ++++++++++++++++++++++++++++-------- src/aeso_scan.erl | 2 +- test/aeso_compiler_tests.erl | 21 ++++++-- test/contracts/include.aes | 10 ++++ test/contracts/included.aes | 2 + test/contracts/included2.aes | 5 ++ 9 files changed, 139 insertions(+), 40 deletions(-) create mode 100644 test/contracts/include.aes create mode 100644 test/contracts/included.aes create mode 100644 test/contracts/included2.aes diff --git a/.gitignore b/.gitignore index 695011d..3b6ef01 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,4 @@ _build rebar3.crashdump *.erl~ *.aes~ +aesophia diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index 47937ab..6967a88 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -21,8 +21,16 @@ -include("aeso_icode.hrl"). --type option() :: pp_sophia_code | pp_ast | pp_types | pp_typed_ast | - pp_icode| pp_assembler | pp_bytecode. +-type option() :: pp_sophia_code + | pp_ast + | pp_types + | pp_typed_ast + | pp_icode + | pp_assembler + | pp_bytecode + | {include_path, [string()]} + | {allow_include, boolean()} + | {src_file, string()}. -type options() :: [option()]. -export_type([ option/0 @@ -40,12 +48,13 @@ version() -> -spec file(string()) -> {ok, map()} | {error, binary()}. file(Filename) -> - file(Filename, []). + Dir = filename:dirname(Filename), + file(Filename, [{include_path, [Dir]}]). -spec file(string(), options()) -> {ok, map()} | {error, binary()}. file(File, Options) -> case read_contract(File) of - {ok, Bin} -> from_string(Bin, Options); + {ok, Bin} -> from_string(Bin, [{src_file, File}, {allow_include, true} | Options]); {error, Error} -> ErrorString = [File,": ",file:format_error(Error)], {error, join_errors("File errors", [ErrorString], fun(E) -> E end)} @@ -213,9 +222,6 @@ icode_to_term(T, V) -> icodes_to_terms(Ts, Vs) -> [ icode_to_term(T, V) || {T, V} <- lists:zip(Ts, Vs) ]. -parse(C,_Options) -> - parse_string(C). - to_icode(TypedAst, Options) -> aeso_ast_to_icode:convert_typed(TypedAst, Options). @@ -265,9 +271,9 @@ sophia_type_to_typerep(String) -> catch _:_ -> {error, bad_type} end. -parse_string(Text) -> +parse(Text, Options) -> %% Try and return something sensible here! - case aeso_parser:string(Text) of + case aeso_parser:string(Text, Options) of %% Yay, it worked! {ok, Contract} -> Contract; %% Scan errors. @@ -280,12 +286,25 @@ parse_string(Text) -> parse_error(Pos, Error); {error, {Pos, ambiguous_parse, As}} -> ErrorString = io_lib:format("Ambiguous ~p", [As]), - parse_error(Pos, ErrorString) + parse_error(Pos, ErrorString); + %% Include error + {error, {Pos, include_not_allowed}} -> + parse_error(Pos, "includes not allowed in this context"); + {error, {Pos, include_error}} -> + parse_error(Pos, "could not find include file") end. -parse_error({Line, Pos}, ErrorString) -> - Error = io_lib:format("line ~p, column ~p: ~s", [Line, Pos, ErrorString]), +parse_error(Pos, ErrorString) -> + Error = io_lib:format("~s: ~s", [pos_error(Pos), ErrorString]), error({parse_errors, [Error]}). read_contract(Name) -> file:read_file(Name). + +pos_error({Line, Pos}) -> + io_lib:format("line ~p, column ~p", [Line, Pos]); +pos_error({no_file, Line, Pos}) -> + pos_error({Line, Pos}); +pos_error({File, Line, Pos}) -> + io_lib:format("file ~s, line ~p, column ~p", [File, Line, Pos]). + diff --git a/src/aeso_parse_lib.erl b/src/aeso_parse_lib.erl index d1be781..21f3df5 100644 --- a/src/aeso_parse_lib.erl +++ b/src/aeso_parse_lib.erl @@ -19,7 +19,7 @@ -export_type([parser/1, parser_expr/1, pos/0, token/0, tokens/0]). --type pos() :: {integer(), integer()}. +-type pos() :: {string() | no_file, integer(), integer()} | {integer(), integer()}. -type token() :: {atom(), pos(), term()} | {atom(), pos()}. -type tokens() :: [token()]. -type error() :: {pos(), string() | no_error}. diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index 7b7e7bd..fc13e54 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -5,28 +5,37 @@ -module(aeso_parser). -export([string/1, + string/2, type/1]). -include("aeso_parse_lib.hrl"). --spec string(string()) -> - {ok, aeso_syntax:ast()} - | {error, {aeso_parse_lib:pos(), - atom(), - term()}} - | {error, {aeso_parse_lib:pos(), - atom()}}. +-type parse_result() :: {ok, aeso_syntax:ast()} + | {error, {aeso_parse_lib:pos(), atom(), term()}} + | {error, {aeso_parse_lib:pos(), atom()}}. + +-spec string(string()) -> parse_result(). string(String) -> - parse_and_scan(file(), String). + string(String, []). + +-spec string(string(), aeso_compiler:options()) -> parse_result(). +string(String, Opts) -> + case parse_and_scan(file(), String, Opts) of + {ok, AST} -> + expand_includes(AST, Opts); + Err = {error, _} -> + Err + end. type(String) -> - parse_and_scan(type(), String). + parse_and_scan(type(), String, []). -parse_and_scan(P, S) -> - case aeso_scan:scan(S) of - {ok, Tokens} -> aeso_parse_lib:parse(P, Tokens); - Error -> Error - end. +parse_and_scan(P, S, Opts) -> + set_current_file(proplists:get_value(src_file, Opts, no_file)), + case aeso_scan:scan(S) of + {ok, Tokens} -> aeso_parse_lib:parse(P, Tokens); + Error -> Error + end. %% -- Parsing rules ---------------------------------------------------------- @@ -38,6 +47,7 @@ decl() -> %% Contract declaration [ ?RULE(keyword(contract), con(), tok('='), maybe_block(decl()), {contract, _1, _2, _4}) , ?RULE(keyword(namespace), con(), tok('='), maybe_block(decl()), {namespace, _1, _2, _4}) + , ?RULE(keyword(include), str(), {include, _2}) %% Type declarations TODO: format annotation for "type bla" vs "type bla()" , ?RULE(keyword(type), id(), {type_decl, _1, _2, []}) @@ -302,6 +312,7 @@ binop(Ops) -> con() -> token(con). id() -> token(id). tvar() -> token(tvar). +str() -> token(string). token(Tag) -> ?RULE(tok(Tag), @@ -337,10 +348,17 @@ bracket_list(P) -> brackets(comma_sep(P)). -type ann_col() :: aeso_syntax:ann_col(). -spec pos_ann(ann_line(), ann_col()) -> ann(). -pos_ann(Line, Col) -> [{line, Line}, {col, Col}]. +pos_ann(Line, Col) -> [{file, current_file()}, {line, Line}, {col, Col}]. + +current_file() -> + get('$current_file'). + +set_current_file(File) -> + put('$current_file', File). ann_pos(Ann) -> - {proplists:get_value(line, Ann), + {proplists:get_value(file, Ann), + proplists:get_value(line, Ann), proplists:get_value(col, Ann)}. get_ann(Ann) when is_list(Ann) -> Ann; @@ -358,10 +376,10 @@ set_ann(Key, Val, Node) -> setelement(2, Node, lists:keystore(Key, 1, Ann, {Key, Val})). get_pos(Node) -> - {get_ann(line, Node), get_ann(col, Node)}. + {current_file(), get_ann(line, Node), get_ann(col, Node)}. -set_pos({L, C}, Node) -> - set_ann(line, L, set_ann(col, C, Node)). +set_pos({F, L, C}, Node) -> + set_ann(file, F, set_ann(line, L, set_ann(col, C, Node))). infix(L, Op, R) -> set_ann(format, infix, {app, get_ann(L), Op, [L, R]}). @@ -443,8 +461,10 @@ parse_pattern(E) -> bad_expr_err("Not a valid pattern", E). parse_field_pattern({field, Ann, F, E}) -> {field, Ann, F, parse_pattern(E)}. -return_error({L, C}, Err) -> - fail(io_lib:format("~p:~p:\n~s", [L, C, Err])). +return_error({no_file, L, C}, Err) -> + fail(io_lib:format("~p:~p:\n~s", [L, C, Err])); +return_error({F, L, C}, Err) -> + fail(io_lib:format("In ~s at ~p:~p:\n~s", [F, L, C, Err])). -spec ret_doc_err(ann(), prettypr:document()) -> no_return(). ret_doc_err(Ann, Doc) -> @@ -456,3 +476,34 @@ bad_expr_err(Reason, E) -> prettypr:sep([prettypr:text(Reason ++ ":"), prettypr:nest(2, aeso_pretty:expr(E))])). +%% -- Helper functions ------------------------------------------------------- +expand_includes(AST, Opts) -> + expand_includes(AST, [], Opts). + +expand_includes([], Acc, _Opts) -> + {ok, lists:reverse(Acc)}; +expand_includes([{include, S = {string, _, File}} | AST], Acc, Opts) -> + AllowInc = proplists:get_value(allow_include, Opts, false), + case read_file(File, Opts) of + {ok, Bin} when AllowInc -> + Opts1 = lists:keystore(src_file, 1, Opts, {src_file, File}), + case string(binary_to_list(Bin), Opts1) of + {ok, AST1} -> + expand_includes(AST1 ++ AST, Acc, Opts); + Err = {error, _} -> + Err + end; + {ok, _} -> + {error, {get_pos(S), include_not_allowed}}; + {error, _} -> + {error, {get_pos(S), include_error}} + end; +expand_includes([E | AST], Acc, Opts) -> + expand_includes(AST, [E | Acc], Opts). + +read_file(File, Opts) -> + CandidateNames = [File] ++ [ filename:join(Dir, File) + || Dir <- proplists:get_value(include_path, Opts, []) ], + lists:foldr(fun(F, {error, _}) -> file:read_file(F); + (_F, OK) -> OK end, {error, not_found}, CandidateNames). + diff --git a/src/aeso_scan.erl b/src/aeso_scan.erl index 617285d..17b26bc 100644 --- a/src/aeso_scan.erl +++ b/src/aeso_scan.erl @@ -36,7 +36,7 @@ lexer() -> , {"\\*/", pop(skip())} , {"[^/*]+|[/*]", skip()} ], - Keywords = ["contract", "import", "let", "rec", "switch", "type", "record", "datatype", "if", "elif", "else", "function", + Keywords = ["contract", "include", "let", "rec", "switch", "type", "record", "datatype", "if", "elif", "else", "function", "stateful", "true", "false", "and", "mod", "public", "private", "indexed", "internal", "namespace"], KW = string:join(Keywords, "|"), diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 0c92123..1343c73 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -23,8 +23,12 @@ simple_compile_test_() -> end} || ContractName <- compilable_contracts() ] ++ [ {"Testing error messages of " ++ ContractName, fun() -> - <<"Type errors\n",ErrorString/binary>> = compile(ContractName), - check_errors(lists:sort(ExpectedErrors), ErrorString) + case compile(ContractName, false) of + <<"Type errors\n", ErrorString/binary>> -> + check_errors(lists:sort(ExpectedErrors), ErrorString); + <<"Parse errors\n", ErrorString/binary>> -> + check_errors(lists:sort(ExpectedErrors), ErrorString) + end end} || {ContractName, ExpectedErrors} <- failing_contracts() ] ++ [ {"Testing deadcode elimination", @@ -46,9 +50,13 @@ check_errors(Expect, ErrorString) -> {Missing, Extra} -> ?assertEqual(Missing, Extra) end. -compile(Name) -> +compile(Name) -> compile(Name, true). + +compile(Name, AllowInc) -> String = aeso_test_utils:read_contract(Name), - case aeso_compiler:from_string(String, []) of + case aeso_compiler:from_string(String, [{include_path, [aeso_test_utils:contract_path()]}, + {allow_include, AllowInc}, + {src_file, Name}]) of {ok,Map} -> Map; {error,ErrorString} -> ErrorString end. @@ -78,7 +86,8 @@ compilable_contracts() -> "deadcode", "variant_types", "state_handling", - "events" + "events", + "include" ]. %% Contracts that should produce type errors @@ -192,4 +201,6 @@ failing_contracts() -> " r.foo : (gas : int, value : int) => Remote.themap\n" "against the expected type\n" " (gas : int, value : int) => map(string, int)">>]} + , {"include", + [<<"file include, line 1, column 9: includes not allowed in this context\n">>]} ]. diff --git a/test/contracts/include.aes b/test/contracts/include.aes new file mode 100644 index 0000000..2431aa5 --- /dev/null +++ b/test/contracts/include.aes @@ -0,0 +1,10 @@ +include "included.aes" +include "../contracts/included2.aes" + +contract Include = + // include "maps.aes" + function foo() = + Included.foo() < Included2a.bar() + + function bar() = + Included2b.foo() > Included.foo() diff --git a/test/contracts/included.aes b/test/contracts/included.aes new file mode 100644 index 0000000..5e229b2 --- /dev/null +++ b/test/contracts/included.aes @@ -0,0 +1,2 @@ +namespace Included = + function foo() = 42 diff --git a/test/contracts/included2.aes b/test/contracts/included2.aes new file mode 100644 index 0000000..85d9b07 --- /dev/null +++ b/test/contracts/included2.aes @@ -0,0 +1,5 @@ +namespace Included2a = + function bar() = 43 + +namespace Included2b = + function foo() = 44 From 421bc01012850659d6070a33018e073901f47737 Mon Sep 17 00:00:00 2001 From: Hans Svensson Date: Fri, 8 Feb 2019 11:51:50 +0100 Subject: [PATCH 12/18] Add error messages for bad include and nested namespace --- src/aeso_ast_infer_types.erl | 13 ++++++++++++- test/aeso_compiler_tests.erl | 3 +++ test/contracts/bad_include_and_ns.aes | 6 ++++++ test/contracts/include.aes | 1 - 4 files changed, 21 insertions(+), 2 deletions(-) create mode 100644 test/contracts/bad_include_and_ns.aes diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 58a4050..c15f8ba 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -566,11 +566,13 @@ infer_constant({letval, Attrs,_Pattern, Type, E}) -> infer_contract(Env, What, Defs) -> Kind = fun({type_def, _, _, _, _}) -> type; ({letfun, _, _, _, _, _}) -> function; - ({fun_decl, _, _, _}) -> prototype + ({fun_decl, _, _, _}) -> prototype; + (_) -> unexpected end, Get = fun(K) -> [ Def || Def <- Defs, Kind(Def) == K ] end, {Env1, TypeDefs} = check_typedefs(Env, Get(type)), create_type_errors(), + check_unexpected(Get(unexpected)), Env2 = case What of namespace -> Env1; @@ -646,6 +648,9 @@ check_typedef(Env, {variant_t, Cons}) -> {variant_t, [ {constr_t, Ann, Con, [ check_type(Env, Arg) || Arg <- Args ]} || {constr_t, Ann, Con, Args} <- Cons ]}. +check_unexpected(Xs) -> + [ type_error(X) || X <- Xs ]. + -spec check_type(env(), aeso_syntax:type()) -> aeso_syntax:type(). check_type(Env, T) -> check_type(Env, T, 0). @@ -1869,6 +1874,12 @@ pp_error({duplicate_definition, Name, Locs}) -> pp_error({duplicate_scope, Kind, Name, OtherKind, L}) -> io_lib:format("The ~p ~s (at ~s) has the same name as a ~p at ~s\n", [Kind, pp(Name), pp_loc(Name), OtherKind, pp_loc(L)]); +pp_error({include, {string, Pos, Name}}) -> + io_lib:format("Include of '~s' at ~s\nnot allowed, include only allowed at top level.\n", + [binary_to_list(Name), pp_loc(Pos)]); +pp_error({namespace, _Pos, {con, Pos, Name}, _Def}) -> + io_lib:format("Nested namespace not allowed\nNamespace '~s' at ~s not defined at top level.\n", + [Name, pp_loc(Pos)]); pp_error(Err) -> io_lib:format("Unknown error: ~p\n", [Err]). diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 1343c73..23a760c 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -203,4 +203,7 @@ failing_contracts() -> " (gas : int, value : int) => map(string, int)">>]} , {"include", [<<"file include, line 1, column 9: includes not allowed in this context\n">>]} + , {"bad_include_and_ns", + [<<"Include of 'included.aes' at line 2, column 11\nnot allowed, include only allowed at top level.">>, + <<"Nested namespace not allowed\nNamespace 'Foo' at line 3, column 13 not defined at top level.">>]} ]. diff --git a/test/contracts/bad_include_and_ns.aes b/test/contracts/bad_include_and_ns.aes new file mode 100644 index 0000000..6644d2c --- /dev/null +++ b/test/contracts/bad_include_and_ns.aes @@ -0,0 +1,6 @@ +contract Bad = + include "included.aes" + namespace Foo = + function foo() = 42 + + function foo() = 43 diff --git a/test/contracts/include.aes b/test/contracts/include.aes index 2431aa5..b7afd65 100644 --- a/test/contracts/include.aes +++ b/test/contracts/include.aes @@ -2,7 +2,6 @@ include "included.aes" include "../contracts/included2.aes" contract Include = - // include "maps.aes" function foo() = Included.foo() < Included2a.bar() From 2ac47059c1479b42a876c7d6d2b971a63e9fa3c1 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 10:39:48 +0100 Subject: [PATCH 13/18] Refactor used_ids and used_types into a generic fold --- src/aeso_syntax.erl | 2 +- src/aeso_syntax_utils.erl | 185 +++++++++++++++++++++----------------- 2 files changed, 106 insertions(+), 81 deletions(-) diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index d5e5af0..3e610bc 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -15,7 +15,7 @@ -export_type([bin_op/0, un_op/0]). -export_type([decl/0, letbind/0, typedef/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, pat/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]). -type ast() :: [decl()]. diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index e94db73..94e89aa 100644 --- a/src/aeso_syntax_utils.erl +++ b/src/aeso_syntax_utils.erl @@ -6,89 +6,114 @@ %%%------------------------------------------------------------------- -module(aeso_syntax_utils). --export([used_ids/1, used_types/1]). +-export([used_ids/1, used_types/1, fold/4]). + +-record(alg, {zero, plus, minus}). %% minus for variable binding + +-type alg(A) :: #alg{ zero :: A + , plus :: fun((A, A) -> A) + , minus :: fun((A, A) -> A) }. + +-type kind() :: decl | type | expr | pat. + +-spec fold(alg(A), fun((kind(), _) -> A), kind(), E | [E]) -> A + when E :: aeso_syntax:decl() + | aeso_syntax:typedef() + | aeso_syntax:field_t() + | aeso_syntax:constructor_t() + | aeso_syntax:type() + | aeso_syntax:expr() + | aeso_syntax:pat() + | aeso_syntax:arg() + | aeso_syntax:alt() + | aeso_syntax:elim() + | aeso_syntax:arg_expr() + | aeso_syntax:field(aeso_syntax:expr()) + | aeso_syntax:stmt(). +fold(Alg, Fun, K, Xs) when is_list(Xs) -> + lists:foldl(fun(X, A) -> (Alg#alg.plus)(A, fold(Alg, Fun, K, X)) end, + Alg#alg.zero, Xs); +fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) -> + Sum = fun(Xs) -> lists:foldl(Plus, Zero, Xs) end, + Decl = fun(D) -> fold(Alg, Fun, decl, D) end, + Type = fun(T) -> fold(Alg, Fun, type, T) end, + Expr = fun(E) -> fold(Alg, Fun, expr, E) end, + Pat = fun(P) -> fold(Alg, Fun, pat, P) end, + Top = Fun(K, X), + LetBound = fun LB ({letval, _, Y, _, _}) -> Expr(Y); + LB ({letfun, _, F, _, _, _}) -> Expr(F); + LB ({letrec, _, Ds}) -> Sum(lists:map(LB, Ds)); + LB (_) -> Zero + end, + Rec = case X of + %% decl() + {contract, _, _, Ds} -> Decl(Ds); + {namespace, _, _, Ds} -> Decl(Ds); + {type_decl, _, _, _} -> Zero; + {type_def, _, _, _, D} -> Decl(D); + {fun_decl, _, _, T} -> Type(T); + {letval, _, _, T, E} -> Plus(Type(T), Expr(E)); + {letfun, _, _, Xs, T, E} -> Plus(Type(T), Minus(Expr(E), Expr(Xs))); + {letrec, _, Ds} -> Decl(Ds); + %% typedef() + {alias_t, T} -> Type(T); + {record_t, Fs} -> Type(Fs); + {variant_t, Cs} -> Type(Cs); + %% field_t() and constructor_t() + {field_t, _, _, T} -> Type(T); + {constr_t, _, _, Ts} -> Type(Ts); + %% type() + {fun_t, _, Named, Args, Ret} -> Type([Named, Args, Ret]); + {app_t, _, T, Ts} -> Type([T | Ts]); + {tuple_t, _, Ts} -> Type(Ts); + %% named_arg_t() + {named_arg_t, _, _, T, E} -> Plus(Type(T), Expr(E)); + %% expr() + {lam, _, Args, E} -> Minus(Expr(E), Expr(Args)); + {'if', _, A, B, C} -> Expr([A, B, C]); + {switch, _, E, Alts} -> Expr([E, Alts]); + {app, _, A, As} -> Expr([A | As]); + {proj, _, E, _} -> Expr(E); + {tuple, _, As} -> Expr(As); + {list, _, As} -> Expr(As); + {typed, _, E, T} -> Plus(Expr(E), Type(T)); + {record, _, Fs} -> Expr(Fs); + {record, _, E, Fs} -> Expr([E | Fs]); + {map, _, E, Fs} -> Expr([E | Fs]); + {map, _, KVs} -> Sum([Expr([Key, Val]) || {Key, Val} <- KVs]); + {map_get, _, A, B} -> Expr([A, B]); + {map_get, _, A, B, C} -> Expr([A, B, C]); + {block, Ann, [S | Ss]} -> Plus(Expr(S), Minus(Expr({block, Ann, Ss}), LetBound(S))); + {block, _, []} -> Zero; + %% field() + {field, _, LV, E} -> Expr([LV, E]); + {field, _, LV, _, E} -> Expr([LV, E]); + %% arg() + {arg, _, X, T} -> Plus(Expr(X), Type(T)); + %% alt() + {'case', _, P, E} -> Minus(Expr(E), Pat(P)); + %% elim() + {proj, _, _} -> Zero; + {map_get, _, E} -> Expr(E); + %% arg_expr() + {named_arg, _, _, E} -> Expr(E); + _ -> Alg#alg.zero + end, + (Alg#alg.plus)(Top, Rec). %% Var set combinators -none() -> []. -one(X) -> [X]. -union_map(F, Xs) -> lists:umerge(lists:map(F, Xs)). -minus(Xs, Ys) -> Xs -- Ys. -%% Compute names used by a definition or expression. -used_ids(Es) when is_list(Es) -> - union_map(fun used_ids/1, Es); -used_ids({bind, A, B}) -> - minus(used_ids(B), used_ids(A)); -%% Declarations -used_ids({contract, _, _, Decls}) -> used_ids(Decls); -used_ids({type_decl, _, _, _}) -> none(); -used_ids({type_def, _, _, _, _}) -> none(); -used_ids({fun_decl, _, _, _}) -> none(); -used_ids({letval, _, _, _, E}) -> used_ids(E); -used_ids({letfun, _, _, Args, _, E}) -> used_ids({bind, Args, E}); -used_ids({letrec, _, Decls}) -> used_ids(Decls); -%% Args -used_ids({arg, _, X, _}) -> used_ids(X); -used_ids({named_arg, _, _, E}) -> used_ids(E); -%% Constants -used_ids({int, _, _}) -> none(); -used_ids({bool, _, _}) -> none(); -used_ids({hash, _, _}) -> none(); -used_ids({unit, _}) -> none(); -used_ids({string, _, _}) -> none(); -used_ids({char, _, _}) -> none(); -%% Expressions -used_ids({lam, _, Args, E}) -> used_ids({bind, Args, E}); -used_ids({'if', _, A, B, C}) -> used_ids([A, B, C]); -used_ids({switch, _, E, Bs}) -> used_ids([E, Bs]); -used_ids({app, _, E, Es}) -> used_ids([E | Es]); -used_ids({proj, _, E, _}) -> used_ids(E); -used_ids({tuple, _, Es}) -> used_ids(Es); -used_ids({list, _, Es}) -> used_ids(Es); -used_ids({typed, _, E, _}) -> used_ids(E); -used_ids({record, _, Fs}) -> used_ids(Fs); -used_ids({record, _, E, Fs}) -> used_ids([E, Fs]); -used_ids({map, _, E, Fs}) -> used_ids([E, Fs]); -used_ids({map, _, KVs}) -> used_ids([ [K, V] || {K, V} <- KVs ]); -used_ids({map_get, _, M, K}) -> used_ids([M, K]); -used_ids({map_get, _, M, K, V}) -> used_ids([M, K, V]); -used_ids({block, _, Ss}) -> used_ids_s(Ss); -used_ids({Op, _}) when is_atom(Op) -> none(); -used_ids({id, _, X}) -> [X]; -used_ids({qid, _, _}) -> none(); -used_ids({con, _, _}) -> none(); -used_ids({qcon, _, _}) -> none(); -%% Switch branches -used_ids({'case', _, P, E}) -> used_ids({bind, P, E}); -%% Fields -used_ids({field, _, LV, E}) -> used_ids([LV, E]); -used_ids({field, _, LV, X, E}) -> used_ids([LV, {bind, X, E}]); -used_ids({proj, _, _}) -> none(); -used_ids({map_get, _, E}) -> used_ids(E). +-spec ulist_alg() -> alg([any()]). +ulist_alg() -> #alg{ zero = [], plus = fun lists:umerge/2, minus = fun erlang:'--'/2 }. -%% Statements -used_ids_s([]) -> none(); -used_ids_s([S | Ss]) -> - used_ids([S, {bind, bound_ids(S), {block, [], Ss}}]). +used_ids(E) -> + fold(ulist_alg(), + fun(expr, {id, _, X}) -> [X]; + (pat, {id, _, X}) -> [X]; + (_, _) -> [] end, decl, E). -bound_ids({letval, _, X, _, _}) -> one(X); -bound_ids({letfun, _, X, _, _, _}) -> one(X); -bound_ids({letrec, _, Decls}) -> union_map(fun bound_ids/1, Decls); -bound_ids(_) -> none(). +used_types(T) -> + fold(ulist_alg(), + fun(type, {id, _, X}) -> [X]; + (_, _) -> [] end, decl, T). -used_types(Ts) when is_list(Ts) -> union_map(fun used_types/1, Ts); -used_types({type_def, _, _, _, T}) -> used_types(T); -used_types({alias_t, T}) -> used_types(T); -used_types({record_t, Fs}) -> used_types(Fs); -used_types({variant_t, Cs}) -> used_types(Cs); -used_types({field_t, _, _, T}) -> used_types(T); -used_types({constr_t, _, _, Ts}) -> used_types(Ts); -used_types({fun_t, _, Named, Args, T}) -> used_types([T | Named ++ Args]); -used_types({named_arg_t, _, _, T, _}) -> used_types(T); -used_types({app_t, _, T, Ts}) -> used_types([T | Ts]); -used_types({tuple_t, _, Ts}) -> used_types(Ts); -used_types({id, _, X}) -> one(X); -used_types({qid, _, _}) -> none(); -used_types({con, _, _}) -> none(); -used_types({qcon, _, _}) -> none(); -used_types({tvar, _, _}) -> none(). From 27cbedc7abc1ae29bebc886beaf000dbc8765d4b Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 11:47:54 +0100 Subject: [PATCH 14/18] Further generalise used names computation --- src/aeso_syntax_utils.erl | 104 ++++++++++++++++++++++++-------------- 1 file changed, 66 insertions(+), 38 deletions(-) diff --git a/src/aeso_syntax_utils.erl b/src/aeso_syntax_utils.erl index 94e89aa..a8aceea 100644 --- a/src/aeso_syntax_utils.erl +++ b/src/aeso_syntax_utils.erl @@ -6,15 +6,15 @@ %%%------------------------------------------------------------------- -module(aeso_syntax_utils). --export([used_ids/1, used_types/1, fold/4]). +-export([used_ids/1, used_types/1, used/1]). --record(alg, {zero, plus, minus}). %% minus for variable binding +-record(alg, {zero, plus, scoped}). --type alg(A) :: #alg{ zero :: A - , plus :: fun((A, A) -> A) - , minus :: fun((A, A) -> A) }. +-type alg(A) :: #alg{ zero :: A + , plus :: fun((A, A) -> A) + , scoped :: fun((A, A) -> A) }. --type kind() :: decl | type | expr | pat. +-type kind() :: decl | type | bind_type | expr | bind_expr. -spec fold(alg(A), fun((kind(), _) -> A), kind(), E | [E]) -> A when E :: aeso_syntax:decl() @@ -30,31 +30,32 @@ | aeso_syntax:arg_expr() | aeso_syntax:field(aeso_syntax:expr()) | aeso_syntax:stmt(). -fold(Alg, Fun, K, Xs) when is_list(Xs) -> - lists:foldl(fun(X, A) -> (Alg#alg.plus)(A, fold(Alg, Fun, K, X)) end, - Alg#alg.zero, Xs); -fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) -> +fold(Alg = #alg{zero = Zero, plus = Plus, scoped = Scoped}, Fun, K, X) -> Sum = fun(Xs) -> lists:foldl(Plus, Zero, Xs) end, + Same = fun(A) -> fold(Alg, Fun, K, A) end, Decl = fun(D) -> fold(Alg, Fun, decl, D) end, Type = fun(T) -> fold(Alg, Fun, type, T) end, Expr = fun(E) -> fold(Alg, Fun, expr, E) end, - Pat = fun(P) -> fold(Alg, Fun, pat, P) end, + BindExpr = fun(P) -> fold(Alg, Fun, bind_expr, P) end, + BindType = fun(T) -> fold(Alg, Fun, bind_type, T) end, Top = Fun(K, X), - LetBound = fun LB ({letval, _, Y, _, _}) -> Expr(Y); - LB ({letfun, _, F, _, _, _}) -> Expr(F); - LB ({letrec, _, Ds}) -> Sum(lists:map(LB, Ds)); - LB (_) -> Zero - end, + Bound = fun LB ({letval, _, Y, _, _}) -> BindExpr(Y); + LB ({letfun, _, F, _, _, _}) -> BindExpr(F); + LB ({letrec, _, Ds}) -> Sum(lists:map(LB, Ds)); + LB (_) -> Zero + end, Rec = case X of + %% lists (bound things in head scope over tail) + [A | As] -> Scoped(Same(A), Same(As)); %% decl() {contract, _, _, Ds} -> Decl(Ds); {namespace, _, _, Ds} -> Decl(Ds); - {type_decl, _, _, _} -> Zero; - {type_def, _, _, _, D} -> Decl(D); + {type_decl, _, I, _} -> BindType(I); + {type_def, _, I, _, D} -> Plus(BindType(I), Decl(D)); {fun_decl, _, _, T} -> Type(T); - {letval, _, _, T, E} -> Plus(Type(T), Expr(E)); - {letfun, _, _, Xs, T, E} -> Plus(Type(T), Minus(Expr(E), Expr(Xs))); - {letrec, _, Ds} -> Decl(Ds); + {letval, _, F, T, E} -> Sum([BindExpr(F), Type(T), Expr(E)]); + {letfun, _, F, Xs, T, E} -> Sum([BindExpr(F), Type(T), Scoped(BindExpr(Xs), Expr(E))]); + {letrec, _, Ds} -> Plus(Bound(Ds), Decl(Ds)); %% typedef() {alias_t, T} -> Type(T); {record_t, Fs} -> Type(Fs); @@ -64,12 +65,12 @@ fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) -> {constr_t, _, _, Ts} -> Type(Ts); %% type() {fun_t, _, Named, Args, Ret} -> Type([Named, Args, Ret]); - {app_t, _, T, Ts} -> Type([T | Ts]); - {tuple_t, _, Ts} -> Type(Ts); + {app_t, _, T, Ts} -> Type([T | Ts]); + {tuple_t, _, Ts} -> Type(Ts); %% named_arg_t() {named_arg_t, _, _, T, E} -> Plus(Type(T), Expr(E)); %% expr() - {lam, _, Args, E} -> Minus(Expr(E), Expr(Args)); + {lam, _, Args, E} -> Scoped(BindExpr(Args), Expr(E)); {'if', _, A, B, C} -> Expr([A, B, C]); {switch, _, E, Alts} -> Expr([E, Alts]); {app, _, A, As} -> Expr([A | As]); @@ -83,15 +84,14 @@ fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) -> {map, _, KVs} -> Sum([Expr([Key, Val]) || {Key, Val} <- KVs]); {map_get, _, A, B} -> Expr([A, B]); {map_get, _, A, B, C} -> Expr([A, B, C]); - {block, Ann, [S | Ss]} -> Plus(Expr(S), Minus(Expr({block, Ann, Ss}), LetBound(S))); - {block, _, []} -> Zero; + {block, _, Ss} -> Expr(Ss); %% field() {field, _, LV, E} -> Expr([LV, E]); {field, _, LV, _, E} -> Expr([LV, E]); %% arg() {arg, _, X, T} -> Plus(Expr(X), Type(T)); %% alt() - {'case', _, P, E} -> Minus(Expr(E), Pat(P)); + {'case', _, P, E} -> Scoped(BindExpr(P), Expr(E)); %% elim() {proj, _, _} -> Zero; {map_get, _, E} -> Expr(E); @@ -101,19 +101,47 @@ fold(Alg = #alg{zero = Zero, plus = Plus, minus = Minus}, Fun, K, X) -> end, (Alg#alg.plus)(Top, Rec). -%% Var set combinators - --spec ulist_alg() -> alg([any()]). -ulist_alg() -> #alg{ zero = [], plus = fun lists:umerge/2, minus = fun erlang:'--'/2 }. +%% Name dependencies used_ids(E) -> - fold(ulist_alg(), - fun(expr, {id, _, X}) -> [X]; - (pat, {id, _, X}) -> [X]; - (_, _) -> [] end, decl, E). + [ X || {term, [X]} <- used(E) ]. used_types(T) -> - fold(ulist_alg(), - fun(type, {id, _, X}) -> [X]; - (_, _) -> [] end, decl, T). + [ X || {type, [X]} <- used(T) ]. + +-type entity() :: {term, [string()]} + | {type, [string()]} + | {namespace, [string()]}. + +-spec entity_alg() -> alg([entity()]). +entity_alg() -> + IsBound = fun({K, _}) -> lists:member(K, [bound_term, bound_type]) end, + Unbind = fun(bound_term) -> term; (bound_type) -> type end, + Scoped = fun(Xs, Ys) -> + {Bound, Others} = lists:partition(IsBound, Ys), + Bound1 = [ {Unbind(Tag), X} || {Tag, X} <- Bound ], + lists:umerge(Xs -- Bound1, Others) + end, + #alg{ zero = [] + , plus = fun lists:umerge/2 + , scoped = Scoped }. + +-spec used(_) -> [entity()]. +used(D) -> + Kind = fun(expr) -> term; + (bind_expr) -> bound_term; + (type) -> type; + (bind_type) -> bound_type + end, + NS = fun(Xs) -> {namespace, lists:droplast(Xs)} end, + NotBound = fun({Tag, _}) -> not lists:member(Tag, [bound_term, bound_type]) end, + Xs = + fold(entity_alg(), + fun(K, {id, _, X}) -> [{Kind(K), [X]}]; + (K, {qid, _, Xs}) -> [{Kind(K), Xs}, NS(Xs)]; + (K, {con, _, X}) -> [{Kind(K), [X]}]; + (K, {qcon, _, Xs}) -> [{Kind(K), Xs}, NS(Xs)]; + (_, _) -> [] + end, decl, D), + lists:filter(NotBound, Xs). From 0b86cdc3182752ff355f1bcd263bd7977eb3a1b0 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 12:12:02 +0100 Subject: [PATCH 15/18] Clean up test case --- test/contracts/namespaces.aes | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/test/contracts/namespaces.aes b/test/contracts/namespaces.aes index 09d0a2e..d67f990 100644 --- a/test/contracts/namespaces.aes +++ b/test/contracts/namespaces.aes @@ -1,16 +1,10 @@ namespace Lib = - // namespace Internal = - // function rev(xs, ys) = - // switch(xs) - // [] => ys - // x :: xs => rev(xs, x :: ys) - private - function rev(xs, ys) = - switch(xs) - [] => ys - x :: xs => rev(xs, x :: ys) + private function rev(xs, ys) = + switch(xs) + [] => ys + x :: xs => rev(xs, x :: ys) function reverse(xs : list('a)) : list('a) = rev(xs, []) From aa6d56ce9b72bace2d96810bc84e4681d9ea09f6 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 14:05:29 +0100 Subject: [PATCH 16/18] Allow passing an explicit "file system" for included files to the compiler --- src/aeso_compiler.erl | 15 +++++++-------- src/aeso_parser.erl | 22 +++++++++++++--------- test/aeso_compiler_tests.erl | 28 ++++++++++++++++++---------- 3 files changed, 38 insertions(+), 27 deletions(-) diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index 6967a88..7fe0a6b 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -28,8 +28,8 @@ | pp_icode | pp_assembler | pp_bytecode - | {include_path, [string()]} - | {allow_include, boolean()} + | {include, {file_system, [string()]} | + {explicit_files, #{string() => binary()}}} | {src_file, string()}. -type options() :: [option()]. @@ -49,12 +49,13 @@ version() -> -spec file(string()) -> {ok, map()} | {error, binary()}. file(Filename) -> Dir = filename:dirname(Filename), - file(Filename, [{include_path, [Dir]}]). + {ok, Cwd} = file:get_cwd(), + file(Filename, [{include, {file_system, [Cwd, Dir]}}]). -spec file(string(), options()) -> {ok, map()} | {error, binary()}. file(File, Options) -> case read_contract(File) of - {ok, Bin} -> from_string(Bin, [{src_file, File}, {allow_include, true} | Options]); + {ok, Bin} -> from_string(Bin, [{src_file, File} | Options]); {error, Error} -> ErrorString = [File,": ",file:format_error(Error)], {error, join_errors("File errors", [ErrorString], fun(E) -> E end)} @@ -288,10 +289,8 @@ parse(Text, Options) -> ErrorString = io_lib:format("Ambiguous ~p", [As]), parse_error(Pos, ErrorString); %% Include error - {error, {Pos, include_not_allowed}} -> - parse_error(Pos, "includes not allowed in this context"); - {error, {Pos, include_error}} -> - parse_error(Pos, "could not find include file") + {error, {Pos, {include_error, File}}} -> + parse_error(Pos, io_lib:format("could not find include file '~s'", [File])) end. parse_error(Pos, ErrorString) -> diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index fc13e54..8b0a247 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -483,9 +483,8 @@ expand_includes(AST, Opts) -> expand_includes([], Acc, _Opts) -> {ok, lists:reverse(Acc)}; expand_includes([{include, S = {string, _, File}} | AST], Acc, Opts) -> - AllowInc = proplists:get_value(allow_include, Opts, false), case read_file(File, Opts) of - {ok, Bin} when AllowInc -> + {ok, Bin} -> Opts1 = lists:keystore(src_file, 1, Opts, {src_file, File}), case string(binary_to_list(Bin), Opts1) of {ok, AST1} -> @@ -493,17 +492,22 @@ expand_includes([{include, S = {string, _, File}} | AST], Acc, Opts) -> Err = {error, _} -> Err end; - {ok, _} -> - {error, {get_pos(S), include_not_allowed}}; {error, _} -> - {error, {get_pos(S), include_error}} + {error, {get_pos(S), {include_error, File}}} end; expand_includes([E | AST], Acc, Opts) -> expand_includes(AST, [E | Acc], Opts). read_file(File, Opts) -> - CandidateNames = [File] ++ [ filename:join(Dir, File) - || Dir <- proplists:get_value(include_path, Opts, []) ], - lists:foldr(fun(F, {error, _}) -> file:read_file(F); - (_F, OK) -> OK end, {error, not_found}, CandidateNames). + case proplists:get_value(include, Opts, {explicit_files, #{}}) of + {file_system, Paths} -> + CandidateNames = [ filename:join(Dir, File) || Dir <- Paths ], + lists:foldr(fun(F, {error, _}) -> file:read_file(F); + (_F, OK) -> OK end, {error, not_found}, CandidateNames); + {explicit_files, Files} -> + case maps:get(binary_to_list(File), Files, not_found) of + not_found -> {error, not_found}; + Src -> {ok, Src} + end + end. diff --git a/test/aeso_compiler_tests.erl b/test/aeso_compiler_tests.erl index 23a760c..04fa19f 100644 --- a/test/aeso_compiler_tests.erl +++ b/test/aeso_compiler_tests.erl @@ -23,7 +23,7 @@ simple_compile_test_() -> end} || ContractName <- compilable_contracts() ] ++ [ {"Testing error messages of " ++ ContractName, fun() -> - case compile(ContractName, false) of + case compile(ContractName) of <<"Type errors\n", ErrorString/binary>> -> check_errors(lists:sort(ExpectedErrors), ErrorString); <<"Parse errors\n", ErrorString/binary>> -> @@ -31,6 +31,17 @@ simple_compile_test_() -> end end} || {ContractName, ExpectedErrors} <- failing_contracts() ] ++ + [ {"Testing include with explicit files", + fun() -> + FileSystem = maps:from_list( + [ begin + {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 := Code2} = compile("include"), + ?assertMatch(true, Code1 == Code2) + end} ] ++ [ {"Testing deadcode elimination", fun() -> #{ byte_code := NoDeadCode } = compile("nodeadcode"), @@ -50,15 +61,14 @@ check_errors(Expect, ErrorString) -> {Missing, Extra} -> ?assertEqual(Missing, Extra) end. -compile(Name) -> compile(Name, true). +compile(Name) -> + compile(Name, [{include, {file_system, [aeso_test_utils:contract_path()]}}]). -compile(Name, AllowInc) -> +compile(Name, Options) -> String = aeso_test_utils:read_contract(Name), - case aeso_compiler:from_string(String, [{include_path, [aeso_test_utils:contract_path()]}, - {allow_include, AllowInc}, - {src_file, Name}]) of - {ok,Map} -> Map; - {error,ErrorString} -> ErrorString + case aeso_compiler:from_string(String, [{src_file, Name} | Options]) of + {ok, Map} -> Map; + {error, ErrorString} -> ErrorString end. %% compilable_contracts() -> [ContractName]. @@ -201,8 +211,6 @@ failing_contracts() -> " r.foo : (gas : int, value : int) => Remote.themap\n" "against the expected type\n" " (gas : int, value : int) => map(string, int)">>]} - , {"include", - [<<"file include, line 1, column 9: includes not allowed in this context\n">>]} , {"bad_include_and_ns", [<<"Include of 'included.aes' at line 2, column 11\nnot allowed, include only allowed at top level.">>, <<"Nested namespace not allowed\nNamespace 'Foo' at line 3, column 13 not defined at top level.">>]} From 236ef6eb899af26359278890f053a54fa3014c2f Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 14:15:15 +0100 Subject: [PATCH 17/18] Dialyzed! --- src/aeso_compiler.erl | 2 +- src/aeso_parser.erl | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/aeso_compiler.erl b/src/aeso_compiler.erl index 7fe0a6b..7a82115 100644 --- a/src/aeso_compiler.erl +++ b/src/aeso_compiler.erl @@ -289,7 +289,7 @@ parse(Text, Options) -> ErrorString = io_lib:format("Ambiguous ~p", [As]), parse_error(Pos, ErrorString); %% Include error - {error, {Pos, {include_error, File}}} -> + {error, {Pos, include_error, File}} -> parse_error(Pos, io_lib:format("could not find include file '~s'", [File])) end. diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index 8b0a247..b934e08 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -493,7 +493,7 @@ expand_includes([{include, S = {string, _, File}} | AST], Acc, Opts) -> Err end; {error, _} -> - {error, {get_pos(S), {include_error, File}}} + {error, {get_pos(S), include_error, File}} end; expand_includes([E | AST], Acc, Opts) -> expand_includes(AST, [E | Acc], Opts). From b5b0d30fc4576feca7347c0855a63797287a4c84 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 8 Feb 2019 14:48:38 +0100 Subject: [PATCH 18/18] Less hacky handling of Chain.event --- src/aeso_ast_infer_types.erl | 8 ++++---- src/aeso_ast_to_icode.erl | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index c15f8ba..8eb049a 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -193,10 +193,10 @@ bind_state(Env) -> Env1 = bind_funs([{"state", State}, {"put", {fun_t, Ann, [], [State], Unit}}], Env), - %% A bit of a hack: we bind Chain.event with the local event type. - Env2 = force_bind_fun("event", {fun_t, Ann, [], [Event], Unit}, - Env1#env{ namespace = ["Chain"] }), - Env2#env{ namespace = Env1#env.namespace }. + %% We bind Chain.event in a local 'Chain' namespace. + pop_scope( + bind_fun("event", {fun_t, Ann, [], [Event], Unit}, + push_scope(namespace, {con, Ann, "Chain"}, Env1))). -spec bind_field(name(), field_info(), env()) -> env(). bind_field(X, Info, Env = #env{ fields = Fields }) -> diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index e9dd732..a7fbbb3 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -140,7 +140,7 @@ ast_type(T, Icode) -> ast_body(?qid_app(["Chain","spend"], [To, Amount], _, _), Icode) -> prim_call(?PRIM_CALL_SPEND, ast_body(Amount, Icode), [ast_body(To, Icode)], [word], {tuple, []}); -ast_body(?qid_app(["Chain","event"], [Event], _, _), Icode) -> +ast_body(?qid_app([Con, "Chain", "event"], [Event], _, _), Icode = #{ contract_name := Con }) -> aeso_builtins:check_event_type(Icode), builtin_call({event, maps:get(event_type, Icode)}, [ast_body(Event, Icode)]);