Compile remote calls

src/aeso_ast_to_fcode.erl

@@ -43,6 +43,7 @@
                | nil
                | {var, var_name()}
                | {def, fun_name(), [fexpr()]}
+               | {remote, fexpr(), fun_name(), [fexpr()]}
                | {builtin, builtin(), non_neg_integer() | none} %% Unapplied builtin
                | {builtin, builtin(), [fexpr()]}
                | {con, arities(), tag(), [fexpr()]}
@@ -296,6 +297,7 @@ type_to_fcode(Env, Type) ->
     type_to_fcode(Env, #{}, Type).
 
 -spec type_to_fcode(env(), #{var_name() => ftype()}, aeso_syntax:type()) -> ftype().
+type_to_fcode(_Env, _Sub, {con, _, _}) -> contract;
 type_to_fcode(Env, Sub, {app_t, _, T = {Id, _, _}, Types}) when Id == id; Id == qid ->
     lookup_type(Env, T, [type_to_fcode(Env, Sub, Type) || Type <- Types]);
 type_to_fcode(Env, _Sub, T = {Id, _, _}) when Id == id; Id == qid ->
@@ -309,8 +311,10 @@ type_to_fcode(_Env, _Sub, {bytes_t, _, _N}) ->
     string; %% TODO: add bytes type to FATE?
 type_to_fcode(_Env, Sub, {tvar, _, X}) ->
     maps:get(X, Sub, any);
-type_to_fcode(Env, Sub, {fun_t, _, [], Args, Res}) ->
+type_to_fcode(Env, Sub, {fun_t, _, Named, Args, Res}) ->
-    {function, [type_to_fcode(Env, Sub, Arg) || Arg <- Args], type_to_fcode(Env, Sub, Res)};
+    FNamed = [type_to_fcode(Env, Sub, Arg) || {named_arg_t, _, _, Arg, _} <- Named],
+    FArgs  = [type_to_fcode(Env, Sub, Arg) || Arg <- Args],
+    {function, FNamed ++ FArgs, type_to_fcode(Env, Sub, Res)};
 type_to_fcode(_Env, _Sub, Type) ->
     error({todo, Type}).
 
@@ -358,8 +362,15 @@ expr_to_fcode(Env, _Type, {tuple, _, Es}) ->
     {tuple, [expr_to_fcode(Env, E) || E <- Es]};
 
 %% Records
-expr_to_fcode(Env, _Type, {proj, _Ann, Rec, X}) ->
+expr_to_fcode(Env, Type, {proj, _Ann, Rec = {typed, _, _, RecType}, {id, _, X}}) ->
-    {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)};
+    case RecType of
+        {con, _, _} ->
+            {fun_t, _, Named, Args, _} = Type,
+            Arity = length(Named) + length(Args),
+            {remote_u, expr_to_fcode(Env, Rec), {entrypoint, list_to_binary(X)}, Arity};
+        {record_t, _} ->
+            {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)}
+    end;
 
 expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) ->
     FVal = fun(F) ->
@@ -444,6 +455,8 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT,
     case expr_to_fcode(Env, Fun) of
         {builtin, B, Ar} when is_integer(Ar) -> builtin_to_fcode(B, FArgs);
         {def, F, Ar}     when is_integer(Ar) -> {def, F, FArgs};
+        {remote_u, Ct, RFun, _Ar} ->
+            {remote, Ct, RFun, FArgs};
         FFun ->
             %% FFun is a closure, with first component the function name and
             %% second component the environment
@@ -765,12 +778,14 @@ lifted_fun(FVs, Xs, Body) ->
        body   => lists:foldr(Proj, Body, indexed(FVs))
      }.
 
+make_closure(FVs, Xs, Body) ->
+    Fun   = add_lambda_fun(lifted_fun(FVs, Xs, Body)),
+    Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end,
+    {closure, Fun, Tup([{var, Y} || Y <- FVs])}.
+
 lambda_lift_expr({lam, Xs, Body}) ->
     FVs   = free_vars({lam, Xs, Body}),
-    Body1 = lambda_lift_expr(Body),
+    make_closure(FVs, Xs, lambda_lift_expr(Body));
-    Fun   = add_lambda_fun(lifted_fun(FVs, Xs, Body1)),
-    Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end,
-    {closure, Fun, Tup([{var, Y} || Y <- FVs])};
 lambda_lift_expr({Tag, F, Ar}) when is_integer(Ar), Tag == def orelse Tag == builtin ->
     Xs   = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ],
     Args = [{var, X} || X <- Xs],
@@ -778,8 +793,13 @@ lambda_lift_expr({Tag, F, Ar}) when is_integer(Ar), Tag == def orelse Tag == bui
                builtin -> builtin_to_fcode(F, Args);
                def     -> {def, F, Args}
            end,
-    Fun = add_lambda_fun(lifted_fun([], Xs, Body)),
+    make_closure([], Xs, Body);
-    {closure, Fun, {tuple, []}};
+lambda_lift_expr({remote_u, Ct, F, Ar}) ->
+    FVs  = free_vars(Ct),
+    Ct1  = lambda_lift_expr(Ct),
+    Xs   = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ],
+    Args = [{var, X} || X <- Xs],
+    make_closure(FVs, Xs, {remote, Ct1, F, Args});
 lambda_lift_expr(Expr) ->
     case Expr of
         {int, _}               -> Expr;
@@ -796,6 +816,7 @@ lambda_lift_expr(Expr) ->
         {builtin, B, As} when is_list(As)
                                -> {builtin, B, lambda_lift_exprs(As)};
         {builtin, _, _}        -> Expr;
+        {remote, Ct, F, As}    -> {remote, lambda_lift_expr(Ct), F, lambda_lift_exprs(As)};
         {con, Ar, C, As}       -> {con, Ar, C, lambda_lift_exprs(As)};
         {tuple, As}            -> {tuple, lambda_lift_exprs(As)};
         {proj, A, I}           -> {proj, lambda_lift_expr(A), I};
@@ -861,7 +882,7 @@ bind_constructors(Env = #{ con_env := ConEnv }, NewCons) ->
 %% -- Names --
 
 -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env().
-add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{};  %% no functions from abstract contracts
+add_fun_env(Env = #{ context := {abstract_contract, _} }, _) -> Env;  %% no functions from abstract contracts
 add_fun_env(Env = #{ fun_env := FunEnv }, Decls) ->
     Entry = fun({letfun, Ann, {id, _, Name}, Args, _, _}) ->
                 [{qname(Env, Name), {make_fun_name(Env, Ann, Name), length(Args)}}];
@@ -971,7 +992,10 @@ free_vars(Expr) ->
         {oracle_query_id, _} -> [];
         {bool, _}            -> [];
         nil                  -> [];
-        {def, _}             -> [];
+        {def, _, As} when is_list(As) -> [];
+        {def, _, _}          -> [];
+        {remote_u, Ct, _, _} -> free_vars(Ct);
+        {remote, Ct, _, As}  -> free_vars([Ct | As]);
         {builtin, _, As} when is_list(As) -> free_vars(As);
         {builtin, _, _}     -> [];
         {con, _, _, As}     -> free_vars(As);
@@ -1099,7 +1123,7 @@ rename_case(Ren, {'case', Pat, Split}) ->
 
 field_index({typed, _, _, RecTy}, X) ->
     field_index(RecTy, X);
-field_index({record_t, Fields}, {id, _, X}) ->
+field_index({record_t, Fields}, X) ->
     IsX = fun({field_t, _, {id, _, Y}, _}) -> X == Y end,
     [I] = [ I || {I, Field} <- indexed(Fields), IsX(Field) ],
     I - 1.  %% Tuples are 0-indexed
@@ -1227,6 +1251,10 @@ pp_fexpr({builtin, B, N}) when is_integer(N) ->
     pp_beside([pp_text(B), pp_text("/"), pp_text(N)]);
 pp_fexpr({builtin, B, As}) when is_list(As) ->
     pp_call(pp_text(B), As);
+pp_fexpr({remote_u, Ct, Fun, _Ar}) ->
+    pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun)]);
+pp_fexpr({remote, Ct, Fun, As}) ->
+    pp_call(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun)]), As);
 pp_fexpr({funcall, Fun, As}) ->
     pp_call(pp_fexpr(Fun), As);
 pp_fexpr({switch, Split}) -> pp_split(Split).

src/aeso_fcode_to_fate.erl

@@ -141,6 +141,7 @@ type_to_scode({list, Type})    -> {list, type_to_scode(Type)};
 type_to_scode({tuple, Types})  -> {tuple, lists:map(fun type_to_scode/1, Types)};
 type_to_scode({map, Key, Val}) -> {map, type_to_scode(Key), type_to_scode(Val)};
 type_to_scode({function, _Args, _Res}) -> {tuple, [string, any]};
+type_to_scode(contract)        -> address;
 type_to_scode(T)               -> T.
 
 %% -- Phase I ----------------------------------------------------------------
@@ -189,7 +190,7 @@ to_scode(_Env, {account_pubkey, K}) ->
     [push(?i(aeb_fate_data:make_address(K)))];
 
 to_scode(_Env, {contract_pubkey, K}) ->
-    [push(?i(aeb_fate_data:make_contract(K)))];
+    [push(?i(aeb_fate_data:make_address(K)))];
 
 to_scode(_Env, {oracle_pubkey, K}) ->
     [push(?i(aeb_fate_data:make_oracle(K)))];
@@ -238,28 +239,31 @@ to_scode(Env, {'let', X, Expr, Body}) ->
 to_scode(Env, {def, Fun, Args}) ->
     FName = make_function_name(Fun),
     Lbl   = aeb_fate_data:make_string(FName),
-    [ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)],
+    call_to_scode(Env, local_call(Env, ?i(Lbl)), Args);
-      local_call(Env, ?i(Lbl)) ];
 to_scode(Env, {funcall, Fun, Args}) ->
-    [ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)],
+    call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args);
-      to_scode(Env, Fun),
-      local_call(Env, ?a) ];
-
-to_scode(Env, {switch, Case}) ->
-    split_to_scode(Env, Case);
 
 to_scode(Env, {builtin, B, Args}) ->
     builtin_to_scode(Env, B, Args);
 
+to_scode(Env, {remote, Ct, Fun, [_Gas, _Value | Args]}) ->
+    %% TODO: FATE doesn't support value and gas arguments yet
+    Lbl  = make_function_name(Fun),
+    Call = if Env#env.tailpos -> aeb_fate_code:call_tr(?a, Lbl);
+              true            -> aeb_fate_code:call_r(?a, Lbl) end,
+    call_to_scode(Env, [to_scode(Env, Ct), Call], Args);
+
 to_scode(Env, {closure, Fun, FVs}) ->
     to_scode(Env, {tuple, [{string, make_function_name(Fun)}, FVs]});
 
+to_scode(Env, {switch, Case}) ->
+    split_to_scode(Env, Case);
+
 to_scode(_Env, Icode) -> ?TODO(Icode).
 
 local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_code:call_t(Fun);
 local_call(_Env, Fun)                      -> aeb_fate_code:call(Fun).
 
-
 split_to_scode(Env, {nosplit, Expr}) ->
     [switch_body, to_scode(Env, Expr)];
 split_to_scode(Env, {split, {tuple, _}, X, Alts}) ->
@@ -1346,7 +1350,7 @@ split_calls({Ref, Code}) ->
 
 split_calls(Ref, [], Acc, Blocks) ->
     lists:reverse([{Ref, lists:reverse(Acc)} | Blocks]);
-split_calls(Ref, [I = {CALL, _} | Code], Acc, Blocks) when CALL == 'CALL'; CALL == 'CALL_R' ->
+split_calls(Ref, [I | Code], Acc, Blocks) when element(1, I) == 'CALL'; element(1, I) == 'CALL_R' ->
     split_calls(make_ref(), Code, [], [{Ref, lists:reverse([I | Acc])} | Blocks]);
 split_calls(Ref, [I | Code], Acc, Blocks) ->
     split_calls(Ref, Code, [I | Acc], Blocks).