Handle unapplied builtins and top-level functions

This commit is contained in:
Ulf Norell 2019-05-06 14:17:41 +02:00
parent 4c872c4690
commit 110466b08c
2 changed files with 47 additions and 40 deletions

View File

@ -53,7 +53,7 @@
| {'let', var_name(), fexpr(), fexpr()} | {'let', var_name(), fexpr(), fexpr()}
| {funcall, fexpr(), [fexpr()]} %% Call to unknown function | {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 | {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()}. | {switch, fsplit()}.
-type fsplit() :: {split, ftype(), var_name(), [fcase()]} -type fsplit() :: {split, ftype(), var_name(), [fcase()]}
@ -107,7 +107,7 @@
-type con_tag() :: #con_tag{}. -type con_tag() :: #con_tag{}.
-type type_env() :: #{ sophia_name() => type_def() }. -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 con_env() :: #{ sophia_name() => con_tag() }.
-type builtins() :: #{ sophia_name() => {builtin(), non_neg_integer() | none} }. -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), Args1 = get_named_args(NamedArgsT, Args),
FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1], FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1],
case expr_to_fcode(Env, Fun) of case expr_to_fcode(Env, Fun) of
{builtin, B, Ar} when is_integer(Ar) -> {builtin, B, Ar} when is_integer(Ar) -> builtin_to_fcode(B, FArgs);
case length(FArgs) of {def, F, Ar} when is_integer(Ar) -> {def, F, FArgs};
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};
FFun -> FFun ->
%% FFun is a closure, with first component the function name and %% FFun is a closure, with first component the function name and
%% second component the environment %% second component the environment
@ -768,7 +764,16 @@ lambda_lift_expr({lam, Xs, Body}) ->
Body1 = lambda_lift_expr(Body), Body1 = lambda_lift_expr(Body),
Fun = add_lambda_fun(lifted_fun(FVs, Xs, Body1)), Fun = add_lambda_fun(lifted_fun(FVs, Xs, Body1)),
Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end, 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) -> lambda_lift_expr(Expr) ->
case Expr of case Expr of
{int, _} -> Expr; {int, _} -> Expr;
@ -780,7 +785,7 @@ lambda_lift_expr(Expr) ->
{bool, _} -> Expr; {bool, _} -> Expr;
nil -> Expr; nil -> Expr;
{var, _} -> Expr; {var, _} -> Expr;
{closure, _, _, _} -> Expr; {closure, _, _} -> Expr;
{def, D, As} -> {def, D, lambda_lift_exprs(As)}; {def, D, As} -> {def, D, lambda_lift_exprs(As)};
{builtin, B, As} when is_list(As) {builtin, B, As} when is_list(As)
-> {builtin, B, lambda_lift_exprs(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(). -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env().
add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{}; %% no functions from abstract contracts add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{}; %% no functions from abstract contracts
add_fun_env(Env = #{ fun_env := FunEnv }, Decls) -> add_fun_env(Env = #{ fun_env := FunEnv }, Decls) ->
Entry = fun({letfun, Ann, {id, _, Name}, _, _, _}) -> Entry = fun({letfun, Ann, {id, _, Name}, Args, _, _}) ->
[{qname(Env, Name), make_fun_name(Env, Ann, Name)}]; [{qname(Env, Name), {make_fun_name(Env, Ann, Name), length(Args)}}];
(_) -> [] end, (_) -> [] end,
FunEnv1 = maps:from_list(lists:flatmap(Entry, Decls)), FunEnv1 = maps:from_list(lists:flatmap(Entry, Decls)),
Env#{ fun_env := maps:merge(FunEnv, FunEnv1) }. Env#{ fun_env := maps:merge(FunEnv, FunEnv1) }.
@ -886,8 +891,8 @@ qname(Env, Name) ->
-spec lookup_fun(env(), sophia_name()) -> fun_name(). -spec lookup_fun(env(), sophia_name()) -> fun_name().
lookup_fun(#{ fun_env := FunEnv }, Name) -> lookup_fun(#{ fun_env := FunEnv }, Name) ->
case maps:get(Name, FunEnv, false) of case maps:get(Name, FunEnv, false) of
false -> error({unbound_name, Name}); false -> error({unbound_name, Name});
FName -> FName {FName, _} -> FName
end. end.
-spec lookup_con(env(), aeso_syntax:con() | aeso_syntax:qcon() | sophia_name()) -> con_tag(). -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 case {maps:get(Q, Funs, not_found), maps:get(Q, Builtin, not_found)} of
{not_found, not_found} -> fcode_error({unbound_variable, Q}); {not_found, not_found} -> fcode_error({unbound_variable, Q});
{_, {B, Ar}} -> {builtin, B, Ar}; {_, {B, Ar}} -> {builtin, B, Ar};
{Fun, _} -> {def, Fun} {{Fun, Ar}, _} -> {def, Fun, Ar}
end. end.
init_fresh_names() -> init_fresh_names() ->
@ -951,31 +956,31 @@ free_vars(Xs) when is_list(Xs) ->
lists:umerge([ free_vars(X) || X <- Xs ]); lists:umerge([ free_vars(X) || X <- Xs ]);
free_vars(Expr) -> free_vars(Expr) ->
case Expr of case Expr of
{var, X} -> [X]; {var, X} -> [X];
{int, _} -> []; {int, _} -> [];
{string, _} -> []; {string, _} -> [];
{account_pubkey, _} -> []; {account_pubkey, _} -> [];
{contract_pubkey, _} -> []; {contract_pubkey, _} -> [];
{oracle_pubkey, _} -> []; {oracle_pubkey, _} -> [];
{oracle_query_id, _} -> []; {oracle_query_id, _} -> [];
{bool, _} -> []; {bool, _} -> [];
nil -> []; nil -> [];
{def, _} -> []; {def, _} -> [];
{builtin, _, As} when is_list(As) -> free_vars(As); {builtin, _, As} when is_list(As) -> free_vars(As);
{builtin, _, _} -> []; {builtin, _, _} -> [];
{con, _, _, As} -> free_vars(As); {con, _, _, As} -> free_vars(As);
{tuple, As} -> free_vars(As); {tuple, As} -> free_vars(As);
{proj, A, _} -> free_vars(A); {proj, A, _} -> free_vars(A);
{set_proj, A, _, B} -> free_vars([A, B]); {set_proj, A, _, B} -> free_vars([A, B]);
{op, _, As} -> free_vars(As); {op, _, As} -> free_vars(As);
{'let', X, A, B} -> free_vars([A, {lam, [X], B}]); {'let', X, A, B} -> free_vars([A, {lam, [X], B}]);
{funcall, A, Bs} -> free_vars([A | Bs]); {funcall, A, Bs} -> free_vars([A | Bs]);
{lam, Xs, B} -> free_vars(B) -- lists:sort(Xs); {lam, Xs, B} -> free_vars(B) -- lists:sort(Xs);
{closure, _, _, A} -> free_vars(A); {closure, _, A} -> free_vars(A);
{switch, A} -> free_vars(A); {switch, A} -> free_vars(A);
{split, _, X, As} -> free_vars([{var, X} | As]); {split, _, X, As} -> free_vars([{var, X} | As]);
{nosplit, A} -> free_vars(A); {nosplit, A} -> free_vars(A);
{'case', P, A} -> free_vars(A) -- lists:sort(pat_vars(P)) {'case', P, A} -> free_vars(A) -- lists:sort(pat_vars(P))
end. end.
get_named_args(NamedArgsT, Args) -> get_named_args(NamedArgsT, Args) ->
@ -1170,8 +1175,10 @@ pp_fexpr({Tag, Lit}) when Tag == int;
aeso_pretty:expr({Tag, [], Lit}); aeso_pretty:expr({Tag, [], Lit});
pp_fexpr(nil) -> pp_fexpr(nil) ->
pp_text("[]"); pp_text("[]");
pp_fexpr({var, X}) -> pp_text(X); pp_fexpr({var, X}) -> pp_text(X);
pp_fexpr({def, Fun}) -> pp_fun_name(Fun); 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_fexpr({def, Fun, Args}) ->
pp_call(pp_fun_name(Fun), Args); pp_call(pp_fun_name(Fun), Args);
pp_fexpr({con, _, I, []}) -> pp_fexpr({con, _, I, []}) ->
@ -1186,7 +1193,7 @@ pp_fexpr({proj, E, I}) ->
pp_fexpr({lam, Xs, A}) -> pp_fexpr({lam, Xs, A}) ->
pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"), pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"),
prettypr:nest(2, pp_fexpr(A))]); prettypr:nest(2, pp_fexpr(A))]);
pp_fexpr({closure, Fun, _Ar, ClEnv}) -> pp_fexpr({closure, Fun, ClEnv}) ->
FVs = case ClEnv of FVs = case ClEnv of
{tuple, Xs} -> Xs; {tuple, Xs} -> Xs;
{var, _} -> [ClEnv] {var, _} -> [ClEnv]

View File

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