Add fann() to builtin_u
This commit is contained in:
parent
3f129b3b04
commit
2d4e1d7026
@ -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);
|
||||||
|
Loading…
x
Reference in New Issue
Block a user