Handle unapplied builtins and top-level functions

src/aeso_ast_to_fcode.erl

@@ -53,7 +53,7 @@
                | {'let', var_name(), fexpr(), fexpr()}
                | {funcall, fexpr(), [fexpr()]}  %% Call to unknown function
                | {lam, [var_name()], fexpr()}   %% Lambda lifted and turned into a closure before it gets to the scode compiler
-               | {closure, fun_name(), non_neg_integer(), fexpr()}
+               | {closure, fun_name(), fexpr()}
                | {switch, fsplit()}.
 
 -type fsplit() :: {split, ftype(), var_name(), [fcase()]}
@@ -107,7 +107,7 @@
 -type con_tag() :: #con_tag{}.
 
 -type type_env() :: #{ sophia_name() => type_def() }.
--type fun_env()  :: #{ sophia_name() => fun_name() }.
+-type fun_env()  :: #{ sophia_name() => {fun_name(), non_neg_integer()} }.
 -type con_env()  :: #{ sophia_name() => con_tag() }.
 -type builtins() :: #{ sophia_name() => {builtin(), non_neg_integer() | none} }.
 
@@ -437,12 +437,8 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT,
     Args1 = get_named_args(NamedArgsT, Args),
     FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1],
     case expr_to_fcode(Env, Fun) of
-        {builtin, B, Ar} when is_integer(Ar) ->
-            case length(FArgs) of
-                N when N == Ar -> builtin_to_fcode(B, FArgs);
-                N when N < Ar  -> error({todo, eta_expand, B, FArgs})
-            end;
-        {def, F} -> {def, F, FArgs};
+        {builtin, B, Ar} when is_integer(Ar) -> builtin_to_fcode(B, FArgs);
+        {def, F, Ar}     when is_integer(Ar) -> {def, F, FArgs};
         FFun ->
             %% FFun is a closure, with first component the function name and
             %% second component the environment
@@ -768,7 +764,16 @@ lambda_lift_expr({lam, Xs, Body}) ->
     Body1 = lambda_lift_expr(Body),
     Fun   = add_lambda_fun(lifted_fun(FVs, Xs, Body1)),
     Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end,
-    {closure, Fun, length(Xs), Tup([{var, Y} || Y <- FVs])};
+    {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],
+    Body = case Tag of
+               builtin -> builtin_to_fcode(F, Args);
+               def     -> {def, F, Args}
+           end,
+    Fun = add_lambda_fun(lifted_fun([], Xs, Body)),
+    {closure, Fun, {tuple, []}};
 lambda_lift_expr(Expr) ->
     case Expr of
         {int, _}               -> Expr;
@@ -780,7 +785,7 @@ lambda_lift_expr(Expr) ->
         {bool, _}              -> Expr;
         nil                    -> Expr;
         {var, _}               -> Expr;
-        {closure, _, _, _}     -> Expr;
+        {closure, _, _}        -> Expr;
         {def, D, As}           -> {def, D, lambda_lift_exprs(As)};
         {builtin, B, As} when is_list(As)
                                -> {builtin, B, lambda_lift_exprs(As)};
@@ -852,8 +857,8 @@ bind_constructors(Env = #{ con_env := ConEnv }, NewCons) ->
 -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env().
 add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{};  %% no functions from abstract contracts
 add_fun_env(Env = #{ fun_env := FunEnv }, Decls) ->
-    Entry = fun({letfun, Ann, {id, _, Name}, _, _, _}) ->
-                [{qname(Env, Name), make_fun_name(Env, Ann, Name)}];
+    Entry = fun({letfun, Ann, {id, _, Name}, Args, _, _}) ->
+                [{qname(Env, Name), {make_fun_name(Env, Ann, Name), length(Args)}}];
                (_) -> [] end,
     FunEnv1 = maps:from_list(lists:flatmap(Entry, Decls)),
     Env#{ fun_env := maps:merge(FunEnv, FunEnv1) }.
@@ -887,7 +892,7 @@ qname(Env, Name) ->
 lookup_fun(#{ fun_env := FunEnv }, Name) ->
     case maps:get(Name, FunEnv, false) of
         false      -> error({unbound_name, Name});
-        FName -> FName
+        {FName, _} -> FName
     end.
 
 -spec lookup_con(env(), aeso_syntax:con() | aeso_syntax:qcon() | sophia_name()) -> con_tag().
@@ -915,7 +920,7 @@ resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) ->
     case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of
         {not_found, not_found} -> fcode_error({unbound_variable, Q});
         {_, {B, Ar}}           -> {builtin, B, Ar};
-        {Fun, _}               -> {def, Fun}
+        {{Fun, Ar}, _}         -> {def, Fun, Ar}
     end.
 
 init_fresh_names() ->
@@ -971,7 +976,7 @@ free_vars(Expr) ->
         {'let', X, A, B}    -> free_vars([A, {lam, [X], B}]);
         {funcall, A, Bs}    -> free_vars([A | Bs]);
         {lam, Xs, B}        -> free_vars(B) -- lists:sort(Xs);
-        {closure, _, _, A} -> free_vars(A);
+        {closure, _, A}     -> free_vars(A);
         {switch, A}         -> free_vars(A);
         {split, _, X, As}   -> free_vars([{var, X} | As]);
         {nosplit, A}        -> free_vars(A);
@@ -1172,6 +1177,8 @@ pp_fexpr(nil) ->
     pp_text("[]");
 pp_fexpr({var, X})   -> pp_text(X);
 pp_fexpr({def, Fun}) -> pp_fun_name(Fun);
+pp_fexpr({def, Fun, Ar}) when is_integer(Ar) ->
+    pp_beside([pp_fun_name(Fun), pp_text("/"), pp_text(Ar)]);
 pp_fexpr({def, Fun, Args}) ->
     pp_call(pp_fun_name(Fun), Args);
 pp_fexpr({con, _, I, []}) ->
@@ -1186,7 +1193,7 @@ pp_fexpr({proj, E, I}) ->
 pp_fexpr({lam, Xs, A}) ->
     pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"),
             prettypr:nest(2, pp_fexpr(A))]);
-pp_fexpr({closure, Fun, _Ar, ClEnv}) ->
+pp_fexpr({closure, Fun, ClEnv}) ->
     FVs = case ClEnv of
               {tuple, Xs} -> Xs;
               {var, _}    -> [ClEnv]

src/aeso_fcode_to_fate.erl

@@ -250,7 +250,7 @@ to_scode(Env, {switch, Case}) ->
 to_scode(Env, {builtin, B, Args}) ->
     builtin_to_scode(Env, B, Args);
 
-to_scode(Env, {closure, Fun, _Ar, FVs}) ->
+to_scode(Env, {closure, Fun, FVs}) ->
     to_scode(Env, {tuple, [{string, make_function_name(Fun)}, FVs]});
 
 to_scode(_Env, Icode) -> ?TODO(Icode).