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

Remove the dependency of type_utils on errors

Browse Source
This commit is contained in:
Gaith Hallak 2023-04-30 13:48:23 +03:00
parent 0dc647f139
commit de4c8f5412
3 changed files with 14 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/aeso_ast_infer_types.erl
View File

@ -89,7 +89,7 @@ when_warning(A, B) -> aeso_tc_options:when_warning(A, B).
%% ------- %% -------
ensure_first_order(A, B) -> aeso_tc_type_utils:ensure_first_order(A, B). is_first_order(A) -> aeso_tc_type_utils:is_first_order(A).
app_t(A, B, C) -> aeso_tc_type_utils:app_t(A, B, C). app_t(A, B, C) -> aeso_tc_type_utils:app_t(A, B, C).
%% ------- %% -------
@ -945,9 +945,9 @@ check_entrypoints(Defs) ->
get_option(allow_higher_order_entrypoints, false) =:= false ]. get_option(allow_higher_order_entrypoints, false) =:= false ].
ensure_first_order_entrypoint({letfun, Ann, Id = {id, _, Name}, Args, Ret, _}) -> ensure_first_order_entrypoint({letfun, Ann, Id = {id, _, Name}, Args, Ret, _}) ->
[ ensure_first_order(ArgType, {higher_order_entrypoint, AnnArg, Id, {argument, ArgId, ArgType}}) [ is_first_order(ArgType) orelse type_error({higher_order_entrypoint, AnnArg, Id, {argument, ArgId, ArgType}})
|| {typed, AnnArg, ArgId, ArgType} <- Args ], || {typed, AnnArg, ArgId, ArgType} <- Args ],
[ ensure_first_order(Ret, {higher_order_entrypoint, Ann, Id, {result, Ret}}) [ is_first_order(Ret) orelse type_error({higher_order_entrypoint, Ann, Id, {result, Ret}})
|| Name /= "init" ], %% init can return higher-order values, since they're written to the store || Name /= "init" ], %% init can return higher-order values, since they're written to the store
%% rather than being returned. %% rather than being returned.
ok. ok.

12
src/aeso_tc_constraints.erl
View File

@ -46,8 +46,8 @@ type_error(A) -> aeso_tc_errors:type_error(A).
%% ------- %% -------
ensure_monomorphic(A, B) -> aeso_tc_type_utils:ensure_monomorphic(A, B). is_monomorphic(A) -> aeso_tc_type_utils:is_monomorphic(A).
ensure_first_order(A, B) -> aeso_tc_type_utils:ensure_first_order(A, B). is_first_order(A) -> aeso_tc_type_utils:is_first_order(A).
app_t(A, B, C) -> aeso_tc_type_utils:app_t(A, B, C). app_t(A, B, C) -> aeso_tc_type_utils:app_t(A, B, C).
%% ------- %% -------
@ -432,10 +432,10 @@ check_oracle_type_constraints(_Env, []) ->
check_oracle_type_constraints(Env, [{oracle_type, Ann, OType} | Rest]) -> check_oracle_type_constraints(Env, [{oracle_type, Ann, OType} | Rest]) ->
Type = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(OType)), Type = unfold_types_in_type(Env, aeso_tc_type_utils:instantiate(OType)),
{app_t, _, {id, _, "oracle"}, [QType, RType]} = Type, {app_t, _, {id, _, "oracle"}, [QType, RType]} = Type,
ensure_monomorphic(QType, {invalid_oracle_type, polymorphic, query, Ann, Type}), is_monomorphic(QType) orelse type_error({invalid_oracle_type, polymorphic, query, Ann, Type}),
ensure_monomorphic(RType, {invalid_oracle_type, polymorphic, response, Ann, Type}), is_monomorphic(RType) orelse type_error({invalid_oracle_type, polymorphic, response, Ann, Type}),
ensure_first_order(QType, {invalid_oracle_type, higher_order, query, Ann, Type}), is_first_order(QType) orelse type_error({invalid_oracle_type, higher_order, query, Ann, Type}),
ensure_first_order(RType, {invalid_oracle_type, higher_order, response, Ann, Type}), is_first_order(RType) orelse type_error({invalid_oracle_type, higher_order, response, Ann, Type}),
check_oracle_type_constraints(Env, Rest). check_oracle_type_constraints(Env, Rest).
%% -- Field constraints -- %% -- Field constraints --

16
src/aeso_tc_type_utils.erl
View File

@ -5,15 +5,12 @@
, instantiate/1 , instantiate/1
, typesig_to_fun_t/1 , typesig_to_fun_t/1
, fun_arity/1 , fun_arity/1
, ensure_first_order/2
, ensure_monomorphic/2
, opposite_variance/1 , opposite_variance/1
, app_t/3 , app_t/3
, is_first_order/1
, is_monomorphic/1
]). ]).
typesig_to_fun_t({type_sig, Ann, _Constr, Named, Args, Res}) ->
{fun_t, Ann, Named, Args, Res}.
dereference(T = {uvar, _, R}) -> dereference(T = {uvar, _, R}) ->
case aeso_tc_ets_manager:ets_lookup(type_vars, R) of case aeso_tc_ets_manager:ets_lookup(type_vars, R) of
[] -> [] ->
@ -67,17 +64,11 @@ integer_to_tvar(X) ->
fun_arity({fun_t, _, _, Args, _}) -> length(Args); fun_arity({fun_t, _, _, Args, _}) -> length(Args);
fun_arity(_) -> none. fun_arity(_) -> none.
ensure_monomorphic(Type, Err) ->
is_monomorphic(Type) orelse aeso_tc_errors:type_error(Err).
is_monomorphic({tvar, _, _}) -> false; is_monomorphic({tvar, _, _}) -> false;
is_monomorphic(Ts) when is_list(Ts) -> lists:all(fun is_monomorphic/1, Ts); 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(Tup) when is_tuple(Tup) -> is_monomorphic(tuple_to_list(Tup));
is_monomorphic(_) -> true. is_monomorphic(_) -> true.
ensure_first_order(Type, Err) ->
is_first_order(Type) orelse aeso_tc_errors:type_error(Err).
is_first_order({fun_t, _, _, _, _}) -> false; is_first_order({fun_t, _, _, _, _}) -> false;
is_first_order(Ts) when is_list(Ts) -> lists:all(fun is_first_order/1, Ts); 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(Tup) when is_tuple(Tup) -> is_first_order(tuple_to_list(Tup));
@ -90,3 +81,6 @@ opposite_variance(bivariant) -> bivariant.
app_t(_Ann, Name, []) -> Name; app_t(_Ann, Name, []) -> Name;
app_t(Ann, Name, Args) -> {app_t, Ann, Name, Args}. app_t(Ann, Name, Args) -> {app_t, Ann, Name, Args}.
typesig_to_fun_t({type_sig, Ann, _Constr, Named, Args, Res}) ->
{fun_t, Ann, Named, Args, Res}.