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

Add fann() to lam

Browse Source
This commit is contained in:
Gaith Hallak 2022-11-05 13:25:55 +03:00
parent 48136ef719
commit 3f129b3b04
1 changed files with 18 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/aeso_ast_to_fcode.erl
View File

@ -84,7 +84,7 @@
| {remote_u, fann(), [ftype()], ftype(), fexpr(), fun_name()} | {remote_u, fann(), [ftype()], ftype(), fexpr(), fun_name()}
| {builtin_u, builtin(), arity()} | {builtin_u, builtin(), arity()}
| {builtin_u, builtin(), arity(), [fexpr()]} %% Typerep arguments to be added after normal args. | {builtin_u, builtin(), arity(), [fexpr()]} %% Typerep arguments to be added after normal args.
| {lam, [var_name()], fexpr()}. | {lam, fann(), [var_name()], fexpr()}.
-type fsplit() :: {split, ftype(), var_name(), [fcase()]} -type fsplit() :: {split, ftype(), var_name(), [fcase()]}
| {nosplit, fexpr()}. | {nosplit, fexpr()}.
@ -661,9 +661,9 @@ expr_to_fcode(Env, _Type, {list_comp, As, Yield, []}) ->
expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {typed, _, _, PatType}, BindExpr}|Rest]}) -> expr_to_fcode(Env, _Type, {list_comp, As, Yield, [{comprehension_bind, Pat = {typed, _, _, PatType}, BindExpr}|Rest]}) ->
Arg = fresh_name(), Arg = fresh_name(),
Env1 = bind_var(Env, Arg), Env1 = bind_var(Env, Arg),
Bind = {lam, [Arg], expr_to_fcode(Env1, {switch, As, {typed, As, {id, As, Arg}, PatType}, Bind = {lam, to_fann(As), [Arg], expr_to_fcode(Env1, {switch, As, {typed, As, {id, As, Arg}, PatType},
[{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]}, [{'case', As, Pat, [{guarded, As, [], {list_comp, As, Yield, Rest}}]},
{'case', As, {id, As, "_"}, [{guarded, As, [], {list, As, []}}]}]})}, {'case', As, {id, As, "_"}, [{guarded, As, [], {list, As, []}}]}]})},
{def_u, Ann, FlatMap, _} = resolve_fun(Env, ["ListInternal", "flat_map"]), {def_u, Ann, FlatMap, _} = resolve_fun(Env, ["ListInternal", "flat_map"]),
{def, Ann, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]}; {def, Ann, FlatMap, [Bind, expr_to_fcode(Env, BindExpr)]};
expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) -> expr_to_fcode(Env, Type, {list_comp, As, Yield, [{comprehension_if, _, Cond}|Rest]}) ->
@ -788,10 +788,10 @@ expr_to_fcode(Env, _Type, {map_get, Ann, Map, Key}) ->
expr_to_fcode(Env, _Type, {map_get, Ann, Map, Key, Def}) -> expr_to_fcode(Env, _Type, {map_get, Ann, Map, Key, Def}) ->
{op, to_fann(Ann), map_get_d, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)]}; {op, to_fann(Ann), map_get_d, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)]};
expr_to_fcode(Env, _Type, {lam, _, Args, Body}) -> expr_to_fcode(Env, _Type, {lam, Ann, Args, Body}) ->
GetArg = fun({arg, _, {id, _, X}, _}) -> X end, GetArg = fun({arg, _, {id, _, X}, _}) -> X end,
Xs = lists:map(GetArg, Args), Xs = lists:map(GetArg, Args),
{lam, Xs, expr_to_fcode(bind_vars(Env, Xs), Body)}; {lam, to_fann(Ann), Xs, expr_to_fcode(bind_vars(Env, Xs), Body)};
expr_to_fcode(_Env, Type, Expr) -> expr_to_fcode(_Env, Type, Expr) ->
error({todo, {Expr, ':', Type}}). error({todo, {Expr, ':', Type}}).
@ -1259,8 +1259,8 @@ make_closure(FVs, Xs, Body) ->
Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end, Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end,
{closure, get_fann(Body), Fun, Tup([{var, Y} || Y <- FVs])}. {closure, get_fann(Body), Fun, Tup([{var, Y} || Y <- FVs])}.
lambda_lift_expr(Layout, {lam, Xs, Body}) -> lambda_lift_expr(Layout, L = {lam, _, Xs, Body}) ->
FVs = free_vars({lam, Xs, Body}), FVs = free_vars(L),
make_closure(FVs, Xs, lambda_lift_expr(Layout, Body)); make_closure(FVs, Xs, lambda_lift_expr(Layout, 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),
@ -1384,8 +1384,8 @@ inline_local_functions(Expr) ->
inline_local_functions(Env, {funcall, _, {proj, _, {var, Y}, 0}, [{proj, _, {var, Y}, 1} | Args]} = Expr) -> inline_local_functions(Env, {funcall, _, {proj, _, {var, Y}, 0}, [{proj, _, {var, Y}, 1} | Args]} = Expr) ->
%% TODO: Don't always inline local funs? %% TODO: Don't always inline local funs?
case maps:get(Y, Env, free) of case maps:get(Y, Env, free) of
{lam, Xs, Body} -> let_bind(lists:zip(Xs, Args), Body); {lam, _, Xs, Body} -> let_bind(lists:zip(Xs, Args), Body);
_ -> Expr _ -> Expr
end; end;
inline_local_functions(_, Expr) -> Expr. inline_local_functions(_, Expr) -> Expr.
@ -1611,7 +1611,7 @@ 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;
read_only({builtin, _, _}) -> false; %% TODO: some builtins are read_only({builtin, _, _}) -> false; %% TODO: some builtins are
@ -1847,11 +1847,11 @@ free_vars(Expr) ->
{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', 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]);
@ -1882,7 +1882,7 @@ used_defs(Expr) ->
{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);
@ -1914,7 +1914,7 @@ bottom_up(F, Env, Expr) ->
{get_state, _} -> Expr; {get_state, _} -> Expr;
{closure, Ann, F, CEnv} -> {closure, Ann, F, bottom_up(F, Env, CEnv)}; {closure, Ann, F, CEnv} -> {closure, Ann, F, bottom_up(F, Env, CEnv)};
{switch, Split} -> {switch, bottom_up(F, Env, Split)}; {switch, Split} -> {switch, bottom_up(F, Env, Split)};
{lam, Xs, B} -> {lam, Xs, bottom_up(F, Env, B)}; {lam, Ann, Xs, B} -> {lam, Ann, Xs, bottom_up(F, Env, B)};
{'let', Ann, X, E, Body} -> {'let', Ann, X, E, Body} ->
E1 = bottom_up(F, Env, E), E1 = bottom_up(F, Env, E),
%% Always freshen user variables to avoid shadowing issues. %% Always freshen user variables to avoid shadowing issues.
@ -1972,9 +1972,9 @@ rename(Ren, Expr) ->
{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, Ann, Xs, B} ->
{Zs, Ren1} = rename_bindings(Ren, Xs), {Zs, Ren1} = rename_bindings(Ren, Xs),
{lam, Zs, rename(Ren1, B)}; {lam, Ann, Zs, rename(Ren1, B)};
{'let', Ann, X, E, Body} -> {'let', Ann, X, E, Body} ->
{Z, Ren1} = rename_binding(Ren, X), {Z, Ren1} = rename_binding(Ren, X),
{'let', Ann, Z, rename(Ren, E), rename(Ren1, Body)} {'let', Ann, Z, rename(Ren, E), rename(Ren1, Body)}
@ -2168,7 +2168,7 @@ pp_fexpr({tuple, Es}) ->
pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es])));
pp_fexpr({proj, _, E, I}) -> pp_fexpr({proj, _, E, I}) ->
pp_beside([pp_fexpr(E), pp_text("."), pp_int(I)]); pp_beside([pp_fexpr(E), pp_text("."), pp_int(I)]);
pp_fexpr({lam, Xs, A}) -> pp_fexpr({lam, _, Xs, A}) ->
pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"), pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"),
prettypr:nest(2, pp_fexpr(A))]); prettypr:nest(2, pp_fexpr(A))]);
pp_fexpr({closure, _, Fun, ClEnv}) -> pp_fexpr({closure, _, Fun, ClEnv}) ->