From 6fd39d4cb19651ddee556307f62631782a9e5d53 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 30 Aug 2019 11:13:13 +0200 Subject: [PATCH] Add checks for polymorphic/higher order oracles and higher order entrypoints (AEVM) --- src/aeso_ast_to_icode.erl | 72 ++++++++++++++++++++------------ test/contracts/complex_types.aes | 2 +- test/contracts/test.aes | 5 ++- test/contracts/tuple_match.aes | 2 +- 4 files changed, 50 insertions(+), 31 deletions(-) diff --git a/src/aeso_ast_to_icode.erl b/src/aeso_ast_to_icode.erl index ca1433a..c245e29 100644 --- a/src/aeso_ast_to_icode.erl +++ b/src/aeso_ast_to_icode.erl @@ -93,6 +93,8 @@ contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest] FunAttrs = [ stateful || proplists:get_value(stateful, Attrib, false) ] ++ [ payable || proplists:get_value(payable, Attrib, false) ] ++ [ private || is_private(Attrib, Icode) ], + [ check_entrypoint_type(Attrib, Name, Args, T) + || aeso_syntax:get_ann(entrypoint, Attrib, false) ], %% TODO: Handle types FunName = ast_id(Name), %% 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, {#tuple{ cpts = [type_value(StateType), ast_body(Body, Icode)] }, {tuple, [typerep, ast_typerep(T, Icode)]}}; - _ -> {ast_body(Body, Icode), ast_typerep(T, Icode)} + _ -> {ast_body(Body, Icode), ast_typerep1(T, Icode)} end, QName = aeso_icode:qualify(Name, 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_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_type(T, Icode) -> @@ -582,7 +584,7 @@ ast_body({block,As,[E|Rest]}, Icode) -> #switch{expr=ast_body(E, Icode), cases=[{#var_ref{name="_"},ast_body({block,As,Rest}, 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)}; 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. @@ -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)], 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([H|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 ], fun(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. -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); -ast_typerep({qid, _, Name}, Icode) -> +ast_typerep1({qid, _, Name}, Icode) -> lookup_type_id(Name, [], Icode); -ast_typerep({con, _, _}, _) -> +ast_typerep1({con, _, _}, _) -> word; %% Contract type -ast_typerep({bytes_t, _, Len}, _) -> +ast_typerep1({bytes_t, _, Len}, _) -> bytes_t(Len); -ast_typerep({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid -> - ArgReps = [ ast_typerep(Arg, Icode) || Arg <- Args ], +ast_typerep1({app_t, _, {I, _, Name}, Args}, Icode) when I =:= id; I =:= qid -> + ArgReps = [ ast_typerep1(Arg, Icode) || Arg <- Args ], 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 undefined -> word; %% We serialize type variables just as addresses in the originating VM. Type -> Type end; -ast_typerep({tuple_t,_,Cpts}, Icode) -> - {tuple, [ast_typerep(C, Icode) || C<-Cpts]}; -ast_typerep({record_t,Fields}, Icode) -> +ast_typerep1({tuple_t,_,Cpts}, Icode) -> + {tuple, [ast_typerep1(C, Icode) || C<-Cpts]}; +ast_typerep1({record_t,Fields}, Icode) -> {tuple, [ begin {field_t, _, _, T} = Field, - ast_typerep(T, Icode) + ast_typerep1(T, Icode) end || Field <- Fields]}; -ast_typerep({fun_t,_,_,_,_}, _Icode) -> +ast_typerep1({fun_t,_,_,_,_}, _Icode) -> function; -ast_typerep({alias_t, T}, Icode) -> ast_typerep(T, Icode); -ast_typerep({variant_t, Cons}, Icode) -> +ast_typerep1({alias_t, T}, Icode) -> ast_typerep1(T, Icode); +ast_typerep1({variant_t, Cons}, Icode) -> {variant, [ begin {constr_t, _, _, Args} = Con, - [ ast_typerep(Arg, Icode) || Arg <- Args ] + [ ast_typerep1(Arg, Icode) || Arg <- Args ] end || Con <- Cons ]}. ttl_t(Icode) -> @@ -841,13 +866,6 @@ type_value({map, K, V}) -> #tuple{ cpts = [#integer{ value = ?TYPEREP_MAP_TAG }, 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) -> NewFuns = [{Name, Attrs, Args, Body, TypeRep}| Funs], aeso_icode:set_functions(NewFuns, Icode). diff --git a/test/contracts/complex_types.aes b/test/contracts/complex_types.aes index 613371f..57e19d7 100644 --- a/test/contracts/complex_types.aes +++ b/test/contracts/complex_types.aes @@ -50,7 +50,7 @@ contract ComplexTypes = entrypoint remote_pair(n : int, s : string) : int * string = state.worker.pair(gas = 10000, n, s) - entrypoint map(f, xs) = + function map(f, xs) = switch(xs) [] => [] x :: xs => f(x) :: map(f, xs) diff --git a/test/contracts/test.aes b/test/contracts/test.aes index 04de90f..bd1a130 100644 --- a/test/contracts/test.aes +++ b/test/contracts/test.aes @@ -91,10 +91,11 @@ contract Identity = // } // let id(x) = x // 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 add(m,n) = (f,x)=>m(f,n(f,x)) - entrypoint main(_) = + + entrypoint main() = let three=s(s(s(z))) add(three,three) (((i)=>i+1),0) diff --git a/test/contracts/tuple_match.aes b/test/contracts/tuple_match.aes index 0bcab8c..b6196e3 100644 --- a/test/contracts/tuple_match.aes +++ b/test/contracts/tuple_match.aes @@ -1,6 +1,6 @@ contract TuplesMatch = - entrypoint tuplify3() = (t) => switch(t) + function tuplify3() = (t) => switch(t) (x, y, z) => 3 entrypoint fst(p : int * string) =