Add fann() to builtin_u

This commit is contained in:
Gaith Hallak 2022-11-05 14:22:11 +03:00
parent 3f129b3b04
commit 2d4e1d7026

View File

@ -82,8 +82,8 @@
%% to closures by the lambda lifter. %% to closures by the lambda lifter.
| {def_u, fann(), fun_name(), arity()} | {def_u, fann(), fun_name(), arity()}
| {remote_u, fann(), [ftype()], ftype(), fexpr(), fun_name()} | {remote_u, fann(), [ftype()], ftype(), fexpr(), fun_name()}
| {builtin_u, builtin(), arity()} | {builtin_u, fann(), builtin(), arity()}
| {builtin_u, builtin(), arity(), [fexpr()]} %% Typerep arguments to be added after normal args. | {builtin_u, fann(), builtin(), arity(), [fexpr()]} %% Typerep arguments to be added after normal args.
| {lam, fann(), [var_name()], fexpr()}. | {lam, fann(), [var_name()], fexpr()}.
-type fsplit() :: {split, ftype(), var_name(), [fcase()]} -type fsplit() :: {split, ftype(), var_name(), [fcase()]}
@ -557,25 +557,25 @@ expr_to_fcode(_Env, _Type, {bytes, _, B}) -> {lit, {bytes, B}};
expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]); expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]);
expr_to_fcode(Env, Type, {qid, _, X}) -> expr_to_fcode(Env, Type, {qid, _, X}) ->
case resolve_var(Env, X) of case resolve_var(Env, X) of
{builtin_u, B, Ar} when B =:= oracle_query; {builtin_u, Ann, B, Ar} when B =:= oracle_query;
B =:= oracle_get_question; B =:= oracle_get_question;
B =:= oracle_get_answer; B =:= oracle_get_answer;
B =:= oracle_respond; B =:= oracle_respond;
B =:= oracle_register; B =:= oracle_register;
B =:= oracle_check; B =:= oracle_check;
B =:= oracle_check_query -> B =:= oracle_check_query ->
OType = get_oracle_type(B, Type), OType = get_oracle_type(B, Type),
{oracle, QType, RType} = type_to_fcode(Env, OType), {oracle, QType, RType} = type_to_fcode(Env, OType),
TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}], TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}],
{builtin_u, B, Ar, TypeArgs}; {builtin_u, Ann, B, Ar, TypeArgs};
{builtin_u, B = aens_resolve, Ar} -> {builtin_u, Ann, B = aens_resolve, Ar} ->
{fun_t, _, _, _, ResType} = Type, {fun_t, _, _, _, ResType} = Type,
AensType = type_to_fcode(Env, ResType), AensType = type_to_fcode(Env, ResType),
TypeArgs = [{lit, {typerep, AensType}}], TypeArgs = [{lit, {typerep, AensType}}],
{builtin_u, B, Ar, TypeArgs}; {builtin_u, Ann, B, Ar, TypeArgs};
{builtin_u, B = bytes_split, Ar} -> {builtin_u, Ann, B = bytes_split, Ar} ->
{fun_t, _, _, _, {tuple_t, _, [{bytes_t, _, N}, _]}} = Type, {fun_t, _, _, _, {tuple_t, _, [{bytes_t, _, N}, _]}} = Type,
{builtin_u, B, Ar, [{lit, {int, N}}]}; {builtin_u, Ann, B, Ar, [{lit, {int, N}}]};
Other -> Other Other -> Other
end; end;
@ -720,8 +720,8 @@ expr_to_fcode(Env, _, {app, _, Fun = {typed, Ann, FunE, {fun_t, _, NamedArgsT, A
Args1 = get_named_args(NamedArgsT, Args), Args1 = get_named_args(NamedArgsT, Args),
FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1], FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1],
case expr_to_fcode(Env, Fun) of case expr_to_fcode(Env, Fun) of
{builtin_u, B, _Ar, TypeArgs} -> builtin_to_fcode(state_layout(Env), B, FArgs ++ TypeArgs); {builtin_u, Ann, B, _Ar, TypeArgs} -> builtin_to_fcode(state_layout(Env), B, FArgs ++ TypeArgs);
{builtin_u, chain_clone, _Ar} -> {builtin_u, Ann, chain_clone, _Ar} ->
case ArgsT of case ArgsT of
var_args -> fcode_error({var_args_not_set, FunE}); var_args -> fcode_error({var_args_not_set, FunE});
_ -> _ ->
@ -730,7 +730,7 @@ expr_to_fcode(Env, _, {app, _, Fun = {typed, Ann, FunE, {fun_t, _, NamedArgsT, A
FInitArgsT = aeb_fate_data:make_typerep([type_to_fcode(Env, T) || T <- ArgsT]), FInitArgsT = aeb_fate_data:make_typerep([type_to_fcode(Env, T) || T <- ArgsT]),
builtin_to_fcode(state_layout(Env), chain_clone, [{lit, FInitArgsT}|FArgs]) builtin_to_fcode(state_layout(Env), chain_clone, [{lit, FInitArgsT}|FArgs])
end; end;
{builtin_u, chain_create, _Ar} -> {builtin_u, Ann, chain_create, _Ar} ->
case {ArgsT, Type} of case {ArgsT, Type} of
{var_args, _} -> fcode_error({var_args_not_set, FunE}); {var_args, _} -> fcode_error({var_args_not_set, FunE});
{_, {con, _, Contract}} -> {_, {con, _, Contract}} ->
@ -738,8 +738,8 @@ expr_to_fcode(Env, _, {app, _, Fun = {typed, Ann, FunE, {fun_t, _, NamedArgsT, A
builtin_to_fcode(state_layout(Env), chain_create, [{lit, {contract_code, Contract}}, {lit, FInitArgsT}|FArgs]); builtin_to_fcode(state_layout(Env), chain_create, [{lit, {contract_code, Contract}}, {lit, FInitArgsT}|FArgs]);
{_, _} -> fcode_error({not_a_contract_type, Type}) {_, _} -> fcode_error({not_a_contract_type, Type})
end; end;
{builtin_u, B, _Ar} -> builtin_to_fcode(state_layout(Env), B, FArgs); {builtin_u, Ann, B, _Ar} -> builtin_to_fcode(state_layout(Env), B, FArgs);
{def_u, Ann, F, _Ar} -> {def, Ann, F, FArgs}; {def_u, Ann, F, _Ar} -> {def, Ann, F, FArgs};
{remote_u, Ann, RArgsT, RRetT, Ct, RFun} -> {remote, Ann, RArgsT, RRetT, Ct, RFun, FArgs}; {remote_u, Ann, RArgsT, RRetT, Ct, RFun} -> {remote, Ann, RArgsT, RRetT, Ct, RFun, FArgs};
FFun -> FFun ->
%% FFun is a closure, with first component the function name and %% FFun is a closure, with first component the function name and
@ -1265,8 +1265,8 @@ lambda_lift_expr(Layout, L = {lam, _, Xs, Body}) ->
lambda_lift_expr(Layout, UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u -> lambda_lift_expr(Layout, UExpr) when element(1, UExpr) == def_u; element(1, UExpr) == builtin_u ->
[Tag, _, F, Ar | _] = tuple_to_list(UExpr), [Tag, _, F, Ar | _] = tuple_to_list(UExpr),
ExtraArgs = case UExpr of ExtraArgs = case UExpr of
{builtin_u, _, _, TypeArgs} -> TypeArgs; {builtin_u, _, _, _, TypeArgs} -> TypeArgs;
_ -> [] _ -> []
end, end,
Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ], Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ],
Args = [{var, X} || X <- Xs] ++ ExtraArgs, Args = [{var, X} || X <- Xs] ++ ExtraArgs,
@ -1609,8 +1609,8 @@ read_only({get_state, _}) -> true;
read_only({set_state, _, _, _}) -> false; read_only({set_state, _, _, _}) -> false;
read_only({def_u, _, _, _}) -> true; read_only({def_u, _, _, _}) -> true;
read_only({remote_u, _, _, _, _, _}) -> true; read_only({remote_u, _, _, _, _, _}) -> true;
read_only({builtin_u, _, _}) -> true;
read_only({builtin_u, _, _, _}) -> true; read_only({builtin_u, _, _, _}) -> true;
read_only({builtin_u, _, _, _, _}) -> true;
read_only({lam, _, _, _}) -> true; read_only({lam, _, _, _}) -> true;
read_only({def, _, _, _}) -> false; %% TODO: purity analysis read_only({def, _, _, _}) -> false; %% TODO: purity analysis
read_only({remote, _, _, _, _, _, _}) -> false; read_only({remote, _, _, _, _, _, _}) -> false;
@ -1767,7 +1767,7 @@ resolve_fun(#{ fun_env := Funs, builtins := Builtin } = Env, 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} -> internal_error({unbound_variable, Q}); {not_found, not_found} -> internal_error({unbound_variable, Q});
{_, {B, none}} -> builtin_to_fcode(state_layout(Env), B, []); {_, {B, none}} -> builtin_to_fcode(state_layout(Env), 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}
end. end.
@ -1832,62 +1832,62 @@ free_vars(Xs) when is_list(Xs) ->
lists:umerge([ free_vars(X) || X <- Xs ]); lists:umerge([ free_vars(X) || X <- Xs ]);
free_vars(Expr) -> free_vars(Expr) ->
case Expr of case Expr of
{var, X} -> [X]; {var, X} -> [X];
{lit, _} -> []; {lit, _} -> [];
nil -> []; nil -> [];
{def, _, _, As} -> free_vars(As); {def, _, _, As} -> free_vars(As);
{def_u, _, _, _} -> []; {def_u, _, _, _} -> [];
{remote, _, _, _, Ct, _, As} -> free_vars([Ct | As]); {remote, _, _, _, Ct, _, As} -> free_vars([Ct | As]);
{remote_u, _, _, _, Ct, _} -> free_vars(Ct); {remote_u, _, _, _, Ct, _} -> free_vars(Ct);
{builtin, _, As} -> free_vars(As); {builtin, _, As} -> free_vars(As);
{builtin_u, _, _} -> []; {builtin_u, _, _, _} -> [];
{builtin_u, _, _, _} -> []; %% Typereps are always literals {builtin_u, _, _, _, _} -> []; %% Typereps are always literals
{con, _, _, As} -> free_vars(As); {con, _, _, As} -> free_vars(As);
{tuple, As} -> free_vars(As); {tuple, As} -> free_vars(As);
{proj, _, A, _} -> free_vars(A); {proj, _, A, _} -> free_vars(A);
{set_proj, _, A, _, B} -> free_vars([A, B]); {set_proj, _, A, _, B} -> free_vars([A, B]);
{op, _, _, As} -> free_vars(As); {op, _, _, As} -> free_vars(As);
{'let', Ann, X, A, B} -> free_vars([A, {lam, Ann, [X], B}]); {'let', Ann, X, A, B} -> free_vars([A, {lam, Ann, [X], B}]);
{funcall, _, A, Bs} -> free_vars([A | Bs]); {funcall, _, A, Bs} -> free_vars([A | Bs]);
{set_state, _, _, A} -> free_vars(A); {set_state, _, _, A} -> free_vars(A);
{get_state, _} -> []; {get_state, _} -> [];
{lam, _, Xs, B} -> free_vars(B) -- lists:sort(Xs); {lam, _, Xs, B} -> free_vars(B) -- lists:sort(Xs);
{closure, _, _, A} -> free_vars(A); {closure, _, _, A} -> free_vars(A);
{switch, A} -> free_vars(A); {switch, A} -> free_vars(A);
{split, _, X, As} -> free_vars([{var, X} | As]); {split, _, X, As} -> free_vars([{var, X} | As]);
{nosplit, A} -> free_vars(A); {nosplit, A} -> free_vars(A);
{'case', P, A} -> free_vars(A) -- lists:sort(fsplit_pat_vars(P)) {'case', P, A} -> free_vars(A) -- lists:sort(fsplit_pat_vars(P))
end. end.
used_defs(Xs) when is_list(Xs) -> used_defs(Xs) when is_list(Xs) ->
lists:umerge([ used_defs(X) || X <- Xs ]); lists:umerge([ used_defs(X) || X <- Xs ]);
used_defs(Expr) -> used_defs(Expr) ->
case Expr of case Expr of
{var, _} -> []; {var, _} -> [];
{lit, _} -> []; {lit, _} -> [];
nil -> []; nil -> [];
{def, _, F, As} -> lists:umerge([F], used_defs(As)); {def, _, F, As} -> lists:umerge([F], used_defs(As));
{def_u, _, F, _} -> [F]; {def_u, _, F, _} -> [F];
{remote, _, _, _, Ct, _, As} -> used_defs([Ct | As]); {remote, _, _, _, Ct, _, As} -> used_defs([Ct | As]);
{remote_u, _, _, _, Ct, _} -> used_defs(Ct); {remote_u, _, _, _, Ct, _} -> used_defs(Ct);
{builtin, _, As} -> used_defs(As); {builtin, _, As} -> used_defs(As);
{builtin_u, _, _} -> []; {builtin_u, _, _, _} -> [];
{builtin_u, _, _, _} -> []; {builtin_u, _, _, _, _} -> [];
{con, _, _, As} -> used_defs(As); {con, _, _, As} -> used_defs(As);
{tuple, As} -> used_defs(As); {tuple, As} -> used_defs(As);
{proj, _, A, _} -> used_defs(A); {proj, _, A, _} -> used_defs(A);
{set_proj, _, A, _, B} -> used_defs([A, B]); {set_proj, _, A, _, B} -> used_defs([A, B]);
{op, _, _, As} -> used_defs(As); {op, _, _, As} -> used_defs(As);
{'let', _, _, A, B} -> used_defs([A, B]); {'let', _, _, A, B} -> used_defs([A, B]);
{funcall, _, A, Bs} -> used_defs([A | Bs]); {funcall, _, A, Bs} -> used_defs([A | Bs]);
{set_state, _, _, A} -> used_defs(A); {set_state, _, _, A} -> used_defs(A);
{get_state, _} -> []; {get_state, _} -> [];
{lam, _, _, B} -> used_defs(B); {lam, _, _, B} -> used_defs(B);
{closure, _, F, A} -> lists:umerge([F], used_defs(A)); {closure, _, F, A} -> lists:umerge([F], used_defs(A));
{switch, A} -> used_defs(A); {switch, A} -> used_defs(A);
{split, _, _, As} -> used_defs(As); {split, _, _, As} -> used_defs(As);
{nosplit, A} -> used_defs(A); {nosplit, A} -> used_defs(A);
{'case', _, A} -> used_defs(A) {'case', _, A} -> used_defs(A)
end. end.
bottom_up(F, Expr) -> bottom_up(F, #{}, Expr). bottom_up(F, Expr) -> bottom_up(F, #{}, Expr).
@ -1900,8 +1900,8 @@ bottom_up(F, Env, Expr) ->
{def, Ann, D, Es} -> {def, Ann, D, [bottom_up(F, Env, E) || E <- Es]}; {def, Ann, D, Es} -> {def, Ann, D, [bottom_up(F, Env, E) || E <- Es]};
{def_u, _, _, _} -> Expr; {def_u, _, _, _} -> Expr;
{builtin, B, Es} -> {builtin, B, [bottom_up(F, Env, E) || E <- Es]}; {builtin, B, Es} -> {builtin, B, [bottom_up(F, Env, E) || E <- Es]};
{builtin_u, _, _} -> Expr;
{builtin_u, _, _, _} -> Expr; {builtin_u, _, _, _} -> Expr;
{builtin_u, _, _, _, _} -> Expr;
{remote, Ann, ArgsT, RetT, Ct, Fun, Es} -> {remote, Ann, ArgsT, RetT, bottom_up(F, Env, Ct), Fun, [bottom_up(F, Env, E) || E <- Es]}; {remote, Ann, ArgsT, RetT, Ct, Fun, Es} -> {remote, Ann, ArgsT, RetT, bottom_up(F, Env, Ct), Fun, [bottom_up(F, Env, E) || E <- Es]};
{remote_u, Ann, ArgsT, RetT, Ct, Fun} -> {remote_u, Ann, ArgsT, RetT, bottom_up(F, Env, Ct), Fun}; {remote_u, Ann, ArgsT, RetT, Ct, Fun} -> {remote_u, Ann, ArgsT, RetT, bottom_up(F, Env, Ct), Fun};
{con, Ar, I, Es} -> {con, Ar, I, [bottom_up(F, Env, E) || E <- Es]}; {con, Ar, I, Es} -> {con, Ar, I, [bottom_up(F, Env, E) || E <- Es]};
@ -1958,8 +1958,8 @@ rename(Ren, Expr) ->
{def, Ann, D, Es} -> {def, Ann, D, [rename(Ren, E) || E <- Es]}; {def, Ann, D, Es} -> {def, Ann, D, [rename(Ren, E) || E <- Es]};
{def_u, _, _, _} -> Expr; {def_u, _, _, _} -> Expr;
{builtin, B, Es} -> {builtin, B, [rename(Ren, E) || E <- Es]}; {builtin, B, Es} -> {builtin, B, [rename(Ren, E) || E <- Es]};
{builtin_u, _, _} -> Expr;
{builtin_u, _, _, _} -> Expr; {builtin_u, _, _, _} -> Expr;
{builtin_u, _, _, _, _} -> Expr;
{remote, Ann, ArgsT, RetT, Ct, F, Es} -> {remote, Ann, ArgsT, RetT, rename(Ren, Ct), F, [rename(Ren, E) || E <- Es]}; {remote, Ann, ArgsT, RetT, Ct, F, Es} -> {remote, Ann, ArgsT, RetT, rename(Ren, Ct), F, [rename(Ren, E) || E <- Es]};
{remote_u, Ann, ArgsT, RetT, Ct, F} -> {remote_u, Ann, ArgsT, RetT, rename(Ren, Ct), F}; {remote_u, Ann, ArgsT, RetT, Ct, F} -> {remote_u, Ann, ArgsT, RetT, rename(Ren, Ct), F};
{con, Ar, I, Es} -> {con, Ar, I, [rename(Ren, E) || E <- Es]}; {con, Ar, I, Es} -> {con, Ar, I, [rename(Ren, E) || E <- Es]};
@ -2203,9 +2203,9 @@ pp_fexpr({'let', _, _, _, _} = Expr) ->
pp_above([ pp_par([pp_text(X), pp_text("="), prettypr:nest(2, pp_fexpr(A))]) || {X, A} <- Ls ]), pp_above([ pp_par([pp_text(X), pp_text("="), prettypr:nest(2, pp_fexpr(A))]) || {X, A} <- Ls ]),
pp_text(" in ") ]), pp_text(" in ") ]),
pp_fexpr(Body) ])); pp_fexpr(Body) ]));
pp_fexpr({builtin_u, B, N}) -> pp_fexpr({builtin_u, _, B, N}) ->
pp_beside([pp_text(B), pp_text("/"), pp_text(N)]); pp_beside([pp_text(B), pp_text("/"), pp_text(N)]);
pp_fexpr({builtin_u, B, N, TypeArgs}) -> pp_fexpr({builtin_u, _, B, N, TypeArgs}) ->
pp_beside([pp_text(B), pp_text("@"), pp_fexpr({tuple, TypeArgs}), pp_text("/"), pp_text(N)]); pp_beside([pp_text(B), pp_text("@"), pp_fexpr({tuple, TypeArgs}), pp_text("/"), pp_text(N)]);
pp_fexpr({builtin, B, As}) -> pp_fexpr({builtin, B, As}) ->
pp_call(pp_text(B), As); pp_call(pp_text(B), As);