QPQ-AG/sophia
10
0
Fork 0
Code Issues 41 Pull Requests 5 Actions Packages Projects Releases 16 Wiki Activity

Move invalid_oracle_type error to type checker

Browse Source
This commit is contained in:
Gaith Hallak 2022-06-24 15:12:16 +04:00
parent f22c1aa82e
commit eb77ae4137
8 changed files with 75 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/aeso_ast_infer_types.erl
View File

@ -88,8 +88,10 @@
| {add_bytes, aeso_syntax:ann(), concat | split, utype(), utype(), utype()}.
-type aens_resolve_constraint() :: {aens_resolve_type, utype()}.
-type oracle_type_constraint() :: {oracle_type, aeso_syntax:ann(), utype()}.
-type constraint() :: named_argument_constraint() | field_constraint() | byte_constraint() | aens_resolve_constraint().
-type constraint() :: named_argument_constraint() | field_constraint() | byte_constraint()
| aens_resolve_constraint() | oracle_type_constraint().
-record(field_info,
{ ann :: aeso_syntax:ann()
@ -1648,6 +1650,14 @@ is_first_order(Ts) when is_list(Ts) -> lists:all(fun is_first_order/1, Ts);
is_first_order(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
is_first_order(_) -> true.
ensure_monomorphic(Type, Err) ->
is_monomorphic(Type) orelse type_error(Err).
is_monomorphic({tvar, _, _}) -> false;
is_monomorphic(Ts) when is_list(Ts) -> lists:all(fun is_monomorphic/1, Ts);
is_monomorphic(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
is_monomorphic(_) -> true.
check_state_init(Env) ->
Top = Env#env.namespace,
StateType = lookup_type(Env, {id, [{origin, system}], "state"}),
@ -1822,6 +1832,9 @@ infer_expr(Env, {app, Ann, Fun, Args0} = App) ->
when_warning(warn_negative_spend, fun() -> warn_potential_negative_spend(Ann, NewFun1, NewArgs) end),
[ add_constraint({aens_resolve_type, GeneralResultType})
|| element(3, FunName) =:= ["AENS", "resolve"] ],
[ add_constraint({oracle_type, Ann, OType})
|| OType <- [get_oracle_type(FunName, ArgTypes, GeneralResultType)],
OType =/= false ],
add_constraint(
#dependent_type_constraint{ named_args_t = NamedArgsVar,
named_args = NamedArgs1,
@ -2347,10 +2360,14 @@ destroy_and_report_unsolved_constraints(Env) ->
({add_bytes, _, _, _, _, _}) -> true;
(_) -> false
end, OtherCs3),
{AensResolveCs, []} =
{AensResolveCs, OtherCs5} =
lists:partition(fun({aens_resolve_type, _}) -> true;
(_) -> false
end, OtherCs4),
{OracleTypeCs, []} =
lists:partition(fun({oracle_type, _, _}) -> true;
(_) -> false
end, OtherCs5),
Unsolved = [ S || S <- [ solve_constraint(Env, dereference_deep(C)) || C <- NamedArgCs ],
S == unsolved ],
@ -2369,9 +2386,19 @@ destroy_and_report_unsolved_constraints(Env) ->
check_is_contract_constraints(Env, ContractCs),
check_bytes_constraints(Env, BytesCs),
check_aens_resolve_constraints(Env, AensResolveCs),
check_oracle_type_constraints(Env, OracleTypeCs),
destroy_constraints().
get_oracle_type({qid, _, ["Oracle", "register"]}, _ , OType) -> OType;
get_oracle_type({qid, _, ["Oracle", "query"]}, [OType| _], _ ) -> OType;
get_oracle_type({qid, _, ["Oracle", "get_question"]}, [OType| _], _ ) -> OType;
get_oracle_type({qid, _, ["Oracle", "get_answer"]}, [OType| _], _ ) -> OType;
get_oracle_type({qid, _, ["Oracle", "check"]}, [OType| _], _ ) -> OType;
get_oracle_type({qid, _, ["Oracle", "check_query"]}, [OType| _], _ ) -> OType;
get_oracle_type({qid, _, ["Oracle", "respond"]}, [OType| _], _ ) -> OType;
get_oracle_type(_Fun, _Args, _Ret) -> false.
%% -- Named argument constraints --
%% If false, a type error has been emitted, so it's safe to drop the constraint.
@ -2513,6 +2540,17 @@ check_aens_resolve_constraints(Env, [{aens_resolve_type, Type} | Rest]) ->
end,
check_aens_resolve_constraints(Env, Rest).
check_oracle_type_constraints(_Env, []) ->
ok;
check_oracle_type_constraints(Env, [{oracle_type, Ann, OType} | Rest]) ->
Type = unfold_types_in_type(Env, instantiate(OType)),
{app_t, _, {id, _, "oracle"}, [QType, RType]} = Type,
ensure_monomorphic(QType, {invalid_oracle_type, polymorphic, query, Ann, Type}),
ensure_monomorphic(RType, {invalid_oracle_type, polymorphic, response, Ann, Type}),
ensure_first_order(QType, {invalid_oracle_type, higher_order, query, Ann, Type}),
ensure_first_order(RType, {invalid_oracle_type, higher_order, response, Ann, Type}),
check_oracle_type_constraints(Env, Rest).
%% -- Field constraints --
check_record_create_constraints(_, []) -> ok;
@ -3588,6 +3626,12 @@ mk_error({invalid_aens_resolve_type, Ann, T}) ->
"It must be a `string` or a pubkey type (`address`, `oracle`, etc)",
[pp_type(" `", T)]),
mk_t_err(pos(Ann), Msg);
mk_error({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`", [pp_type(" `", Type)]),
Cxt = io_lib:format("The ~s type must not be ~s", [What, WhyS]),
mk_t_err(pos(Ann), Msg, Cxt);
mk_error(Err) ->
Msg = io_lib:format("Unknown error: ~p", [Err]),
mk_t_err(pos(0, 0), Msg).

32
src/aeso_ast_to_fcode.erl
View File

@ -534,7 +534,7 @@ expr_to_fcode(_Env, _Type, {bytes, _, B}) -> {lit, {bytes, B}};
%% Variables
expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]);
expr_to_fcode(Env, Type, {qid, Ann, X}) ->
expr_to_fcode(Env, Type, {qid, _, X}) ->
case resolve_var(Env, X) of
{builtin_u, B, Ar} when B =:= oracle_query;
B =:= oracle_get_question;
@ -545,7 +545,6 @@ expr_to_fcode(Env, Type, {qid, Ann, X}) ->
B =:= oracle_check_query ->
OType = get_oracle_type(B, Type),
{oracle, QType, RType} = type_to_fcode(Env, OType),
validate_oracle_type(Ann, OType, QType, RType),
TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}],
{builtin_u, B, Ar, TypeArgs};
{builtin_u, B = aens_resolve, Ar} ->
@ -803,35 +802,6 @@ get_oracle_type(oracle_check, {fun_t, _, _, [OType | _], _}) -> OType;
get_oracle_type(oracle_check_query, {fun_t, _, _, [OType | _], _}) -> OType;
get_oracle_type(oracle_respond, {fun_t, _, _, [OType | _], _}) -> OType.
validate_oracle_type(Ann, Type, QType, RType) ->
ensure_monomorphic(QType, {invalid_oracle_type, polymorphic, query, Ann, Type}),
ensure_monomorphic(RType, {invalid_oracle_type, polymorphic, response, Ann, Type}),
ensure_first_order(QType, {invalid_oracle_type, higher_order, query, Ann, Type}),
ensure_first_order(RType, {invalid_oracle_type, higher_order, response, Ann, Type}),
ok.
ensure_monomorphic(Type, Err) ->
case is_monomorphic(Type) of
true -> ok;
false -> fcode_error(Err)
end.
ensure_first_order(Type, Err) ->
case is_first_order(Type) of
true -> ok;
false -> fcode_error(Err)
end.
is_monomorphic({tvar, _}) -> false;
is_monomorphic(Ts) when is_list(Ts) -> lists:all(fun is_monomorphic/1, Ts);
is_monomorphic(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
is_monomorphic(_) -> true.
is_first_order({function, _, _}) -> false;
is_first_order(Ts) when is_list(Ts) -> lists:all(fun is_first_order/1, Ts);
is_first_order(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
is_first_order(_) -> true.
%% -- Pattern matching --
-spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()], aeso_syntax:expr()) -> fsplit().

9
src/aeso_code_errors.erl
View File

@ -10,12 +10,6 @@
-export([format/1, pos/1]).
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", [pp_type(2, Type)]),
Cxt = io_lib:format("The ~s type must not be ~s.", [What, WhyS]),
mk_err(pos(Ann), Msg, Cxt);
format({var_args_not_set, Expr}) ->
mk_err( pos(Expr), "Could not deduce type of variable arguments list"
, "When compiling " ++ pp_expr(Expr)
@ -36,9 +30,6 @@ pp_expr(E) ->
pp_expr(N, E) ->
prettypr:format(prettypr:nest(N, aeso_pretty:expr(E))).
pp_type(N, T) ->
prettypr:format(prettypr:nest(N, aeso_pretty:type(T))).
mk_err(Pos, Msg) ->
aeso_errors:new(code_error, Pos, lists:flatten(Msg)).

50
test/aeso_compiler_tests.erl
View File

@ -45,12 +45,6 @@ simple_compile_test_() ->
check_errors(ExpectedErrors, Errors)
end} ||
{ContractName, ExpectedErrors} <- failing_contracts() ] ++
[ {"Testing code generation error messages of " ++ ContractName,
fun() ->
Errors = compile(ContractName),
check_errors([ExpectedError], Errors)
end} ||
{ContractName, ExpectedError} <- failing_code_gen_contracts()] ++
[ {"Testing include with explicit files",
fun() ->
FileSystem = maps:from_list(
@ -1076,30 +1070,34 @@ failing_contracts() ->
" `list(int)`\n"
"It must be a `string` or a pubkey type (`address`, `oracle`, etc)">>
])
].
-define(Path(File), "code_errors/" ??File).
-define(Msg(File, Line, Col, Err), <<?Pos("Code generation", ?Path(File), Line, Col) Err>>).
-define(FATE_ERR(File, Line, Col, Err), {?Path(File), ?Msg(File, Line, Col, Err)}).
failing_code_gen_contracts() ->
[ ?FATE_ERR(polymorphic_query_type, 3, 5,
, ?TYPE_ERROR(polymorphic_query_type,
[<<?Pos(3,5)
"Invalid oracle type\n"
" oracle('a, 'b)\n"
"The query type must not be polymorphic (contain type variables).")
, ?FATE_ERR(polymorphic_response_type, 3, 5,
" `oracle('a, 'b)`\n"
"The query type must not be polymorphic (contain type variables)">>,
<<?Pos(3,5)
"Invalid oracle type\n"
" oracle(string, 'r)\n"
"The response type must not be polymorphic (contain type variables).")
, ?FATE_ERR(higher_order_query_type, 3, 5,
" `oracle('a, 'b)`\n"
"The response type must not be polymorphic (contain type variables)">>
])
, ?TYPE_ERROR(polymorphic_response_type,
[<<?Pos(3,5)
"Invalid oracle type\n"
" oracle((int) => int, string)\n"
"The query type must not be higher-order (contain function types).")
, ?FATE_ERR(higher_order_response_type, 3, 5,
" `oracle(string, 'r)`\n"
"The response type must not be polymorphic (contain type variables)">>
])
, ?TYPE_ERROR(higher_order_query_type,
[<<?Pos(3,5)
"Invalid oracle type\n"
" oracle(string, (int) => int)\n"
"The response type must not be higher-order (contain function types).")
" `oracle((int) => int, string)`\n"
"The query type must not be higher-order (contain function types)">>
])
, ?TYPE_ERROR(higher_order_response_type,
[<<?Pos(3,5)
"Invalid oracle type\n"
" `oracle(string, (int) => int)`\n"
"The response type must not be higher-order (contain function types)">>
])
].
validation_test_() ->

0
test/contracts/code_errors/higher_order_query_type.aes → test/contracts/higher_order_query_type.aes
View File

0
test/contracts/code_errors/higher_order_response_type.aes → test/contracts/higher_order_response_type.aes
View File

0
test/contracts/code_errors/polymorphic_query_type.aes → test/contracts/polymorphic_query_type.aes
View File

0
test/contracts/code_errors/polymorphic_response_type.aes → test/contracts/polymorphic_response_type.aes
View File