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

Add fann() to lit and get_state

Browse Source
This commit is contained in:
Gaith Hallak 2022-11-09 14:28:27 +03:00
parent d11f3107a4
commit 7abf93e0e0
1 changed files with 68 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

122
src/aeso_ast_to_fcode.erl
View File

@ -60,7 +60,7 @@
-type fann() :: [ {line, aeso_syntax:ann_line()} ].
-type fexpr() :: {lit, flit()}
-type fexpr() :: {lit, fann(), flit()}
| nil
| {var, fann(), var_name()}
| {def, fann(), fun_name(), [fexpr()]}
@ -76,7 +76,7 @@
| {closure, fann(), fun_name(), fexpr()}
| {switch, fann(), fsplit()}
| {set_state, fann(), state_reg(), fexpr()}
| {get_state, state_reg()}
| {get_state, fann(), state_reg()}
%% The following (unapplied top-level functions/builtins and
%% lambdas) are generated by the fcode compiler, but translated
%% to closures by the lambda lifter.
@ -534,8 +534,8 @@ args_to_fcode(Env, Args) ->
make_let(Expr, Body) ->
case Expr of
{var, _, _} -> Body(Expr);
{lit, {int, _}} -> Body(Expr);
{lit, {bool, _}} -> Body(Expr);
{lit, _, {int, _}} -> Body(Expr);
{lit, _, {bool, _}} -> Body(Expr);
_ ->
X = fresh_name(),
FAnn = get_fann(Expr),
@ -560,21 +560,21 @@ expr_to_fcode(Env, Expr) ->
-spec expr_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:expr()) -> fexpr().
%% Literals
expr_to_fcode(_Env, _Type, {int, _, N}) -> {lit, {int, N}};
expr_to_fcode(_Env, _Type, {char, _, N}) -> {lit, {int, N}};
expr_to_fcode(_Env, _Type, {bool, _, B}) -> {lit, {bool, B}};
expr_to_fcode(_Env, _Type, {string, _, S}) -> {lit, {string, S}};
expr_to_fcode(_Env, _Type, {account_pubkey, _, K}) -> {lit, {account_pubkey, K}};
expr_to_fcode(_Env, _Type, {contract_pubkey, _, K}) -> {lit, {contract_pubkey, K}};
expr_to_fcode(_Env, _Type, {oracle_pubkey, _, K}) -> {lit, {oracle_pubkey, K}};
expr_to_fcode(_Env, _Type, {oracle_query_id, _, K}) -> {lit, {oracle_query_id, K}};
expr_to_fcode(_Env, _Type, {bytes, _, B}) -> {lit, {bytes, B}};
expr_to_fcode(_Env, _Type, {int, Ann, N}) -> {lit, to_fann(Ann), {int, N}};
expr_to_fcode(_Env, _Type, {char, Ann, N}) -> {lit, to_fann(Ann), {int, N}};
expr_to_fcode(_Env, _Type, {bool, Ann, B}) -> {lit, to_fann(Ann), {bool, B}};
expr_to_fcode(_Env, _Type, {string, Ann, S}) -> {lit, to_fann(Ann), {string, S}};
expr_to_fcode(_Env, _Type, {account_pubkey, Ann, K}) -> {lit, to_fann(Ann), {account_pubkey, K}};
expr_to_fcode(_Env, _Type, {contract_pubkey, Ann, K}) -> {lit, to_fann(Ann), {contract_pubkey, K}};
expr_to_fcode(_Env, _Type, {oracle_pubkey, Ann, K}) -> {lit, to_fann(Ann), {oracle_pubkey, K}};
expr_to_fcode(_Env, _Type, {oracle_query_id, Ann, K}) -> {lit, to_fann(Ann), {oracle_query_id, K}};
expr_to_fcode(_Env, _Type, {bytes, Ann, B}) -> {lit, to_fann(Ann), {bytes, B}};
%% Variables
expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]);
expr_to_fcode(Env, Type, {qid, _, X}) ->
case resolve_var(Env, X) of
{builtin_u, Ann, B, Ar} when B =:= oracle_query;
{builtin_u, FAnn, B, Ar} when B =:= oracle_query;
B =:= oracle_get_question;
B =:= oracle_get_answer;
B =:= oracle_respond;
@ -583,16 +583,16 @@ expr_to_fcode(Env, Type, {qid, _, X}) ->
B =:= oracle_check_query ->
OType = get_oracle_type(B, Type),
{oracle, QType, RType} = type_to_fcode(Env, OType),
TypeArgs = [{lit, {typerep, QType}}, {lit, {typerep, RType}}],
{builtin_u, Ann, B, Ar, TypeArgs};
{builtin_u, Ann, B = aens_resolve, Ar} ->
TypeArgs = [{lit, FAnn, {typerep, QType}}, {lit, FAnn, {typerep, RType}}],
{builtin_u, FAnn, B, Ar, TypeArgs};
{builtin_u, FAnn, B = aens_resolve, Ar} ->
{fun_t, _, _, _, ResType} = Type,
AensType = type_to_fcode(Env, ResType),
TypeArgs = [{lit, {typerep, AensType}}],
{builtin_u, Ann, B, Ar, TypeArgs};
{builtin_u, Ann, B = bytes_split, Ar} ->
TypeArgs = [{lit, FAnn, {typerep, AensType}}],
{builtin_u, FAnn, B, Ar, TypeArgs};
{builtin_u, FAnn, B = bytes_split, Ar} ->
{fun_t, _, _, _, {tuple_t, _, [{bytes_t, _, N}, _]}} = Type,
{builtin_u, Ann, B, Ar, [{lit, {int, N}}]};
{builtin_u, FAnn, B, Ar, [{lit, FAnn, {int, N}}]};
Other -> Other
end;
@ -728,7 +728,7 @@ expr_to_fcode(Env, Type, {app, Ann, {Op, _}, [A, B]}) when is_atom(Op) ->
expr_to_fcode(Env, _Type, {app, Ann, {Op, _}, [A]}) when is_atom(Op) ->
FAnn = to_fann(Ann),
case Op of
'-' -> {op, FAnn, '-', [{lit, {int, 0}}, expr_to_fcode(Env, A)]};
'-' -> {op, FAnn, '-', [{lit, FAnn, {int, 0}}, expr_to_fcode(Env, A)]};
'!' -> {op, FAnn, '!', [expr_to_fcode(Env, A)]}
end;
@ -737,27 +737,27 @@ expr_to_fcode(Env, _, {app, _, Fun = {typed, Ann, FunE, {fun_t, _, NamedArgsT, A
Args1 = get_named_args(NamedArgsT, Args),
FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1],
case expr_to_fcode(Env, Fun) of
{builtin_u, Ann, B, _Ar, TypeArgs} -> builtin_to_fcode(state_layout(Env), B, FArgs ++ TypeArgs);
{builtin_u, Ann, chain_clone, _Ar} ->
{builtin_u, _, B, _Ar, TypeArgs} -> builtin_to_fcode(state_layout(Env), B, FArgs ++ TypeArgs);
{builtin_u, FAnn, chain_clone, _Ar} ->
case ArgsT of
var_args -> fcode_error({var_args_not_set, FunE});
_ ->
%% Here we little cheat on the typechecker, but this inconsistency
%% is to be solved in `aeso_fcode_to_fate:type_to_scode/1`
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, FAnn, FInitArgsT}|FArgs])
end;
{builtin_u, Ann, chain_create, _Ar} ->
{builtin_u, FAnn, chain_create, _Ar} ->
case {ArgsT, Type} of
{var_args, _} -> fcode_error({var_args_not_set, FunE});
{_, {con, _, Contract}} ->
FInitArgsT = aeb_fate_data:make_typerep([type_to_fcode(Env, T) || T <- ArgsT]),
builtin_to_fcode(state_layout(Env), chain_create, [{lit, {contract_code, Contract}}, {lit, FInitArgsT}|FArgs]);
builtin_to_fcode(state_layout(Env), chain_create, [{lit, FAnn, {contract_code, Contract}}, {lit, FAnn, FInitArgsT}|FArgs]);
{_, _} -> fcode_error({not_a_contract_type, Type})
end;
{builtin_u, Ann, B, _Ar} -> builtin_to_fcode(state_layout(Env), B, FArgs);
{def_u, Ann, F, _Ar} -> {def, Ann, F, FArgs};
{remote_u, Ann, RArgsT, RRetT, Ct, RFun} -> {remote, Ann, RArgsT, RRetT, Ct, RFun, FArgs};
{builtin_u, _, B, _Ar} -> builtin_to_fcode(state_layout(Env), B, FArgs);
{def_u, FAnn, F, _Ar} -> {def, FAnn, F, FArgs};
{remote_u, FAnn, RArgsT, RRetT, Ct, RFun} -> {remote, FAnn, RArgsT, RRetT, Ct, RFun, FArgs};
FFun ->
%% FFun is a closure, with first component the function name and
%% second component the environment
@ -1108,8 +1108,8 @@ expr_to_decision_tree(Env, Expr) ->
{atom, expr_to_fcode(Env, Expr)}.
-spec decision_tree_to_fcode(decision_tree()) -> fexpr().
decision_tree_to_fcode(false) -> {lit, {bool, false}};
decision_tree_to_fcode(true) -> {lit, {bool, true}};
decision_tree_to_fcode(false) -> {lit, [], {bool, false}};
decision_tree_to_fcode(true) -> {lit, [], {bool, true}};
decision_tree_to_fcode({atom, B}) -> B;
decision_tree_to_fcode({'if', A, Then, Else}) ->
X = fresh_name(),
@ -1170,7 +1170,7 @@ set_state({tuple, Ls}, Val) ->
-spec get_state(state_layout()) -> fexpr().
get_state({reg, R}) ->
{get_state, R};
{get_state, [], R};
get_state({tuple, Ls}) ->
{tuple, [get_state(L) || L <- Ls]}.
@ -1247,12 +1247,12 @@ event_function(_Env = #{event_type := {variant_t, EventCons}}, EventType = {vari
Arities = [length(Ts) || Ts <- FCons],
Case = fun({Name, Tag, Ixs}) ->
{ok, HashValue} = eblake2:blake2b(?HASH_BYTES, list_to_binary(Name)),
Hash = {lit, {bytes, HashValue}},
Hash = {lit, [], {bytes, HashValue}},
Vars = [ "arg" ++ integer_to_list(I) || I <- lists:seq(1, length(Ixs)) ],
IVars = lists:zip(Ixs, Vars),
Payload =
case [ V || {notindexed, V} <- IVars ] of
[] -> {lit, {string, <<>>}};
[] -> {lit, [], {string, <<>>}};
[V] -> {var, [], V}
end,
Indices = [ {var, [], V} || {indexed, V} <- IVars ],
@ -1345,7 +1345,7 @@ lambda_lift_expr(Layout, {remote_u, Ann, ArgsT, RetT, Ct, F}) ->
make_closure(FVs, Xs, {remote, Ann, ArgsT, RetT, Ct1, F, Args});
lambda_lift_expr(Layout, Expr) ->
case Expr of
{lit, _} -> Expr;
{lit, _, _} -> Expr;
nil -> Expr;
{var, _, _} -> Expr;
{closure, _, _, _} -> Expr;
@ -1360,7 +1360,7 @@ lambda_lift_expr(Layout, Expr) ->
{'let', Ann, X, A, B} -> {'let', Ann, X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)};
{funcall, Ann, A, Bs} -> {funcall, Ann, lambda_lift_expr(Layout, A), lambda_lift_exprs(Layout, Bs)};
{set_state, Ann, R, A} -> {set_state, Ann, R, lambda_lift_expr(Layout, A)};
{get_state, _} -> Expr;
{get_state, _, _} -> Expr;
{switch, Ann, S} -> {switch, Ann, lambda_lift_expr(Layout, S)};
{split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Layout, Alts)};
{nosplit, A} -> {nosplit, lambda_lift_expr(Layout, A)};
@ -1442,7 +1442,7 @@ make_lets(Es, Body) -> make_lets(Es, [], Body).
make_lets([], Xs, Body) -> Body(lists:reverse(Xs));
make_lets([{var, _, _} = E | Es], Xs, Body) ->
make_lets(Es, [E | Xs], Body);
make_lets([{lit, _} = E | Es], Xs, Body) ->
make_lets([{lit, _, _} = E | Es], Xs, Body) ->
make_lets(Es, [E | Xs], Body);
make_lets([E | Es], Xs, Body) ->
?make_let(X, E, make_lets(Es, [X | Xs], Body)).
@ -1547,9 +1547,9 @@ simplify(Env, {proj, _, Var = {var, _, _}, I} = Expr) ->
E -> E
end;
simplify(Env, {switch, _, Split}) ->
simplify(Env, {switch, FAnn, Split}) ->
case simpl_switch(Env, [], Split) of
nomatch -> {builtin, abort, [{lit, {string, <<"Incomplete patterns">>}}]};
nomatch -> {builtin, abort, [{lit, FAnn, {string, <<"Incomplete patterns">>}}]};
Expr -> Expr
end;
@ -1625,7 +1625,7 @@ simpl_case(Env, E, [{'case', Pat, Body} | Alts]) ->
-spec match_pat(fsplit_pat(), fexpr()) -> false | [{var_name(), fexpr()}].
match_pat({tuple, Xs}, {tuple, Es}) -> lists:zip(Xs, Es);
match_pat({con, _, C, Xs}, {con, _, C, Es}) -> lists:zip(Xs, Es);
match_pat(L, {lit, L}) -> [];
match_pat(L, {lit, _, L}) -> [];
match_pat(nil, nil) -> [];
match_pat({'::', X, Y}, {op, _, '::', [A, B]}) -> [{X, A}, {Y, B}];
match_pat({var, _, X}, E) -> [{X, E}];
@ -1652,7 +1652,7 @@ constructor_form(Env, Expr) ->
end;
{con, _, _, _} -> Expr;
{tuple, _} -> Expr;
{lit, _} -> Expr;
{lit, _, _} -> Expr;
nil -> Expr;
{op, _, '::', _} -> Expr;
_ -> false
@ -1675,14 +1675,14 @@ drop_unused_lets(_, Expr) -> Expr.
%% -- Static analysis --------------------------------------------------------
-spec safe_to_duplicate(fexpr()) -> boolean().
safe_to_duplicate({lit, _}) -> true;
safe_to_duplicate({lit, _, _}) -> true;
safe_to_duplicate({var, _, _}) -> true;
safe_to_duplicate(nil) -> true;
safe_to_duplicate({tuple, []}) -> true;
safe_to_duplicate(_) -> false.
-spec read_only(fexpr() | fsplit() | fcase() | [fexpr()] | [fcase()]) -> boolean().
read_only({lit, _}) -> true;
read_only({lit, _, _}) -> true;
read_only({var, _, _}) -> true;
read_only(nil) -> true;
read_only({con, _, _, Es}) -> read_only(Es);
@ -1690,7 +1690,7 @@ read_only({tuple, Es}) -> read_only(Es);
read_only({proj, _, E, _}) -> read_only(E);
read_only({set_proj, _, A, _, B}) -> read_only([A, B]);
read_only({op, _, _, Es}) -> read_only(Es);
read_only({get_state, _}) -> true;
read_only({get_state, _, _}) -> true;
read_only({set_state, _, _, _}) -> false;
read_only({def_u, _, _, _}) -> true;
read_only({remote_u, _, _, _, _, _}) -> true;
@ -1931,7 +1931,7 @@ free_vars(Xs) when is_list(Xs) ->
free_vars(Expr) ->
case Expr of
{var, _, X} -> [X];
{lit, _} -> [];
{lit, _, _} -> [];
nil -> [];
{def, _, _, As} -> free_vars(As);
{def_u, _, _, _} -> [];
@ -1948,7 +1948,7 @@ free_vars(Expr) ->
{'let', Ann, X, A, B} -> free_vars([A, {lam, Ann, [X], B}]);
{funcall, _, A, Bs} -> free_vars([A | Bs]);
{set_state, _, _, A} -> free_vars(A);
{get_state, _} -> [];
{get_state, _, _} -> [];
{lam, _, Xs, B} -> free_vars(B) -- lists:sort(Xs);
{closure, _, _, A} -> free_vars(A);
{switch, _, A} -> free_vars(A);
@ -1963,7 +1963,7 @@ used_defs(Xs) when is_list(Xs) ->
used_defs(Expr) ->
case Expr of
{var, _, _} -> [];
{lit, _} -> [];
{lit, _, _} -> [];
nil -> [];
{def, _, F, As} -> lists:umerge([F], used_defs(As));
{def_u, _, F, _} -> [F];
@ -1980,7 +1980,7 @@ used_defs(Expr) ->
{'let', _, _, A, B} -> used_defs([A, B]);
{funcall, _, A, Bs} -> used_defs([A | Bs]);
{set_state, _, _, A} -> used_defs(A);
{get_state, _} -> [];
{get_state, _, _} -> [];
{lam, _, _, B} -> used_defs(B);
{closure, _, F, A} -> lists:umerge([F], used_defs(A));
{switch, _, A} -> used_defs(A);
@ -1997,7 +1997,7 @@ bottom_up(F, Expr) -> bottom_up(F, #{}, Expr).
Fun :: fun((expr_env(), fexpr()) -> fexpr()).
bottom_up(F, Env, Expr) ->
F(Env, case Expr of
{lit, _} -> Expr;
{lit, _, _} -> Expr;
nil -> Expr;
{var, _, _} -> Expr;
{def, Ann, D, Es} -> {def, Ann, D, [bottom_up(F, Env, E) || E <- Es]};
@ -2014,7 +2014,7 @@ bottom_up(F, Env, Expr) ->
{op, Ann, Op, Es} -> {op, Ann, Op, [bottom_up(F, Env, E) || E <- Es]};
{funcall, Ann, Fun, Es} -> {funcall, Ann, bottom_up(F, Env, Fun), [bottom_up(F, Env, E) || E <- Es]};
{set_state, Ann, R, E} -> {set_state, Ann, R, bottom_up(F, Env, E)};
{get_state, _} -> Expr;
{get_state, _, _} -> Expr;
{closure, Ann, F, CEnv} -> {closure, Ann, F, bottom_up(F, Env, CEnv)};
{switch, Ann, Split} -> {switch, Ann, bottom_up(F, Env, Split)};
{lam, Ann, Xs, B} -> {lam, Ann, Xs, bottom_up(F, Env, B)};
@ -2057,7 +2057,7 @@ get_named_arg({named_arg_t, _, {id, _, Name}, _, Default}, Args) ->
-spec rename(rename(), fexpr()) -> fexpr().
rename(Ren, Expr) ->
case Expr of
{lit, _} -> Expr;
{lit, _, _} -> Expr;
nil -> nil;
{var, Ann, X} -> {var, Ann, rename_var(Ren, X)};
{def, Ann, D, Es} -> {def, Ann, D, [rename(Ren, E) || E <- Es]};
@ -2074,7 +2074,7 @@ rename(Ren, Expr) ->
{op, Ann, Op, Es} -> {op, Ann, Op, [rename(Ren, E) || E <- Es]};
{funcall, Ann, Fun, Es} -> {funcall, Ann, rename(Ren, Fun), [rename(Ren, E) || E <- Es]};
{set_state, Ann, R, E} -> {set_state, Ann, R, rename(Ren, E)};
{get_state, _} -> Expr;
{get_state, _, _} -> Expr;
{closure, Ann, F, Env} -> {closure, Ann, F, rename(Ren, Env)};
{switch, Ann, Split} -> {switch, Ann, rename_split(Ren, Split)};
{lam, Ann, Xs, B} ->
@ -2288,9 +2288,9 @@ pp_par([]) -> prettypr:empty();
pp_par(Xs) -> prettypr:par(Xs).
-spec pp_fexpr(fexpr()) -> prettypr:document().
pp_fexpr({lit, {typerep, T}}) ->
pp_fexpr({lit, _, {typerep, T}}) ->
pp_ftype(T);
pp_fexpr({lit, {Tag, Lit}}) ->
pp_fexpr({lit, _, {Tag, Lit}}) ->
aeso_pretty:expr({Tag, [], Lit});
pp_fexpr(nil) ->
pp_text("[]");
@ -2356,10 +2356,10 @@ pp_fexpr({remote, _, ArgsT, RetT, Ct, Fun, As}) ->
pp_call(pp_parens(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun), pp_text(" : "), pp_ftype({function, ArgsT, RetT})])), As);
pp_fexpr({funcall, _, Fun, As}) ->
pp_call(pp_fexpr(Fun), As);
pp_fexpr({set_state, _, R, A}) ->
pp_call(pp_text("set_state"), [{lit, {int, R}}, A]);
pp_fexpr({get_state, R}) ->
pp_call(pp_text("get_state"), [{lit, {int, R}}]);
pp_fexpr({set_state, FAnn, R, A}) ->
pp_call(pp_text("set_state"), [{lit, FAnn, {int, R}}, A]);
pp_fexpr({get_state, FAnn, R}) ->
pp_call(pp_text("get_state"), [{lit, FAnn, {int, R}}]);
pp_fexpr({switch, _, Split}) -> pp_split(Split);
pp_fexpr({contract_code, Contract}) ->
pp_beside(pp_text("contract "), pp_text(Contract)).
@ -2376,7 +2376,7 @@ pp_call_t(Fun, Args) ->
pp_ftype(T) when is_atom(T) -> pp_text(T);
pp_ftype(any) -> pp_text("_");
pp_ftype({tvar, X}) -> pp_text(X);
pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, {int, N}}]);
pp_ftype({bytes, N}) -> pp_call(pp_text("bytes"), [{lit, [], {int, N}}]);
pp_ftype({oracle, Q, R}) -> pp_call_t("oracle", [Q, R]);
pp_ftype({tuple, Ts}) ->
pp_parens(pp_par(pp_punctuate(pp_text(" *"), [pp_ftype(T) || T <- Ts])));
@ -2411,7 +2411,7 @@ pp_pat({'::', X, Xs}) -> pp_fexpr({op, [], '::', [{var, [], X}, {var, [], Xs}
pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, [], X} || X <- Xs]});
pp_pat({var, Ann, X}) -> pp_fexpr({var, Ann, X});
pp_pat(P = {Tag, _}) when Tag == bool; Tag == int; Tag == string
-> pp_fexpr({lit, P});
-> pp_fexpr({lit, [], P});
pp_pat(Pat) -> pp_fexpr(Pat).
-spec is_infix(op()) -> boolean().