From 367f87b612f0310dfe3d5cf7ef66227e29ac61ed Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 21 Jan 2019 14:20:57 +0100 Subject: [PATCH] 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)) +