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

Compile list patterns

Browse Source
This commit is contained in:
Ulf Norell 2019-04-09 18:06:21 +02:00
parent 6042294f96
commit d333b5f11f
2 changed files with 115 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
src/aeso_ast_to_fcode.erl
View File

@ -40,10 +40,12 @@
-type fcase() :: {'case', fsplit_pat(), fsplit()}.
-type fsplit_pat() :: {bool, false | true}
-type fsplit_pat() :: {var, var_name()}
| {bool, false | true}
| {int, integer()}
| {tuple, [var_name()]}
| {var, var_name()}.
| nil
| {'::', var_name(), var_name()}
| {tuple, [var_name()]}.
-type ftype() :: integer
| boolean
@ -261,6 +263,7 @@ alts_to_fcode(Env, Type, X, Alts) ->
-type fpat() :: {var, var_name()}
| {bool, false | true}
| {int, integer()}
| nil | {'::', fpat(), fpat()}
| {tuple, [fpat()]}.
%% %% Invariant: the number of variables matches the number of patterns in each falt.
@ -295,13 +298,15 @@ merge_alts(I, X, Alts, Alts1) ->
when Alts :: [{fsplit_pat(), [falt()]}].
merge_alt(_, _, {P, A}, []) -> [{P, [A]}];
merge_alt(I, X, {P, A}, [{Q, As} | Rest]) ->
Match = fun({var, _}, {var, _}) -> match;
({tuple, _}, {tuple, _}) -> match;
({bool, B}, {bool, B}) -> match;
({int, N}, {int, N}) -> match;
({var, _}, _) -> expand;
(_, {var, _}) -> insert;
(_, _) -> mismatch
Match = fun({var, _}, {var, _}) -> match;
({tuple, _}, {tuple, _}) -> match;
({bool, B}, {bool, B}) -> match;
({int, N}, {int, N}) -> match;
(nil, nil) -> match;
({'::', _, _}, {'::', _, _}) -> match;
({var, _}, _) -> expand;
(_, {var, _}) -> insert;
(_, _) -> mismatch
end,
case Match(P, Q) of
match -> [{Q, [A | As]} | Rest];
@ -317,11 +322,18 @@ expand(I, X, P, Q, Case = {'case', Ps, E}) ->
{Ps0r, Ren1} = rename_pats([{Y, X} || Y /= X], Ps0),
{Ps1r, Ren2} = rename_pats(Ren1, Ps1),
E1 = rename(Ren2, E),
Splice = fun(Qs) -> Ps0r ++ Qs ++ Ps1r end,
case Q of
{tuple, Xs} -> {[{Q, {'case', Splice([{var, "_"} || _ <- Xs]), E1}}], []};
{bool, _} -> {[{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]], []};
{int, _} -> {[{Q, {'case', Splice([]), E1}}], [{P, Case}]}
Splice = fun(N) -> Ps0r ++ lists:duplicate(N, {var, "_"}) ++ Ps1r end,
Type = fun({tuple, Xs}) -> {tuple, length(Xs)};
({bool, _}) -> bool;
({int, _}) -> int;
(nil) -> list;
({'::', _, _}) -> list end,
MkCase = fun(Pat, Vars) -> {Pat, {'case', Splice(Vars), E1}} end,
case Type(Q) of
{tuple, N} -> {[MkCase(Q, N)], []};
bool -> {[MkCase({bool, B}, 0) || B <- [false, true]], []};
int -> {[MkCase(Q, 0)], [{P, Case}]};
list -> {[MkCase(nil, 0), MkCase({'::', fresh_name(), fresh_name()}, 2)], []}
end.
-spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}.
@ -334,13 +346,17 @@ split_alt(I, {'case', Pats, Body}) ->
split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]};
split_pat({bool, B}) -> {{bool, B}, []};
split_pat({int, N}) -> {{int, N}, []};
split_pat(nil) -> {nil, []};
split_pat({'::', P, Q}) -> {{'::', fresh_name(), fresh_name()}, [P, Q]};
split_pat({tuple, Pats}) ->
Xs = [fresh_name() || _ <- Pats],
{{tuple, Xs}, Pats}.
-spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}].
split_vars({bool, _}, boolean) -> [];
split_vars({int, _}, integer) -> [];
split_vars({bool, _}, boolean) -> [];
split_vars({int, _}, integer) -> [];
split_vars(nil, {list, _}) -> [];
split_vars({'::', X, Xs}, {list, T}) -> [{X, T}, {Xs, {list, T}}];
split_vars({tuple, Xs}, {tuple, Ts}) ->
lists:zip(Xs, Ts);
split_vars({var, X}, T) -> [{X, T}].
@ -384,6 +400,11 @@ rename_pats(Ren, [P | Ps]) ->
rename_pat(Ren, P = {bool, _}) -> {P, Ren};
rename_pat(Ren, P = {int, _}) -> {P, Ren};
rename_pat(Ren, P = nil) -> {P, Ren};
rename_pat(Ren, {'::', P, Q}) ->
{P1, Ren1} = rename_pat(Ren, P),
{Q1, Ren2} = rename_pat(Ren1, Q),
{{'::', P1, Q1}, Ren2};
rename_pat(Ren, {var, X}) ->
{Z, Ren1} = rename_binding(Ren, X),
{{var, Z}, Ren1};
@ -425,6 +446,12 @@ pat_to_fcode(_Env, _Type, {bool, _, B}) ->
{bool, B};
pat_to_fcode(_Env, _Type, {int, _, N}) ->
{int, N};
pat_to_fcode(Env, _Type, {list, _, Ps}) ->
lists:foldr(fun(P, Qs) ->
{'::', pat_to_fcode(Env, P), Qs}
end, nil, Ps);
pat_to_fcode(Env, _Type, {app, _, {'::', _}, [P, Q]}) ->
{'::', pat_to_fcode(Env, P), pat_to_fcode(Env, Q)};
pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}.
-spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr().
@ -588,6 +615,7 @@ pp_case({'case', Pat, Split}) ->
pp_above(pp_beside(pp_pat(Pat), pp_text(" =>")),
prettypr:nest(2, pp_split(Split))).
pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]});
pp_pat(Pat) -> pp_fexpr(Pat).
pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]});
pp_pat({'::', X, Xs}) -> pp_fexpr({binop, list, '::', {var, X}, {var, Xs}});
pp_pat(Pat) -> pp_fexpr(Pat).

96
src/aeso_fcode_to_fate.erl
View File

@ -56,6 +56,10 @@
Op =:= 'ELEMENT' orelse
Op =:= 'CONS')).
-define(IsUnOp(Op),
(Op =:= 'HD' orelse
Op =:= 'TL')).
-record(env, { vars = [], locals = [], tailpos = true }).
%% -- Debugging --------------------------------------------------------------
@ -192,6 +196,24 @@ split_to_scode(Env, {split, boolean, X, Alts}) ->
SAlts = [GetAlt(false), GetAlt(true)],
[aeb_fate_code:push(lookup_var(Env, X)),
{switch, boolean, SAlts, Def}];
split_to_scode(Env, {split, {list, _}, X, Alts}) ->
{Def, Alts1} = catchall_to_scode(Env, X, Alts),
Arg = lookup_var(Env, X),
GetAlt = fun(P) ->
case [C || C = {'case', Pat, _} <- Alts1, Pat == P orelse is_tuple(Pat) andalso element(1, Pat) == P] of
[] -> missing;
[{'case', nil, S} | _] -> split_to_scode(Env, S);
[{'case', {'::', Y, Z}, S} | _] ->
{I, Env1} = bind_local(Y, Env),
{J, Env2} = bind_local(Z, Env1),
[aeb_fate_code:hd({var, I}, Arg),
aeb_fate_code:tl({var, J}, Arg),
split_to_scode(Env2, S)]
end
end,
SAlts = [GetAlt('::'), GetAlt(nil)],
[aeb_fate_code:is_nil(?a, Arg),
{switch, boolean, SAlts, Def}];
split_to_scode(Env, {split, integer, X, Alts}) ->
{Def, Alts1} = catchall_to_scode(Env, X, Alts),
literal_split_to_scode(Env, integer, X, Alts1, Def);
@ -572,6 +594,8 @@ rules() ->
].
%% Removing pushes that are immediately consumed.
r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a}} | Code]) when ?IsUnOp(Op) ->
{[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code};
r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) ->
{[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code};
r_push_consume({i, Ann1, {'PUSH', B}}, [{i, Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) ->
@ -584,6 +608,8 @@ r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {'POP', B}} | Code]) ->
false -> {[], Code}
end;
%% Writing directly to memory instead of going through the accumulator.
r_push_consume({i, Ann1, {Op, ?a, A}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsUnOp(Op) ->
{[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code};
r_push_consume({i, Ann1, {Op, ?a, A, B}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) ->
{[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code};
@ -654,49 +680,63 @@ r_inline_store(Acc, R, A, [{i, Ann, I} | Code]) ->
false -> {lists:reverse(Acc1), Code};
{New, Rest} -> {New, Rest}
end;
{Op, S, B} when ?IsUnOp(Op), B == R ->
Acc1 = [{i, Ann, {Op, S, Inl(B)}} | Acc],
case r_inline_store(Acc1, R, A, Code) of
false -> {lists:reverse(Acc1), Code};
{New, Rest} -> {New, Rest}
end;
_ -> r_inline_store([{i, Ann, I} | Acc], R, A, Code)
end
end;
r_inline_store(_Acc, _, _, _) -> false.
%% Shortcut write followed by final read
r_one_shot_var({i, Ann1, {Op, R = {var, _}, A, B}}, [{i, Ann2, J} | Code]) when ?IsBinOp(Op) ->
Copy = case J of
{'PUSH', R} -> {write_to, ?a};
{'STORE', S, R} -> {write_to, S};
_ -> false
end,
case {live_out(R, Ann2), Copy} of
{false, {write_to, X}} ->
{[{i, merge_ann(Ann1, Ann2), {Op, X, A, B}}], Code};
r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) ->
case op_view(I) of
{Op, R, As} ->
Copy = case J of
{'PUSH', R} -> {write_to, ?a};
{'STORE', S, R} -> {write_to, S};
_ -> false
end,
case {live_out(R, Ann2), Copy} of
{false, {write_to, X}} ->
{[{i, merge_ann(Ann1, Ann2), from_op_view({Op, X, As})}], Code};
_ -> false
end;
_ -> false
end;
r_one_shot_var(_, _) -> false.
%% Remove writes to dead variables
r_write_to_dead_var({i, Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) ->
case live_out(R, Ann) of
false ->
%% Subtle: we still have to pop the stack if any of the arguments
%% came from there. In this case we pop to R, which we know is
%% unused.
{[{i, Ann, {'POP', R}} || X <- [A, B], X == ?a], Code};
true -> false
end;
r_write_to_dead_var({i, Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a ->
case live_out(R, Ann) of
false ->
case Code of
[] -> {[], []};
[switch_body, {Ann1, I} | Code1] ->
{[], [switch_body, {i, merge_ann(Ann, Ann1), I} | Code1]};
[{i, Ann1, I} | Code1] ->
{[], [{merge_ann(Ann, Ann1), I} | Code1]}
r_write_to_dead_var({i, Ann, I}, Code) ->
case op_view(I) of
{_Op, R = {var, _}, As} ->
case live_out(R, Ann) of
false ->
%% Subtle: we still have to pop the stack if any of the arguments
%% came from there. In this case we pop to R, which we know is
%% unused.
{[{i, Ann, {'POP', R}} || X <- As, X == ?a], Code};
true -> false
end;
true -> false
_ -> false
end;
r_write_to_dead_var(_, _) -> false.
op_view({Op, R, A, B}) when ?IsBinOp(Op) ->
{Op, R, [A, B]};
op_view({Op, R, A}) when ?IsUnOp(Op) ->
{Op, R, [A]};
op_view({'STORE', R, A}) ->
{'STORE', R, [A]};
op_view({'NIL', R}) ->
{'NIL', R, []};
op_view(_) ->
false.
from_op_view({Op, R, As}) -> list_to_tuple([Op, R | As]).
%% Desugar and specialize and remove annotations
-spec unannotate(scode_a()) -> scode();