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

Add fann() to set_proj

Browse Source
This commit is contained in:
Gaith Hallak 2022-11-02 12:15:37 +03:00
parent 404bb33863
commit 74f0b3a2db
1 changed files with 101 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

202
src/aeso_ast_to_fcode.erl
View File

@ -69,7 +69,7 @@
| {con, arities(), tag(), [fexpr()]} | {con, arities(), tag(), [fexpr()]}
| {tuple, [fexpr()]} | {tuple, [fexpr()]}
| {proj, fann(), fexpr(), integer()} | {proj, fann(), fexpr(), integer()}
| {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value | {set_proj, fann(), fexpr(), integer(), fexpr()} %% tuple, field, new_value
| {op, op(), [fexpr()]} | {op, op(), [fexpr()]}
| {'let', var_name(), fexpr(), fexpr()} | {'let', var_name(), fexpr(), fexpr()}
| {funcall, fann(), fexpr(), [fexpr()]} %% Call to unknown function | {funcall, fann(), fexpr(), [fexpr()]} %% Call to unknown function
@ -634,8 +634,8 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, Ann, Rec, Fields}) ->
({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)} ({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)}
end, end,
Set = fun({_, false}, R) -> R; Set = fun({_, false}, R) -> R;
({I, {set, E}}, R) -> {set_proj, R, I - 1, expr_to_fcode(Env, E)}; ({I, {set, E}}, R) -> {set_proj, to_fann(Ann), R, I - 1, expr_to_fcode(Env, E)};
({I, {upd, Z, E}}, R) -> {set_proj, R, I - 1, ({I, {upd, Z, E}}, R) -> {set_proj, to_fann(Ann), R, I - 1,
{'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)}} {'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)}}
end, end,
Expand = length(Fields) == length(FieldTypes), Expand = length(Fields) == length(FieldTypes),
@ -1277,26 +1277,26 @@ lambda_lift_expr(Layout, {remote_u, Ann, ArgsT, RetT, Ct, F}) ->
make_closure(FVs, Xs, {remote, Ann, ArgsT, RetT, Ct1, F, Args}); make_closure(FVs, Xs, {remote, Ann, ArgsT, RetT, Ct1, F, Args});
lambda_lift_expr(Layout, Expr) -> lambda_lift_expr(Layout, Expr) ->
case Expr of case Expr of
{lit, _} -> Expr; {lit, _} -> Expr;
nil -> Expr; nil -> Expr;
{var, _} -> Expr; {var, _} -> Expr;
{closure, _, _, _} -> Expr; {closure, _, _, _} -> Expr;
{def, D, As} -> {def, D, lambda_lift_exprs(Layout, As)}; {def, D, As} -> {def, D, lambda_lift_exprs(Layout, As)};
{builtin, B, As} -> {builtin, B, lambda_lift_exprs(Layout, As)}; {builtin, B, As} -> {builtin, B, lambda_lift_exprs(Layout, As)};
{remote, Ann, ArgsT, RetT, Ct, F, As} -> {remote, Ann, ArgsT, RetT, lambda_lift_expr(Layout, Ct), F, lambda_lift_exprs(Layout, As)}; {remote, Ann, ArgsT, RetT, Ct, F, As} -> {remote, Ann, ArgsT, RetT, lambda_lift_expr(Layout, Ct), F, lambda_lift_exprs(Layout, As)};
{con, Ar, C, As} -> {con, Ar, C, lambda_lift_exprs(Layout, As)}; {con, Ar, C, As} -> {con, Ar, C, lambda_lift_exprs(Layout, As)};
{tuple, As} -> {tuple, lambda_lift_exprs(Layout, As)}; {tuple, As} -> {tuple, lambda_lift_exprs(Layout, As)};
{proj, Ann, A, I} -> {proj, Ann, lambda_lift_expr(Layout, A), I}; {proj, Ann, A, I} -> {proj, Ann, lambda_lift_expr(Layout, A), I};
{set_proj, A, I, B} -> {set_proj, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)}; {set_proj, Ann, A, I, B} -> {set_proj, Ann, lambda_lift_expr(Layout, A), I, lambda_lift_expr(Layout, B)};
{op, Op, As} -> {op, Op, lambda_lift_exprs(Layout, As)}; {op, Op, As} -> {op, Op, lambda_lift_exprs(Layout, As)};
{'let', X, A, B} -> {'let', X, lambda_lift_expr(Layout, A), lambda_lift_expr(Layout, B)}; {'let', X, A, B} -> {'let', 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)}; {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)}; {set_state, Ann, R, A} -> {set_state, Ann, R, lambda_lift_expr(Layout, A)};
{get_state, _} -> Expr; {get_state, _} -> Expr;
{switch, S} -> {switch, lambda_lift_expr(Layout, S)}; {switch, S} -> {switch, lambda_lift_expr(Layout, S)};
{split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Layout, Alts)}; {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Layout, Alts)};
{nosplit, A} -> {nosplit, lambda_lift_expr(Layout, A)}; {nosplit, A} -> {nosplit, lambda_lift_expr(Layout, A)};
{'case', P, S} -> {'case', P, lambda_lift_expr(Layout, S)} {'case', P, S} -> {'case', P, lambda_lift_expr(Layout, S)}
end. end.
lambda_lift_exprs(Layout, As) -> [lambda_lift_expr(Layout, A) || A <- As]. lambda_lift_exprs(Layout, As) -> [lambda_lift_expr(Layout, A) || A <- As].
@ -1355,8 +1355,8 @@ bind_subexpressions(Expr) ->
bind_subexpressions(_, {tuple, Es}) -> bind_subexpressions(_, {tuple, Es}) ->
?make_lets(Xs, Es, {tuple, Xs}); ?make_lets(Xs, Es, {tuple, Xs});
bind_subexpressions(_, {set_proj, A, I, B}) -> bind_subexpressions(_, {set_proj, Ann, A, I, B}) ->
?make_lets([X, Y], [A, B], {set_proj, X, I, Y}); ?make_lets([X, Y], [A, B], {set_proj, Ann, X, I, Y});
bind_subexpressions(_, E) -> E. bind_subexpressions(_, E) -> E.
make_lets(Es, Body) -> make_lets(Es, [], Body). make_lets(Es, Body) -> make_lets(Es, [], Body).
@ -1390,8 +1390,8 @@ let_float(_, {'let', X, E, Body}) ->
pull_out_let({'let', X, {here, E}, Body}); pull_out_let({'let', X, {here, E}, Body});
let_float(_, {proj, Ann, E, I}) -> let_float(_, {proj, Ann, E, I}) ->
pull_out_let({proj, Ann, {here, E}, I}); pull_out_let({proj, Ann, {here, E}, I});
let_float(_, {set_proj, E, I, V}) -> let_float(_, {set_proj, Ann, E, I, V}) ->
pull_out_let({set_proj, {here, E}, I, {here, V}}); pull_out_let({set_proj, Ann, {here, E}, I, {here, V}});
let_float(_, {op, Op, Es}) -> let_float(_, {op, Op, Es}) ->
{Lets, Es1} = pull_out_let([{here, E} || E <- Es]), {Lets, Es1} = pull_out_let([{here, E} || E <- Es]),
let_bind(Lets, {op, Op, Es1}); let_bind(Lets, {op, Op, Es1});
@ -1475,13 +1475,13 @@ simpl_proj(Env, I, Expr) ->
false -> false false -> false
end end, end end,
case Expr of case Expr of
false -> false; false -> false;
{var, X} -> simpl_proj(Env, I, maps:get(X, Env, false)); {var, X} -> simpl_proj(Env, I, maps:get(X, Env, false));
{tuple, Es} -> IfSafe(lists:nth(I + 1, Es)); {tuple, Es} -> IfSafe(lists:nth(I + 1, Es));
{set_proj, _, I, Val} -> IfSafe(Val); {set_proj, _, _, I, Val} -> IfSafe(Val);
{set_proj, E, _, _} -> simpl_proj(Env, I, E); {set_proj, _, E, _, _} -> simpl_proj(Env, I, E);
{proj, _, E, J} -> simpl_proj(Env, I, simpl_proj(Env, J, E)); {proj, _, E, J} -> simpl_proj(Env, I, simpl_proj(Env, J, E));
_ -> false _ -> false
end. end.
get_catchalls(Alts) -> get_catchalls(Alts) ->
@ -1551,7 +1551,7 @@ constructor_form(Env, Expr) ->
free -> false; free -> false;
E -> constructor_form(Env, E) %% TODO: shadowing? E -> constructor_form(Env, E) %% TODO: shadowing?
end; end;
{set_proj, E, I, V} -> {set_proj, _, E, I, V} ->
case constructor_form(Env, E) of case constructor_form(Env, E) of
{tuple, Es} -> {tuple, setnth(I + 1, V, Es)}; {tuple, Es} -> {tuple, setnth(I + 1, V, Es)};
_ -> false _ -> false
@ -1596,7 +1596,7 @@ read_only(nil) -> true;
read_only({con, _, _, Es}) -> read_only(Es); read_only({con, _, _, Es}) -> read_only(Es);
read_only({tuple, Es}) -> read_only(Es); read_only({tuple, Es}) -> read_only(Es);
read_only({proj, _, E, _}) -> read_only(E); read_only({proj, _, E, _}) -> read_only(E);
read_only({set_proj, A, _, B}) -> read_only([A, B]); read_only({set_proj, _, A, _, B}) -> read_only([A, B]);
read_only({op, _, Es}) -> read_only(Es); read_only({op, _, Es}) -> read_only(Es);
read_only({get_state, _}) -> true; read_only({get_state, _}) -> true;
read_only({set_state, _, _, _}) -> false; read_only({set_state, _, _, _}) -> false;
@ -1825,62 +1825,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', X, A, B} -> free_vars([A, {lam, [X], B}]); {'let', X, A, B} -> free_vars([A, {lam, [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,7 +1900,7 @@ bottom_up(F, Env, Expr) ->
{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]};
{tuple, Es} -> {tuple, [bottom_up(F, Env, E) || E <- Es]}; {tuple, Es} -> {tuple, [bottom_up(F, Env, E) || E <- Es]};
{proj, Ann, E, I} -> {proj, Ann, bottom_up(F, Env, E), I}; {proj, Ann, E, I} -> {proj, Ann, bottom_up(F, Env, E), I};
{set_proj, R, I, E} -> {set_proj, bottom_up(F, Env, R), I, bottom_up(F, Env, E)}; {set_proj, Ann, R, I, E} -> {set_proj, Ann, bottom_up(F, Env, R), I, bottom_up(F, Env, E)};
{op, Op, Es} -> {op, Op, [bottom_up(F, Env, E) || E <- Es]}; {op, Op, Es} -> {op, 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]}; {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)}; {set_state, Ann, R, E} -> {set_state, Ann, R, bottom_up(F, Env, E)};
@ -1945,26 +1945,26 @@ get_named_arg({named_arg_t, _, {id, _, Name}, _, Default}, Args) ->
-spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). -spec rename([{var_name(), var_name()}], fexpr()) -> fexpr().
rename(Ren, Expr) -> rename(Ren, Expr) ->
case Expr of case Expr of
{lit, _} -> Expr; {lit, _} -> Expr;
nil -> nil; nil -> nil;
{var, X} -> {var, rename_var(Ren, X)}; {var, X} -> {var, rename_var(Ren, X)};
{def, D, Es} -> {def, D, [rename(Ren, E) || E <- Es]}; {def, D, Es} -> {def, 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]};
{tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; {tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]};
{proj, Ann, E, I} -> {proj, Ann, rename(Ren, E), I}; {proj, Ann, E, I} -> {proj, Ann, rename(Ren, E), I};
{set_proj, R, I, E} -> {set_proj, rename(Ren, R), I, rename(Ren, E)}; {set_proj, Ann, R, I, E} -> {set_proj, Ann, rename(Ren, R), I, rename(Ren, E)};
{op, Op, Es} -> {op, Op, [rename(Ren, E) || E <- Es]}; {op, Op, Es} -> {op, Op, [rename(Ren, E) || E <- Es]};
{funcall, Ann, Fun, Es} -> {funcall, Ann, rename(Ren, Fun), [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)}; {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)}; {closure, Ann, F, Env} -> {closure, Ann, F, rename(Ren, Env)};
{switch, Split} -> {switch, rename_split(Ren, Split)}; {switch, Split} -> {switch, rename_split(Ren, Split)};
{lam, Xs, B} -> {lam, Xs, B} ->
{Zs, Ren1} = rename_bindings(Ren, Xs), {Zs, Ren1} = rename_bindings(Ren, Xs),
{lam, Zs, rename(Ren1, B)}; {lam, Zs, rename(Ren1, B)};
@ -2170,7 +2170,7 @@ pp_fexpr({closure, _, Fun, ClEnv}) ->
{var, _} -> [ClEnv] {var, _} -> [ClEnv]
end, end,
pp_call(pp_text("__CLOSURE__"), [{def, Fun} | FVs]); pp_call(pp_text("__CLOSURE__"), [{def, Fun} | FVs]);
pp_fexpr({set_proj, E, I, A}) -> pp_fexpr({set_proj, _, E, I, A}) ->
pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_int(I), pp_text(" = "), pp_fexpr(A)]))); pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_int(I), pp_text(" = "), pp_fexpr(A)])));
pp_fexpr({op, Op, [A, B] = Args}) -> pp_fexpr({op, Op, [A, B] = Args}) ->
case is_infix(Op) of case is_infix(Op) of