diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index a0dda40..0ea96fa 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -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). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 2192f70..2509827 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -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();