Compile let to FATE

This commit is contained in:
Ulf Norell 2019-04-01 13:47:01 +02:00
parent bc8b2d1c81
commit 33bb8a37d0
2 changed files with 63 additions and 18 deletions

View File

@ -31,9 +31,15 @@
| {var, var_name()} | {var, var_name()}
| {binop, ftype(), binop(), fexpr(), fexpr()} | {binop, ftype(), binop(), fexpr(), fexpr()}
| {'if', fexpr(), fexpr(), fexpr()} | {'if', fexpr(), fexpr(), fexpr()}
| {todo, term()}. | {switch, fexpr(), [falt()]}.
-type fpat() :: {var, var_name()}.
-type falt() :: {fpat(), fexpr()}.
-type ftype() :: aeb_fate_data:fate_type_type(). -type ftype() :: aeb_fate_data:fate_type_type().
-type fun_def() :: #{ attrs := [attribute()], -type fun_def() :: #{ attrs := [attribute()],
args := [{var_name(), ftype()}], args := [{var_name(), ftype()}],
return := ftype(), return := ftype(),
@ -173,20 +179,43 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) ->
expr_to_fcode(Env, Then), expr_to_fcode(Env, Then),
expr_to_fcode(Env, Else)}; expr_to_fcode(Env, Else)};
%% Blocks
expr_to_fcode(Env, _Type, {block, _, Stmts}) ->
stmts_to_fcode(Env, Stmts);
%% Binary operator %% Binary operator
expr_to_fcode(Env, Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> expr_to_fcode(Env, Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) ->
FOp = binop_to_fcode(Op), FOp = binop_to_fcode(Op),
{binop, Type, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; {binop, Type, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)};
expr_to_fcode(_Env, Type, Expr) -> expr_to_fcode(_Env, Type, Expr) ->
{todo, {Expr, '::', Type}}. {todo, {Expr, ':', Type}}.
binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op.
-spec pat_to_fcode(env(), aeso_syntax:pattern()) -> fpat().
pat_to_fcode(Env, {typed, _, Pat, Type}) ->
pat_to_fcode(Env, type_to_fcode(Env, Type), Pat);
pat_to_fcode(Env, Pat) ->
pat_to_fcode(Env, no_type, Pat).
-spec pat_to_fcode(env(), ftype() | no_type, aeso_syntax:pattern()) -> fpat().
pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X};
pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}.
-spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr().
stmts_to_fcode(Env, [{letval, _, Pat, _, Expr} | Stmts]) ->
{switch, expr_to_fcode(Env, Expr),
[{pat_to_fcode(Env, Pat), stmts_to_fcode(Env, Stmts)}]};
stmts_to_fcode(Env, [Expr]) ->
expr_to_fcode(Env, Expr).
%% -- Optimisations ---------------------------------------------------------- %% -- Optimisations ----------------------------------------------------------
%% - Translate && and || to ifte %% - Translate && and || to ifte
%% - Deadcode elimination %% - Deadcode elimination
%% - Simplified case trees (FATE has special instructions for shallow matching)
%% -- Helper functions ------------------------------------------------------- %% -- Helper functions -------------------------------------------------------

View File

@ -18,7 +18,7 @@
-define(i(__X__), {immediate, __X__}). -define(i(__X__), {immediate, __X__}).
-define(a, {stack, 0}). -define(a, {stack, 0}).
-record(env, { args = [], stack = [], tailpos = true }). -record(env, { args = [], stack = [], locals = [], tailpos = true }).
%% -- Debugging -------------------------------------------------------------- %% -- Debugging --------------------------------------------------------------
@ -69,15 +69,18 @@ init_env(Args) ->
#env{ args = Args, stack = [], tailpos = true }. #env{ args = Args, stack = [], tailpos = true }.
push_env(Type, Env) -> push_env(Type, Env) ->
Env#env{ stack = [{"_", Type} | Env#env.stack] }. Env#env{ stack = [Type | Env#env.stack] }.
bind_local(Name, Env = #env{ locals = Locals }) ->
{length(Locals), Env#env{ locals = Locals ++ [Name] }}.
notail(Env) -> Env#env{ tailpos = false }. notail(Env) -> Env#env{ tailpos = false }.
lookup_var(#env{ args = Args, stack = S }, X) -> lookup_var(Env = #env{ args = Args, locals = Locals }, X) ->
case {keyfind_index(X, 1, S), keyfind_index(X, 1, Args)} of case {find_index(X, Locals), keyfind_index(X, 1, Args)} of
{false, false} -> false; {false, false} -> error({unbound_variable, X, Env});
{false, Arg} -> {arg, Arg}; {false, Arg} -> {arg, Arg};
{Local, _} -> {stack, Local} {Local, _} -> {var, Local}
end. end.
%% -- The compiler -- %% -- The compiler --
@ -86,23 +89,30 @@ to_scode(_Env, {integer, N}) ->
[aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring [aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring
to_scode(Env, {var, X}) -> to_scode(Env, {var, X}) ->
case lookup_var(Env, X) of [aeb_fate_code:push(lookup_var(Env, X))];
false -> error({unbound_variable, X, Env});
{stack, N} -> [aeb_fate_code:dup(?i(N))];
{arg, N} -> [aeb_fate_code:push({arg, N})]
end;
to_scode(Env, {binop, Type, Op, A, B}) -> to_scode(Env, {binop, Type, Op, A, B}) ->
[ to_scode(notail(Env), B) [ to_scode(notail(Env), B),
, to_scode(push_env(Type, Env), A) to_scode(push_env(Type, Env), A),
, binop_to_scode(Op) ]; binop_to_scode(Op) ];
to_scode(Env, {'if', Dec, Then, Else}) -> to_scode(Env, {'if', Dec, Then, Else}) ->
[ to_scode(notail(Env), Dec) [ to_scode(notail(Env), Dec),
, {ifte, to_scode(Env, Then), to_scode(Env, Else)} ]; {ifte, to_scode(Env, Then), to_scode(Env, Else)} ];
to_scode(Env, {switch, Expr, Alts}) ->
[ to_scode(notail(Env), Expr),
alts_to_scode(Env, Alts) ];
to_scode(_Env, Icode) -> ?TODO(Icode). to_scode(_Env, Icode) -> ?TODO(Icode).
alts_to_scode(Env, [{{var, X}, Body}]) ->
{I, Env1} = bind_local(X, Env),
[ aeb_fate_code:store({var, I}, {stack, 0}),
to_scode(Env1, Body) ];
alts_to_scode(_Env, Alts) ->
?TODO(Alts).
%% -- Operators -- %% -- Operators --
binop_to_scode('+') -> add_a_a_a(); %% Optimization introduces other variants binop_to_scode('+') -> add_a_a_a(); %% Optimization introduces other variants
@ -283,3 +293,9 @@ keyfind_index(X, J, Xs) ->
[] -> false [] -> false
end. end.
find_index(X, Xs) ->
case lists:keyfind(X, 2, with_ixs(Xs)) of
{I, _} -> I;
false -> false
end.