From 33bb8a37d0f5b9ed7bfd83d56b34d1ec9d59d55f Mon Sep 17 00:00:00 2001
From: Ulf Norell <ulf.norell@gmail.com>
Date: Mon, 1 Apr 2019 13:47:01 +0200
Subject: [PATCH] Compile `let` to FATE

---
 src/aeso_ast_to_fcode.erl  | 33 ++++++++++++++++++++++++--
 src/aeso_fcode_to_fate.erl | 48 +++++++++++++++++++++++++-------------
 2 files changed, 63 insertions(+), 18 deletions(-)

diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl
index 14ab6ed..f042ad2 100644
--- a/src/aeso_ast_to_fcode.erl
+++ b/src/aeso_ast_to_fcode.erl
@@ -31,9 +31,15 @@
                | {var, var_name()}
                | {binop, ftype(), binop(), 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 fun_def() :: #{ attrs  := [attribute()],
                       args   := [{var_name(), 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, Else)};
 
+%% Blocks
+expr_to_fcode(Env, _Type, {block, _, Stmts}) ->
+    stmts_to_fcode(Env, Stmts);
+
 %% Binary operator
 expr_to_fcode(Env, Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) ->
     FOp = binop_to_fcode(Op),
     {binop, Type, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)};
 
 expr_to_fcode(_Env, Type, Expr) ->
-    {todo, {Expr, '::', Type}}.
+    {todo, {Expr, ':', Type}}.
 
 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 ----------------------------------------------------------
 
 %% - Translate && and || to ifte
 %% - Deadcode elimination
+%% - Simplified case trees (FATE has special instructions for shallow matching)
 
 %% -- Helper functions -------------------------------------------------------
 
diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl
index 71e5f53..8065df9 100644
--- a/src/aeso_fcode_to_fate.erl
+++ b/src/aeso_fcode_to_fate.erl
@@ -18,7 +18,7 @@
 -define(i(__X__), {immediate, __X__}).
 -define(a, {stack, 0}).
 
--record(env, { args = [], stack = [], tailpos = true }).
+-record(env, { args = [], stack = [], locals = [], tailpos = true }).
 
 %% -- Debugging --------------------------------------------------------------
 
@@ -69,15 +69,18 @@ init_env(Args) ->
     #env{ args = Args, stack = [], tailpos = true }.
 
 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 }.
 
-lookup_var(#env{ args = Args, stack = S }, X) ->
-    case {keyfind_index(X, 1, S), keyfind_index(X, 1, Args)} of
-        {false, false} -> false;
+lookup_var(Env = #env{ args = Args, locals = Locals }, X) ->
+    case {find_index(X, Locals), keyfind_index(X, 1, Args)} of
+        {false, false} -> error({unbound_variable, X, Env});
         {false, Arg}   -> {arg, Arg};
-        {Local, _}     -> {stack, Local}
+        {Local, _}     -> {var, Local}
     end.
 
 %% -- The compiler --
@@ -86,23 +89,30 @@ to_scode(_Env, {integer, N}) ->
     [aeb_fate_code:push(?i(N))];    %% Doesn't exist (yet), translated by desugaring
 
 to_scode(Env, {var, X}) ->
-    case lookup_var(Env, X) of
-        false      -> error({unbound_variable, X, Env});
-        {stack, N} -> [aeb_fate_code:dup(?i(N))];
-        {arg, N}   -> [aeb_fate_code:push({arg, N})]
-    end;
+    [aeb_fate_code:push(lookup_var(Env, X))];
 
 to_scode(Env, {binop, Type, Op, A, B}) ->
-    [ to_scode(notail(Env), B)
-    , to_scode(push_env(Type, Env), A)
-    , binop_to_scode(Op) ];
+    [ to_scode(notail(Env), B),
+      to_scode(push_env(Type, Env), A),
+      binop_to_scode(Op) ];
 
 to_scode(Env, {'if', Dec, Then, Else}) ->
-    [ to_scode(notail(Env), Dec)
-    , {ifte, to_scode(Env, Then), to_scode(Env, Else)} ];
+    [ to_scode(notail(Env), Dec),
+      {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).
 
+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 --
 
 binop_to_scode('+') -> add_a_a_a();  %% Optimization introduces other variants
@@ -283,3 +293,9 @@ keyfind_index(X, J, Xs) ->
         []      -> false
     end.
 
+find_index(X, Xs) ->
+    case lists:keyfind(X, 2, with_ixs(Xs)) of
+        {I, _} -> I;
+        false  -> false
+    end.
+