More code errors

This commit is contained in:
Ulf Norell 2019-09-03 14:11:42 +02:00
parent adfa325f48
commit 30de1db163
18 changed files with 227 additions and 48 deletions

View File

@ -140,6 +140,7 @@
functions := #{ fun_name() => fun_def() } }. functions := #{ fun_name() => fun_def() } }.
-define(HASH_BYTES, 32). -define(HASH_BYTES, 32).
%% -- Entrypoint ------------------------------------------------------------- %% -- Entrypoint -------------------------------------------------------------
%% Main entrypoint. Takes typed syntax produced by aeso_ast_infer_types:infer/1,2 %% Main entrypoint. Takes typed syntax produced by aeso_ast_infer_types:infer/1,2
@ -272,21 +273,21 @@ decls_to_fcode(Env, Decls) ->
-spec decl_to_fcode(env(), aeso_syntax:decl()) -> env(). -spec decl_to_fcode(env(), aeso_syntax:decl()) -> env().
decl_to_fcode(Env, {type_decl, _, _, _}) -> Env; decl_to_fcode(Env, {type_decl, _, _, _}) -> Env;
decl_to_fcode(Env = #{context := {main_contract, _}}, {fun_decl, Ann, {id, _, Name}, _}) -> decl_to_fcode(Env = #{context := {main_contract, _}}, {fun_decl, _, Id, _}) ->
case is_no_code(Env) of case is_no_code(Env) of
false -> fcode_error({missing_definition, Name, lists:keydelete(entrypoint, 1, Ann)}); false -> fcode_error({missing_definition, Id});
true -> Env true -> Env
end; end;
decl_to_fcode(Env, {fun_decl, _, _, _}) -> Env; decl_to_fcode(Env, {fun_decl, _, _, _}) -> Env;
decl_to_fcode(Env, {type_def, _Ann, Name, Args, Def}) -> decl_to_fcode(Env, {type_def, _Ann, Name, Args, Def}) ->
typedef_to_fcode(Env, Name, Args, Def); typedef_to_fcode(Env, Name, Args, Def);
decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, Ret, Body}) -> decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, Id = {id, _, Name}, Args, Ret, Body}) ->
Attrs = get_attributes(Ann), Attrs = get_attributes(Ann),
FName = lookup_fun(Env, qname(Env, Name)), FName = lookup_fun(Env, qname(Env, Name)),
FArgs = args_to_fcode(Env, Args), FArgs = args_to_fcode(Env, Args),
FRet = type_to_fcode(Env, Ret), FRet = type_to_fcode(Env, Ret),
FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body), FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body),
[ ensure_first_order_entrypoint(Ann, FArgs, FRet) [ ensure_first_order_entrypoint(Ann, Id, Args, Ret, FArgs, FRet)
|| aeso_syntax:get_ann(entrypoint, Ann, false) ], || aeso_syntax:get_ann(entrypoint, Ann, false) ],
Def = #{ attrs => Attrs, Def = #{ attrs => Attrs,
args => FArgs, args => FArgs,
@ -415,7 +416,7 @@ expr_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Args}) when C
Arity = lists:nth(I + 1, Arities), Arity = lists:nth(I + 1, Arities),
case length(Args) == Arity of case length(Args) == Arity of
true -> {con, Arities, I, [expr_to_fcode(Env, Arg) || Arg <- Args]}; true -> {con, Arities, I, [expr_to_fcode(Env, Arg) || Arg <- Args]};
false -> fcode_error({constructor_arity_mismatch, Con, length(Args), Arity}) false -> internal_error({constructor_arity_mismatch, Con, length(Args), Arity})
end; end;
%% Tuples %% Tuples
@ -540,7 +541,7 @@ expr_to_fcode(Env, Type, {app, _, Fun = {typed, _, _, {fun_t, _, NamedArgsT, _,
%% Get the type of the oracle from the args or the expression itself %% Get the type of the oracle from the args or the expression itself
OType = get_oracle_type(B, Type, Args1), OType = get_oracle_type(B, Type, Args1),
{oracle, QType, RType} = type_to_fcode(Env, OType), {oracle, QType, RType} = type_to_fcode(Env, OType),
validate_oracle_type(aeso_syntax:get_ann(Fun), QType, RType), validate_oracle_type(aeso_syntax:get_ann(Fun), OType, QType, RType),
TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}], TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}],
builtin_to_fcode(B, FArgs ++ TypeArgs); builtin_to_fcode(B, FArgs ++ TypeArgs);
{builtin_u, B, _} when B =:= aens_resolve -> {builtin_u, B, _} when B =:= aens_resolve ->
@ -622,11 +623,11 @@ get_oracle_type(oracle_check, _Type, [{typed, _, _Expr, OType}]) ->
get_oracle_type(oracle_check_query, _Type, [{typed, _, _Expr, OType} | _]) -> OType; get_oracle_type(oracle_check_query, _Type, [{typed, _, _Expr, OType} | _]) -> OType;
get_oracle_type(oracle_respond, _Type, [_, {typed, _,_Expr, OType} | _]) -> OType. get_oracle_type(oracle_respond, _Type, [_, {typed, _,_Expr, OType} | _]) -> OType.
validate_oracle_type(Ann, QType, RType) -> validate_oracle_type(Ann, Type, QType, RType) ->
ensure_monomorphic(QType, {polymorphic_query_type, Ann, QType}), ensure_monomorphic(QType, {invalid_oracle_type, polymorphic, query, Ann, Type}),
ensure_monomorphic(RType, {polymorphic_response_type, Ann, RType}), ensure_monomorphic(RType, {invalid_oracle_type, polymorphic, response, Ann, Type}),
ensure_first_order(QType, {higher_order_query_type, Ann, QType}), ensure_first_order(QType, {invalid_oracle_type, higher_order, query, Ann, Type}),
ensure_first_order(RType, {higher_order_response_type, Ann, RType}), ensure_first_order(RType, {invalid_oracle_type, higher_order, response, Ann, Type}),
ok. ok.
validate_aens_resolve_type(Ann, {app_t, _, _, [Type]}, {variant, [[], [FType]]}) -> validate_aens_resolve_type(Ann, {app_t, _, _, [Type]}, {variant, [[], [FType]]}) ->
@ -639,10 +640,10 @@ validate_aens_resolve_type(Ann, {app_t, _, _, [Type]}, {variant, [[], [FType]]})
_ -> fcode_error({invalid_aens_resolve_type, Ann, Type}) _ -> fcode_error({invalid_aens_resolve_type, Ann, Type})
end. end.
ensure_first_order_entrypoint(Ann, Args, Ret) -> ensure_first_order_entrypoint(Ann, Name, Args, Ret, FArgs, FRet) ->
[ ensure_first_order(T, {higher_order_entrypoint_argument, Ann, X, T}) [ ensure_first_order(FT, {invalid_entrypoint, higher_order, Ann1, Name, {argument, X, T}})
|| {X, T} <- Args ], || {{arg, Ann1, X, T}, {_, FT}} <- lists:zip(Args, FArgs) ],
ensure_first_order(Ret, {higher_order_entrypoint_return, Ann, Ret}), ensure_first_order(FRet, {invalid_entrypoint, higher_order, Ann, Name, {result, Ret}}),
ok. ok.
ensure_monomorphic(Type, Err) -> ensure_monomorphic(Type, Err) ->
@ -1218,7 +1219,7 @@ resolve_var(Env, Q) -> resolve_fun(Env, Q).
resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) -> resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) ->
case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of
{not_found, not_found} -> fcode_error({unbound_variable, Q}); {not_found, not_found} -> internal_error({unbound_variable, Q});
{_, {B, none}} -> {builtin, B, []}; {_, {B, none}} -> {builtin, B, []};
{_, {B, Ar}} -> {builtin_u, B, Ar}; {_, {B, Ar}} -> {builtin_u, B, Ar};
{{Fun, Ar}, _} -> {def_u, Fun, Ar} {{Fun, Ar}, _} -> {def_u, Fun, Ar}

View File

@ -113,8 +113,12 @@ contract_to_icode([{letfun, Attrib, Name, Args, _What, Body={typed,_,_,T}}|Rest]
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),
contract_to_icode(Rest, NewIcode); contract_to_icode(Rest, NewIcode);
contract_to_icode([], Icode) -> Icode; contract_to_icode([], Icode) -> Icode;
contract_to_icode([{fun_decl, _, _, _} | Code], Icode) -> contract_to_icode([{fun_decl, _, Id, _} | Code], Icode = #{ options := Options }) ->
contract_to_icode(Code, Icode); NoCode = proplists:get_value(no_code, Options, false),
case aeso_icode:in_main_contract(Icode) andalso not NoCode of
true -> gen_error({missing_definition, Id});
false -> contract_to_icode(Code, Icode)
end;
contract_to_icode([Decl | Code], Icode) -> contract_to_icode([Decl | Code], Icode) ->
io:format("Unhandled declaration: ~p\n", [Decl]), io:format("Unhandled declaration: ~p\n", [Decl]),
contract_to_icode(Code, Icode). contract_to_icode(Code, Icode).
@ -267,8 +271,8 @@ ast_body({app, _, {typed, _, {proj, _, Addr, {id, _, FunName}},
%% entrypoint on the callee side. %% entrypoint on the callee side.
type_hash= #integer{value = 0} type_hash= #integer{value = 0}
}; };
ast_body(Call = {proj, _, {typed, _, _, {con, _, _Contract}}, {id, _, _FunName}}, _Icode) -> ast_body({proj, _, Con = {typed, _, _, {con, _, _}}, _Fun}, _Icode) ->
gen_error({unapplied_contract_call, Call}); gen_error({unapplied_contract_call, Con});
ast_body({con, _, Name}, Icode) -> ast_body({con, _, Name}, Icode) ->
Tag = aeso_icode:get_constructor_tag([Name], Icode), Tag = aeso_icode:get_constructor_tag([Name], Icode),
@ -405,7 +409,7 @@ ast_binop(Op, Ann, {typed, _, A, Type}, B, Icode)
Neg = case Op of Neg = case Op of
'==' -> fun(X) -> X end; '==' -> fun(X) -> X end;
'!=' -> fun(X) -> #unop{ op = '!', rand = X } end; '!=' -> fun(X) -> #unop{ op = '!', rand = X } end;
_ -> gen_error({cant_compare, Ann, Op, Type}) _ -> gen_error({cant_compare_type_aevm, Ann, Op, Type})
end, end,
Args = [ast_body(A, Icode), ast_body(B, Icode)], Args = [ast_body(A, Icode), ast_body(B, Icode)],
Builtin = Builtin =
@ -416,10 +420,10 @@ ast_binop(Op, Ann, {typed, _, A, Type}, B, Icode)
case lists:usort(Types) of case lists:usort(Types) of
[word] -> [word] ->
builtin_call(str_equal_p, [ #integer{value = 32 * length(Types)} | Args]); builtin_call(str_equal_p, [ #integer{value = 32 * length(Types)} | Args]);
_ -> gen_error({cant_compare, Ann, Op, Type}) _ -> gen_error({cant_compare_type_aevm, Ann, Op, Type})
end; end;
_ -> _ ->
gen_error({cant_compare, Ann, Op, Type}) gen_error({cant_compare_type_aevm, Ann, Op, Type})
end, end,
Neg(Builtin) Neg(Builtin)
end; end;
@ -508,48 +512,57 @@ builtin_code(_, {id, _, "require"}, [Bool, String], _, _, Icode) ->
builtin_call(require, [ast_body(Bool, Icode), ast_body(String, Icode)]); builtin_call(require, [ast_body(Bool, Icode), ast_body(String, Icode)]);
%% Oracles %% Oracles
builtin_code(_, {qid, _, ["Oracle", "register"]}, Args, _, ?oracle_t(QType, RType), Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "register"]}, Args, _, OracleType = ?oracle_t(QType, RType), Icode) ->
check_oracle_type(Ann, OracleType),
{Sign, [Acct, QFee, TTL]} = get_signature_arg(Args), {Sign, [Acct, QFee, TTL]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_ORACLE_REGISTER, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_REGISTER, #integer{value = 0},
[ast_body(Acct, Icode), ast_body(Sign, Icode), ast_body(QFee, Icode), ast_body(TTL, Icode), [ast_body(Acct, Icode), ast_body(Sign, Icode), ast_body(QFee, Icode), ast_body(TTL, Icode),
ast_type_value(QType, Icode), ast_type_value(RType, Icode)], ast_type_value(QType, Icode), ast_type_value(RType, Icode)],
[word, sign_t(), word, ttl_t(Icode), typerep, typerep], word); [word, sign_t(), word, ttl_t(Icode), typerep, typerep], word);
builtin_code(_, {qid, _, ["Oracle", "query_fee"]}, [Oracle], _, _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "query_fee"]}, [Oracle], [OracleType], _, Icode) ->
check_oracle_type(Ann, OracleType),
prim_call(?PRIM_CALL_ORACLE_QUERY_FEE, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_QUERY_FEE, #integer{value = 0},
[ast_body(Oracle, Icode)], [word], word); [ast_body(Oracle, Icode)], [word], word);
builtin_code(_, {qid, _, ["Oracle", "query"]}, [Oracle, Q, QFee, QTTL, RTTL], [_, QType, _, _, _], _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "query"]}, [Oracle, Q, QFee, QTTL, RTTL], [OracleType, QType, _, _, _], _, Icode) ->
check_oracle_type(Ann, OracleType),
prim_call(?PRIM_CALL_ORACLE_QUERY, ast_body(QFee, Icode), prim_call(?PRIM_CALL_ORACLE_QUERY, ast_body(QFee, Icode),
[ast_body(Oracle, Icode), ast_body(Q, Icode), ast_body(QTTL, Icode), ast_body(RTTL, Icode)], [ast_body(Oracle, Icode), ast_body(Q, Icode), ast_body(QTTL, Icode), ast_body(RTTL, Icode)],
[word, ast_type(QType, Icode), ttl_t(Icode), ttl_t(Icode)], word); [word, ast_type(QType, Icode), ttl_t(Icode), ttl_t(Icode)], word);
builtin_code(_, {qid, _, ["Oracle", "extend"]}, Args, _, _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "extend"]}, Args, [OracleType, _], _, Icode) ->
check_oracle_type(Ann, OracleType),
{Sign, [Oracle, TTL]} = get_signature_arg(Args), {Sign, [Oracle, TTL]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_ORACLE_EXTEND, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_EXTEND, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Sign, Icode), ast_body(TTL, Icode)], [ast_body(Oracle, Icode), ast_body(Sign, Icode), ast_body(TTL, Icode)],
[word, sign_t(), ttl_t(Icode)], {tuple, []}); [word, sign_t(), ttl_t(Icode)], {tuple, []});
builtin_code(_, {qid, _, ["Oracle", "respond"]}, Args, [_, _, RType], _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "respond"]}, Args, [OracleType, _, RType], _, Icode) ->
check_oracle_type(Ann, OracleType),
{Sign, [Oracle, Query, R]} = get_signature_arg(Args), {Sign, [Oracle, Query, R]} = get_signature_arg(Args),
prim_call(?PRIM_CALL_ORACLE_RESPOND, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_RESPOND, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Query, Icode), ast_body(Sign, Icode), ast_body(R, Icode)], [ast_body(Oracle, Icode), ast_body(Query, Icode), ast_body(Sign, Icode), ast_body(R, Icode)],
[word, word, sign_t(), ast_type(RType, Icode)], {tuple, []}); [word, word, sign_t(), ast_type(RType, Icode)], {tuple, []});
builtin_code(_, {qid, _, ["Oracle", "get_question"]}, [Oracle, Q], [_, ?query_t(QType, _)], _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "get_question"]}, [Oracle, Q], [OracleType, ?query_t(QType, _)], _, Icode) ->
check_oracle_type(Ann, OracleType),
prim_call(?PRIM_CALL_ORACLE_GET_QUESTION, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_GET_QUESTION, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], ast_type(QType, Icode)); [ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], ast_type(QType, Icode));
builtin_code(_, {qid, _, ["Oracle", "get_answer"]}, [Oracle, Q], [_, ?query_t(_, RType)], _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "get_answer"]}, [Oracle, Q], [OracleType, ?query_t(_, RType)], _, Icode) ->
check_oracle_type(Ann, OracleType),
prim_call(?PRIM_CALL_ORACLE_GET_ANSWER, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_GET_ANSWER, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], aeso_icode:option_typerep(ast_type(RType, Icode))); [ast_body(Oracle, Icode), ast_body(Q, Icode)], [word, word], aeso_icode:option_typerep(ast_type(RType, Icode)));
builtin_code(_, {qid, _, ["Oracle", "check"]}, [Oracle], [?oracle_t(Q, R)], _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "check"]}, [Oracle], [OracleType = ?oracle_t(Q, R)], _, Icode) ->
check_oracle_type(Ann, OracleType),
prim_call(?PRIM_CALL_ORACLE_CHECK, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_CHECK, #integer{value = 0},
[ast_body(Oracle, Icode), ast_type_value(Q, Icode), ast_type_value(R, Icode)], [ast_body(Oracle, Icode), ast_type_value(Q, Icode), ast_type_value(R, Icode)],
[word, typerep, typerep], word); [word, typerep, typerep], word);
builtin_code(_, {qid, _, ["Oracle", "check_query"]}, [Oracle, Query], [_, ?query_t(Q, R)], _, Icode) -> builtin_code(_, {qid, Ann, ["Oracle", "check_query"]}, [Oracle, Query], [OracleType, ?query_t(Q, R)], _, Icode) ->
check_oracle_type(Ann, OracleType),
prim_call(?PRIM_CALL_ORACLE_CHECK_QUERY, #integer{value = 0}, prim_call(?PRIM_CALL_ORACLE_CHECK_QUERY, #integer{value = 0},
[ast_body(Oracle, Icode), ast_body(Query, Icode), [ast_body(Oracle, Icode), ast_body(Query, Icode),
ast_type_value(Q, Icode), ast_type_value(R, Icode)], ast_type_value(Q, Icode), ast_type_value(R, Icode)],
@ -730,8 +743,8 @@ map_empty(KeyType, ValType, Icode) ->
ast_type_value(ValType, Icode)], ast_type_value(ValType, Icode)],
[typerep, typerep], word). [typerep, typerep], word).
map_get(Key, Map = {typed, Ann, _, MapType}, Icode) -> map_get(Key, Map = {typed, _Ann, _, MapType}, Icode) ->
{_KeyType, ValType} = check_monomorphic_map(Ann, MapType, Icode), {_KeyType, ValType} = check_monomorphic_map(aeso_syntax:get_ann(Key), MapType, Icode),
builtin_call({map_lookup, ast_type(ValType, Icode)}, [ast_body(Map, Icode), ast_body(Key, Icode)]). builtin_call({map_lookup, ast_type(ValType, Icode)}, [ast_body(Map, Icode), ast_body(Key, Icode)]).
map_put(Key, Val, Map, Icode) -> map_put(Key, Val, Map, Icode) ->
@ -771,12 +784,19 @@ check_entrypoint_type(Ann, Name, Args, Ret) ->
false -> gen_error(Err); false -> gen_error(Err);
true -> ok true -> ok
end end, end end,
[ CheckFirstOrder(T, {entrypoint_argument_must_have_first_order_type, Ann1, Name, X, T}) [ CheckFirstOrder(T, {invalid_entrypoint, higher_order, Ann1, Name, {argument, X, T}})
|| {arg, Ann1, X, T} <- Args ], || {arg, Ann1, X, T} <- Args ],
CheckFirstOrder(Ret, {entrypoint_must_have_first_order_return_type, Ann, Name, Ret}), CheckFirstOrder(Ret, {invalid_entrypoint, higher_order, Ann, Name, {result, Ret}}),
[ CheckMonomorphic(T, {entrypoint_argument_must_have_monomorphic_type, Ann1, Name, X, T}) [ CheckMonomorphic(T, {invalid_entrypoint, polymorphic, Ann1, Name, {argument, X, T}})
|| {arg, Ann1, X, T} <- Args ], || {arg, Ann1, X, T} <- Args ],
CheckMonomorphic(Ret, {entrypoint_must_have_monomorphic_return_type, Ann, Name, Ret}). CheckMonomorphic(Ret, {invalid_entrypoint, polymorphic, Ann, Name, {result, Ret}}).
check_oracle_type(Ann, Type = ?oracle_t(QType, RType)) ->
[ gen_error({invalid_oracle_type, Why, Which, Ann, Type})
|| {Why, Check} <- [{polymorphic, fun is_monomorphic/1},
{higher_order, fun is_first_order_type/1}],
{Which, T} <- [{query, QType}, {response, RType}],
not Check(T) ].
is_simple_type({tvar, _, _}) -> false; is_simple_type({tvar, _, _}) -> false;
is_simple_type({fun_t, _, _, _, _}) -> false; is_simple_type({fun_t, _, _, _, _}) -> false;

View File

@ -18,17 +18,32 @@ format({missing_init_function, Con}) ->
Msg = io_lib:format("Missing init function for the contract '~s'.\n", [pp_expr(Con)]), Msg = io_lib:format("Missing init function for the contract '~s'.\n", [pp_expr(Con)]),
Cxt = "The 'init' function can only be omitted if the state type is 'unit'.\n", Cxt = "The 'init' function can only be omitted if the state type is 'unit'.\n",
mk_err(pos(Con), Msg, Cxt); mk_err(pos(Con), Msg, Cxt);
format({missing_definition, Id}) ->
Msg = io_lib:format("Missing definition of function '~s'.\n", [pp_expr(Id)]),
mk_err(pos(Id), Msg);
format({parameterized_state, Decl}) -> format({parameterized_state, Decl}) ->
Msg = "The state type cannot be parameterized.\n", Msg = "The state type cannot be parameterized.\n",
mk_err(pos(Decl), Msg); mk_err(pos(Decl), Msg);
format({parameterized_event, Decl}) -> format({parameterized_event, Decl}) ->
Msg = "The event type cannot be parameterized.\n", Msg = "The event type cannot be parameterized.\n",
mk_err(pos(Decl), Msg); mk_err(pos(Decl), Msg);
format({entrypoint_argument_must_have_monomorphic_type, Ann, {id, _, Name}, X, T}) -> format({invalid_entrypoint, Why, Ann, {id, _, Name}, Thing}) ->
Msg = io_lib:format("The argument\n~s\nof entrypoint '~s' does not have a monomorphic type.\n", What = case Why of higher_order -> "higher-order (contains function types)";
[pp_typed(X, T), Name]), polymorphic -> "polymorphic (contains type variables)" end,
Cxt = "Use the FATE backend if you want polymorphic entrypoints.", ThingS = case Thing of
mk_err(pos(Ann), Msg, Cxt); {argument, X, T} -> io_lib:format("argument\n~s\n", [pp_typed(X, T)]);
{result, T} -> io_lib:format("return type\n~s\n", [pp_type(2, T)])
end,
Bad = case Thing of
{argument, _, _} -> io_lib:format("has a ~s type", [What]);
{result, _} -> io_lib:format("is ~s", [What])
end,
Msg = io_lib:format("The ~sof entrypoint '~s' ~s.\n",
[ThingS, Name, Bad]),
case Why of
polymorphic -> mk_err(pos(Ann), Msg, "Use the FATE backend if you want polymorphic entrypoints.\n");
higher_order -> mk_err(pos(Ann), Msg)
end;
format({cant_compare_type_aevm, Ann, Op, Type}) -> format({cant_compare_type_aevm, Ann, Op, Type}) ->
StringAndTuple = [ "- type string\n" StringAndTuple = [ "- type string\n"
"- tuple or record of word type\n" || lists:member(Op, ['==', '!=']) ], "- tuple or record of word type\n" || lists:member(Op, ['==', '!=']) ],
@ -36,16 +51,35 @@ format({cant_compare_type_aevm, Ann, Op, Type}) ->
"~s\n" "~s\n"
"The AEVM only supports '~s' on values of\n" "The AEVM only supports '~s' on values of\n"
"- word type (int, bool, bits, address, oracle(_, _), etc)\n" "- word type (int, bool, bits, address, oracle(_, _), etc)\n"
"~s" "~s",
"Use FATE if you need to compare arbitrary types.\n",
[pp_type(2, Type), Op, StringAndTuple]), [pp_type(2, Type), Op, StringAndTuple]),
mk_err(pos(Ann), Msg); Cxt = "Use FATE if you need to compare arbitrary types.\n",
mk_err(pos(Ann), Msg, Cxt);
format({invalid_aens_resolve_type, Ann, T}) -> format({invalid_aens_resolve_type, Ann, T}) ->
Msg = io_lib:format("Invalid return type of AENS.resolve:\n" Msg = io_lib:format("Invalid return type of AENS.resolve:\n"
"~s\n" "~s\n"
"It must be a string or a pubkey type (address, oracle, etc).\n", "It must be a string or a pubkey type (address, oracle, etc).\n",
[pp_type(2, T)]), [pp_type(2, T)]),
mk_err(pos(Ann), Msg); mk_err(pos(Ann), Msg);
format({unapplied_contract_call, Contract}) ->
Msg = io_lib:format("The AEVM does not support unapplied contract call to\n"
"~s\n", [pp_expr(2, Contract)]),
Cxt = "Use FATE if you need this.\n",
mk_err(pos(Contract), Msg, Cxt);
format({invalid_map_key_type, Why, Ann, Type}) ->
Msg = io_lib:format("Invalid map key type\n~s\n", [pp_type(2, Type)]),
Cxt = case Why of
polymorphic -> "Map keys cannot be polymorphic in the AEVM. Use FATE if you need this.\n";
function -> "Map keys cannot be higher-order.\n"
end,
mk_err(pos(Ann), Msg, Cxt);
format({invalid_oracle_type, Why, What, Ann, Type}) ->
WhyS = case Why of higher_order -> "higher-order (contain function types)";
polymorphic -> "polymorphic (contain type variables)" end,
Msg = io_lib:format("Invalid oracle type\n~s\n", [pp_type(2, Type)]),
Cxt = io_lib:format("The ~s type must not be ~s.\n", [What, WhyS]),
mk_err(pos(Ann), Msg, Cxt);
format(Err) -> format(Err) ->
mk_err(aeso_errors:pos(0, 0), io_lib:format("Unknown error: ~p\n", [Err])). mk_err(aeso_errors:pos(0, 0), io_lib:format("Unknown error: ~p\n", [Err])).
@ -62,7 +96,10 @@ pp_typed(E, T) ->
aeso_pretty:type(T)]))). aeso_pretty:type(T)]))).
pp_expr(E) -> pp_expr(E) ->
prettypr:format(aeso_pretty:expr(E)). pp_expr(0, E).
pp_expr(N, E) ->
prettypr:format(prettypr:nest(N, aeso_pretty:expr(E))).
pp_type(N, T) -> pp_type(N, T) ->
prettypr:format(prettypr:nest(N, aeso_pretty:type(T))). prettypr:format(prettypr:nest(N, aeso_pretty:type(T))).

View File

@ -16,6 +16,7 @@
set_payable/2, set_payable/2,
enter_namespace/2, enter_namespace/2,
get_namespace/1, get_namespace/1,
in_main_contract/1,
qualify/2, qualify/2,
set_functions/2, set_functions/2,
map_typerep/2, map_typerep/2,
@ -120,6 +121,10 @@ enter_namespace(NS, Icode = #{ namespace := NS1 }) ->
enter_namespace(NS, Icode) -> enter_namespace(NS, Icode) ->
Icode#{ namespace => NS }. Icode#{ namespace => NS }.
-spec in_main_contract(icode()) -> boolean().
in_main_contract(#{ namespace := {con, _, Main}, contract_name := Main }) -> true;
in_main_contract(_Icode) -> false.
-spec get_namespace(icode()) -> false | aeso_syntax:con() | aeso_syntax:qcon(). -spec get_namespace(icode()) -> false | aeso_syntax:con() | aeso_syntax:qcon().
get_namespace(Icode) -> maps:get(namespace, Icode, false). get_namespace(Icode) -> maps:get(namespace, Icode, false).

View File

@ -492,11 +492,26 @@ failing_contracts() ->
failing_code_gen_contracts() -> failing_code_gen_contracts() ->
[ ?SAME(last_declaration_must_be_contract, 1, 1, [ ?SAME(last_declaration_must_be_contract, 1, 1,
"Expected a contract as the last declaration instead of the namespace 'LastDeclarationIsNotAContract'") "Expected a contract as the last declaration instead of the namespace 'LastDeclarationIsNotAContract'")
, ?SAME(missing_definition, 2, 14,
"Missing definition of function 'foo'.")
, ?AEVM(polymorphic_entrypoint, 2, 17, , ?AEVM(polymorphic_entrypoint, 2, 17,
"The argument\n" "The argument\n"
" x : 'a\n" " x : 'a\n"
"of entrypoint 'id' does not have a monomorphic type.\n" "of entrypoint 'id' has a polymorphic (contains type variables) type.\n"
"Use the FATE backend if you want polymorphic entrypoints.") "Use the FATE backend if you want polymorphic entrypoints.")
, ?AEVM(polymorphic_entrypoint_return, 2, 3,
"The return type\n"
" 'a\n"
"of entrypoint 'fail' is polymorphic (contains type variables).\n"
"Use the FATE backend if you want polymorphic entrypoints.")
, ?SAME(higher_order_entrypoint, 2, 20,
"The argument\n"
" f : (int) => int\n"
"of entrypoint 'apply' has a higher-order (contains function types) type.")
, ?SAME(higher_order_entrypoint_return, 2, 3,
"The return type\n"
" (int) => int\n"
"of entrypoint 'add' is higher-order (contains function types).")
, ?SAME(missing_init_function, 1, 10, , ?SAME(missing_init_function, 1, 10,
"Missing init function for the contract 'MissingInitFunction'.\n" "Missing init function for the contract 'MissingInitFunction'.\n"
"The 'init' function can only be omitted if the state type is 'unit'.") "The 'init' function can only be omitted if the state type is 'unit'.")
@ -520,11 +535,53 @@ failing_code_gen_contracts() ->
"- type string\n" "- type string\n"
"- tuple or record of word type\n" "- tuple or record of word type\n"
"Use FATE if you need to compare arbitrary types.") "Use FATE if you need to compare arbitrary types.")
, ?AEVM(complex_compare, 4, 5,
"Cannot compare values of type\n"
" (string * int)\n"
"The AEVM only supports '!=' on values of\n"
"- word type (int, bool, bits, address, oracle(_, _), etc)\n"
"- type string\n"
"- tuple or record of word type\n"
"Use FATE if you need to compare arbitrary types.")
, ?AEVM(complex_compare_leq, 4, 5,
"Cannot compare values of type\n"
" (int * int)\n"
"The AEVM only supports '=<' on values of\n"
"- word type (int, bool, bits, address, oracle(_, _), etc)\n"
"Use FATE if you need to compare arbitrary types.")
, ?AEVM(higher_order_compare, 4, 5, , ?AEVM(higher_order_compare, 4, 5,
"Cannot compare values of type\n" "Cannot compare values of type\n"
" (int) => int\n" " (int) => int\n"
"The AEVM only supports '<' on values of\n" "The AEVM only supports '<' on values of\n"
"- word type (int, bool, bits, address, oracle(_, _), etc)\n" "- word type (int, bool, bits, address, oracle(_, _), etc)\n"
"Use FATE if you need to compare arbitrary types.") "Use FATE if you need to compare arbitrary types.")
, ?AEVM(unapplied_contract_call, 6, 19,
"The AEVM does not support unapplied contract call to\n"
" r : Remote\n"
"Use FATE if you need this.")
, ?AEVM(polymorphic_map_keys, 4, 34,
"Invalid map key type\n"
" 'a\n"
"Map keys cannot be polymorphic in the AEVM. Use FATE if you need this.")
, ?AEVM(higher_order_map_keys, 4, 42,
"Invalid map key type\n"
" (int) => int\n"
"Map keys cannot be higher-order.")
, ?SAME(polymorphic_query_type, 3, 5,
"Invalid oracle type\n"
" oracle('a, 'b)\n"
"The query type must not be polymorphic (contain type variables).")
, ?SAME(polymorphic_response_type, 3, 5,
"Invalid oracle type\n"
" oracle(string, 'r)\n"
"The response type must not be polymorphic (contain type variables).")
, ?SAME(higher_order_query_type, 3, 5,
"Invalid oracle type\n"
" oracle((int) => int, string)\n"
"The query type must not be higher-order (contain function types).")
, ?SAME(higher_order_response_type, 3, 5,
"Invalid oracle type\n"
" oracle(string, (int) => int)\n"
"The response type must not be higher-order (contain function types).")
]. ].

View File

@ -0,0 +1,4 @@
contract ComplexCompare =
entrypoint test(x : string * int) =
("foo", 1) != x

View File

@ -0,0 +1,4 @@
contract ComplexCompare =
entrypoint test(x : int) =
(1, 2) =< (x, x + 1)

View File

@ -0,0 +1,2 @@
contract HigherOrderEntrypoint =
entrypoint apply(f : int => int, x : int) = f(x)

View File

@ -0,0 +1,2 @@
contract HigherOrderEntrypoint =
entrypoint add(x : int) = (y) => x + y

View File

@ -0,0 +1,6 @@
contract MapAsMapKey =
type t('key) = map('key, int)
function foo(m) : t(int => int) = {[m] = 0}
entrypoint main() = ()

View File

@ -0,0 +1,5 @@
contract HigherOrderQueryType =
stateful function foo(o) : oracle_query(_, string ) =
Oracle.query(o, (x) => x + 1, 100, RelativeTTL(100), RelativeTTL(100))
entrypoint main() = ()

View File

@ -0,0 +1,5 @@
contract HigherOrderResponseType =
stateful function foo(o, q : oracle_query(string, _)) =
Oracle.respond(o, q, (x) => x + 1)
entrypoint main() = ()

View File

@ -0,0 +1,3 @@
contract MissingDefinition =
entrypoint foo : int => int
entrypoint main() = foo(0)

View File

@ -0,0 +1,3 @@
contract PolymorphicEntrypoint =
entrypoint fail() : 'a = abort("fail")

View File

@ -0,0 +1,6 @@
contract MapAsMapKey =
type t('key) = map('key, int)
function foo(m) : t('a) = {[m] = 0}
entrypoint main() = ()

View File

@ -0,0 +1,5 @@
contract PolymorphicQueryType =
stateful function is_oracle(o) =
Oracle.check(o)
entrypoint main() = ()

View File

@ -0,0 +1,5 @@
contract PolymorphicResponseType =
function is_oracle(o : oracle(string, 'r)) =
Oracle.check(o)
entrypoint main(o : oracle(string, int)) = is_oracle(o)

View File

@ -0,0 +1,9 @@
contract Remote =
entrypoint foo : int => int
contract UnappliedContractCall =
function f(r) = r.foo
entrypoint test(r) = f(r)(0)