Handle unapplied builtins and top-level functions
This commit is contained in:
parent
4c872c4690
commit
110466b08c
@ -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]
|
||||||
|
@ -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).
|
||||||
|
Loading…
x
Reference in New Issue
Block a user