Add checks for polymorphic/higher order oracles and higher order entrypoints (AEVM)

This commit is contained in:
Ulf Norell 2019-08-30 11:13:13 +02:00
parent 1ce95b32ac
commit 6fd39d4cb1
4 changed files with 50 additions and 31 deletions

View File

@ -93,6 +93,8 @@ contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest]
FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++ FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++
[ payable || proplists:get_value(payable, Attrib, false) ] ++ [ payable || proplists:get_value(payable, Attrib, false) ] ++
[ private || is_private(Attrib, Icode) ], [ private || is_private(Attrib, Icode) ],
[ check_entrypoint_type(Attrib, Name, Args, T)
|| aeso_syntax:get_ann(entrypoint, Attrib, false) ],
%% TODO: Handle types %% TODO: Handle types
FunName = ast_id(Name), FunName = ast_id(Name),
%% TODO: push funname to env %% TODO: push funname to env
@ -105,7 +107,7 @@ contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest]
#{ state_type := StateType } = Icode, #{ state_type := StateType } = Icode,
{#tuple{ cpts = [type_value(StateType), ast_body(Body, Icode)] }, {#tuple{ cpts = [type_value(StateType), ast_body(Body, Icode)] },
{tuple, [typerep, ast_typerep(T, Icode)]}}; {tuple, [typerep, ast_typerep(T, Icode)]}};
_ -> {ast_body(Body, Icode), ast_typerep(T, Icode)} _ -> {ast_body(Body, Icode), ast_typerep1(T, Icode)}
end, end,
QName = aeso_icode:qualify(Name, Icode), QName = aeso_icode:qualify(Name, Icode),
NewIcode = ast_fun_to_icode(ast_id(QName), FunAttrs, FunArgs, FunBody, TypeRep, Icode), NewIcode = ast_fun_to_icode(ast_id(QName), FunAttrs, FunArgs, FunBody, TypeRep, Icode),
@ -121,7 +123,7 @@ ast_id({id, _, Id}) -> Id;
ast_id({qid, _, Id}) -> Id. ast_id({qid, _, Id}) -> Id.
ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) -> ast_args([{arg, _, Name, Type}|Rest], Acc, Icode) ->
ast_args(Rest, [{ast_id(Name), ast_type(Type, Icode)}| Acc], Icode); ast_args(Rest, [{ast_id(Name), ast_typerep1(Type, Icode)}| Acc], Icode);
ast_args([], Acc, _Icode) -> lists:reverse(Acc). ast_args([], Acc, _Icode) -> lists:reverse(Acc).
ast_type(T, Icode) -> ast_type(T, Icode) ->
@ -582,7 +584,7 @@ ast_body({block,As,[E|Rest]}, Icode) ->
#switch{expr=ast_body(E, Icode), #switch{expr=ast_body(E, Icode),
cases=[{#var_ref{name="_"},ast_body({block,As,Rest}, Icode)}]}; cases=[{#var_ref{name="_"},ast_body({block,As,Rest}, Icode)}]};
ast_body({lam,_,Args,Body}, Icode) -> ast_body({lam,_,Args,Body}, Icode) ->
#lambda{args=[#arg{name = ast_id(P), type = ast_type(T, Icode)} || {arg,_,P,T} <- Args], #lambda{args=[#arg{name = ast_id(P), type = ast_typerep1(T, Icode)} || {arg,_,P,T} <- Args],
body=ast_body(Body, Icode)}; body=ast_body(Body, Icode)};
ast_body({typed,_,{record,Attrs,Fields},{record_t,DefFields}}, Icode) -> ast_body({typed,_,{record,Attrs,Fields},{record_t,DefFields}}, Icode) ->
%% Compile as a tuple with the fields in the order they appear in the definition. %% Compile as a tuple with the fields in the order they appear in the definition.
@ -717,6 +719,22 @@ map_upd(Key, Default, ValFun, Map = {typed, Ann, _, MapType}, Icode) ->
Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Default, Icode), ast_body(ValFun, Icode)], Args = [ast_body(Map, Icode), ast_body(Key, Icode), ast_body(Default, Icode), ast_body(ValFun, Icode)],
builtin_call(FunName, Args). builtin_call(FunName, Args).
check_entrypoint_type(Ann, Name, Args, Ret) ->
Check = fun(T, Err) ->
case is_simple_type(T) of
false -> gen_error(Err);
true -> ok
end end,
[ Check(T, {entrypoint_argument_must_have_simple_type, Ann1, Name, X, T})
|| {arg, Ann1, X, T} <- Args ],
Check(Ret, {entrypoint_must_have_simple_return_type, Ann, Name, Ret}).
is_simple_type({tvar, _, _}) -> false;
is_simple_type({fun_t, _, _, _, _}) -> false;
is_simple_type(Ts) when is_list(Ts) -> lists:all(fun is_simple_type/1, Ts);
is_simple_type(T) when is_tuple(T) -> is_simple_type(tuple_to_list(T));
is_simple_type(_) -> true.
is_monomorphic({tvar, _, _}) -> false; is_monomorphic({tvar, _, _}) -> false;
is_monomorphic([H|T]) -> is_monomorphic([H|T]) ->
is_monomorphic(H) andalso is_monomorphic(T); is_monomorphic(H) andalso is_monomorphic(T);
@ -757,42 +775,49 @@ make_type_def(Args, Def, Icode = #{ type_vars := TypeEnv }) ->
TVars = [ X || {tvar, _, X} <- Args ], TVars = [ X || {tvar, _, X} <- Args ],
fun(Types) -> fun(Types) ->
TypeEnv1 = maps:from_list(lists:zip(TVars, Types)), TypeEnv1 = maps:from_list(lists:zip(TVars, Types)),
ast_typerep(Def, Icode#{ type_vars := maps:merge(TypeEnv, TypeEnv1) }) ast_typerep1(Def, Icode#{ type_vars := maps:merge(TypeEnv, TypeEnv1) })
end. end.
-spec ast_typerep(aeso_syntax:type()) -> aeb_aevm_data:type(). -spec ast_typerep(aeso_syntax:type()) -> aeb_aevm_data:type().
ast_typerep(Type) -> ast_typerep(Type, aeso_icode:new([])). ast_typerep(Type) ->
ast_typerep(Type, aeso_icode:new([])).
ast_typerep({id, _, Name}, Icode) -> ast_typerep(Type, Icode) ->
case is_simple_type(Type) of
false -> gen_error({not_a_simple_type, Type});
true -> ast_typerep1(Type, Icode)
end.
ast_typerep1({id, _, Name}, Icode) ->
lookup_type_id(Name, [], Icode); lookup_type_id(Name, [], Icode);
ast_typerep({qid, _, Name}, Icode) -> ast_typerep1({qid, _, Name}, Icode) ->
lookup_type_id(Name, [], Icode); lookup_type_id(Name, [], Icode);
ast_typerep({con, _, _}, _) -> ast_typerep1({con, _, _}, _) ->
word; %% Contract type word; %% Contract type
ast_typerep({bytes_t, _, Len}, _) -> ast_typerep1({bytes_t, _, Len}, _) ->
bytes_t(Len); bytes_t(Len);
ast_typerep({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid -> ast_typerep1({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid ->
ArgReps = [ ast_typerep(Arg, Icode) || Arg <- Args ], ArgReps = [ ast_typerep1(Arg, Icode) || Arg <- Args ],
lookup_type_id(Name, ArgReps, Icode); lookup_type_id(Name, ArgReps, Icode);
ast_typerep({tvar,_,A}, #{ type_vars := TypeVars }) -> ast_typerep1({tvar,_,A}, #{ type_vars := TypeVars }) ->
case maps:get(A, TypeVars, undefined) of case maps:get(A, TypeVars, undefined) of
undefined -> word; %% We serialize type variables just as addresses in the originating VM. undefined -> word; %% We serialize type variables just as addresses in the originating VM.
Type -> Type Type -> Type
end; end;
ast_typerep({tuple_t,_,Cpts}, Icode) -> ast_typerep1({tuple_t,_,Cpts}, Icode) ->
{tuple, [ast_typerep(C, Icode) || C<-Cpts]}; {tuple, [ast_typerep1(C, Icode) || C<-Cpts]};
ast_typerep({record_t,Fields}, Icode) -> ast_typerep1({record_t,Fields}, Icode) ->
{tuple, [ begin {tuple, [ begin
{field_t, _, _, T} = Field, {field_t, _, _, T} = Field,
ast_typerep(T, Icode) ast_typerep1(T, Icode)
end || Field <- Fields]}; end || Field <- Fields]};
ast_typerep({fun_t,_,_,_,_}, _Icode) -> ast_typerep1({fun_t,_,_,_,_}, _Icode) ->
function; function;
ast_typerep({alias_t, T}, Icode) -> ast_typerep(T, Icode); ast_typerep1({alias_t, T}, Icode) -> ast_typerep1(T, Icode);
ast_typerep({variant_t, Cons}, Icode) -> ast_typerep1({variant_t, Cons}, Icode) ->
{variant, [ begin {variant, [ begin
{constr_t, _, _, Args} = Con, {constr_t, _, _, Args} = Con,
[ ast_typerep(Arg, Icode) || Arg <- Args ] [ ast_typerep1(Arg, Icode) || Arg <- Args ]
end || Con <- Cons ]}. end || Con <- Cons ]}.
ttl_t(Icode) -> ttl_t(Icode) ->
@ -841,13 +866,6 @@ type_value({map, K, V}) ->
#tuple{ cpts = [#integer{ value = ?TYPEREP_MAP_TAG }, #tuple{ cpts = [#integer{ value = ?TYPEREP_MAP_TAG },
type_value(K), type_value(V)] }. type_value(K), type_value(V)] }.
%% As abort is a built-in in the future it will be illegal to for
%% users to define abort. For the time being strip away all user
%% defined abort functions.
ast_fun_to_icode("abort", _Atts, _Args, _Body, _TypeRep, Icode) ->
%% Strip away all user defined abort functions.
Icode;
ast_fun_to_icode(Name, Attrs, Args, Body, TypeRep, #{functions := Funs} = Icode) -> ast_fun_to_icode(Name, Attrs, Args, Body, TypeRep, #{functions := Funs} = Icode) ->
NewFuns = [{Name, Attrs, Args, Body, TypeRep}| Funs], NewFuns = [{Name, Attrs, Args, Body, TypeRep}| Funs],
aeso_icode:set_functions(NewFuns, Icode). aeso_icode:set_functions(NewFuns, Icode).

View File

@ -50,7 +50,7 @@ contract ComplexTypes =
entrypoint remote_pair(n : int, s : string) : int * string = entrypoint remote_pair(n : int, s : string) : int * string =
state.worker.pair(gas = 10000, n, s) state.worker.pair(gas = 10000, n, s)
entrypoint map(f, xs) = function map(f, xs) =
switch(xs) switch(xs)
[] => [] [] => []
x :: xs => f(x) :: map(f, xs) x :: xs => f(x) :: map(f, xs)

View File

@ -91,10 +91,11 @@ contract Identity =
// } // }
// let id(x) = x // let id(x) = x
// let main(xs) = map(double,xs) // let main(xs) = map(double,xs)
entrypoint z(f,x) = x function z(f,x) = x
function s(n) = (f,x)=>f(n(f,x)) function s(n) = (f,x)=>f(n(f,x))
function add(m,n) = (f,x)=>m(f,n(f,x)) function add(m,n) = (f,x)=>m(f,n(f,x))
entrypoint main(_) =
entrypoint main() =
let three=s(s(s(z))) let three=s(s(s(z)))
add(three,three) add(three,three)
(((i)=>i+1),0) (((i)=>i+1),0)

View File

@ -1,6 +1,6 @@
contract TuplesMatch = contract TuplesMatch =
entrypoint tuplify3() = (t) => switch(t) function tuplify3() = (t) => switch(t)
(x, y, z) => 3 (x, y, z) => 3
entrypoint fst(p : int * string) = entrypoint fst(p : int * string) =