From e6c9d0fac160af33f6160fc4386175a8edfff793 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 4 Feb 2019 10:39:36 +0100 Subject: [PATCH] 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.