Clearer distinction between applied and unapplied top-level things (def/builtin) in fcode

This commit is contained in:
Ulf Norell 2019-05-07 09:39:50 +02:00
parent 2ef94b03ec
commit 182f30133b
2 changed files with 87 additions and 76 deletions

View File

@ -44,7 +44,6 @@
| {var, var_name()} | {var, var_name()}
| {def, fun_name(), [fexpr()]} | {def, fun_name(), [fexpr()]}
| {remote, fexpr(), fun_name(), [fexpr()]} | {remote, fexpr(), fun_name(), [fexpr()]}
| {builtin, builtin(), non_neg_integer() | none} %% Unapplied builtin
| {builtin, builtin(), [fexpr()]} | {builtin, builtin(), [fexpr()]}
| {con, arities(), tag(), [fexpr()]} | {con, arities(), tag(), [fexpr()]}
| {tuple, [fexpr()]} | {tuple, [fexpr()]}
@ -53,9 +52,15 @@
| {op, op(), [fexpr()]} | {op, op(), [fexpr()]}
| {'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
| {closure, fun_name(), fexpr()} | {closure, fun_name(), fexpr()}
| {switch, fsplit()}. | {switch, fsplit()}
%% The following (unapplied top-level functions/builtins and
%% lambdas) are generated by the fcode compiler, but translated
%% to closures by the lambda lifter.
| {def_u, fun_name(), arity()}
| {remote_u, fexpr(), fun_name(), arity()}
| {builtin_u, builtin(), arity()}
| {lam, [var_name()], fexpr()}.
-type fsplit() :: {split, ftype(), var_name(), [fcase()]} -type fsplit() :: {split, ftype(), var_name(), [fcase()]}
| {nosplit, fexpr()}. | {nosplit, fexpr()}.
@ -102,7 +107,7 @@
-type type_def() :: fun(([ftype()]) -> ftype()). -type type_def() :: fun(([ftype()]) -> ftype()).
-type tag() :: non_neg_integer(). -type tag() :: non_neg_integer().
-type arities() :: [non_neg_integer()]. -type arities() :: [arity()].
-record(con_tag, { tag :: tag(), arities :: arities() }). -record(con_tag, { tag :: tag(), arities :: arities() }).
-type con_tag() :: #con_tag{}. -type con_tag() :: #con_tag{}.
@ -453,10 +458,9 @@ 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_to_fcode(B, FArgs); {builtin_u, B, _Ar} -> builtin_to_fcode(B, FArgs);
{def, F, Ar} when is_integer(Ar) -> {def, F, FArgs}; {def_u, F, _Ar} -> {def, F, FArgs};
{remote_u, Ct, RFun, _Ar} -> {remote_u, Ct, RFun, _Ar} -> {remote, Ct, RFun, FArgs};
{remote, Ct, RFun, 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
@ -470,7 +474,7 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT,
%% Maps %% Maps
expr_to_fcode(_Env, _Type, {map, _, []}) -> expr_to_fcode(_Env, _Type, {map, _, []}) ->
{builtin, map_empty, none}; {builtin, map_empty, []};
expr_to_fcode(Env, Type, {map, Ann, KVs}) -> expr_to_fcode(Env, Type, {map, Ann, KVs}) ->
%% Cheaper to do incremental map_update than building the list and doing %% Cheaper to do incremental map_update than building the list and doing
%% map_from_list (I think). %% map_from_list (I think).
@ -786,12 +790,12 @@ make_closure(FVs, Xs, Body) ->
lambda_lift_expr({lam, Xs, Body}) -> lambda_lift_expr({lam, Xs, Body}) ->
FVs = free_vars({lam, Xs, Body}), FVs = free_vars({lam, Xs, Body}),
make_closure(FVs, Xs, lambda_lift_expr(Body)); make_closure(FVs, Xs, lambda_lift_expr(Body));
lambda_lift_expr({Tag, F, Ar}) when is_integer(Ar), Tag == def orelse Tag == builtin -> lambda_lift_expr({Tag, F, Ar}) when Tag == def_u; Tag == builtin_u ->
Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ], Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ],
Args = [{var, X} || X <- Xs], Args = [{var, X} || X <- Xs],
Body = case Tag of Body = case Tag of
builtin -> builtin_to_fcode(F, Args); builtin_u -> builtin_to_fcode(F, Args);
def -> {def, F, Args} def_u -> {def, F, Args}
end, end,
make_closure([], Xs, Body); make_closure([], Xs, Body);
lambda_lift_expr({remote_u, Ct, F, Ar}) -> lambda_lift_expr({remote_u, Ct, F, Ar}) ->
@ -813,9 +817,7 @@ lambda_lift_expr(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} -> {builtin, B, lambda_lift_exprs(As)};
-> {builtin, B, lambda_lift_exprs(As)};
{builtin, _, _} -> Expr;
{remote, Ct, F, As} -> {remote, lambda_lift_expr(Ct), F, lambda_lift_exprs(As)}; {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)}; {con, Ar, C, As} -> {con, Ar, C, lambda_lift_exprs(As)};
{tuple, As} -> {tuple, lambda_lift_exprs(As)}; {tuple, As} -> {tuple, lambda_lift_exprs(As)};
@ -946,8 +948,9 @@ resolve_var(Env, Q) -> resolve_fun(Env, Q).
resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) -> 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, none}} -> {builtin, B, []};
{{Fun, Ar}, _} -> {def, Fun, Ar} {_, {B, Ar}} -> {builtin_u, B, Ar};
{{Fun, Ar}, _} -> {def_u, Fun, Ar}
end. end.
init_fresh_names() -> init_fresh_names() ->
@ -992,25 +995,25 @@ free_vars(Expr) ->
{oracle_query_id, _} -> []; {oracle_query_id, _} -> [];
{bool, _} -> []; {bool, _} -> [];
nil -> []; nil -> [];
{def, _, As} when is_list(As) -> []; {def, _, As} -> free_vars(As);
{def, _, _} -> []; {def_u, _, _} -> [];
{remote_u, Ct, _, _} -> free_vars(Ct);
{remote, Ct, _, As} -> free_vars([Ct | As]); {remote, Ct, _, As} -> free_vars([Ct | As]);
{builtin, _, As} when is_list(As) -> free_vars(As); {remote_u, Ct, _, _} -> free_vars(Ct);
{builtin, _, _} -> []; {builtin, _, As} -> free_vars(As);
{con, _, _, As} -> free_vars(As); {builtin_u, _, _} -> [];
{tuple, As} -> free_vars(As); {con, _, _, As} -> free_vars(As);
{proj, A, _} -> free_vars(A); {tuple, As} -> free_vars(As);
{set_proj, A, _, B} -> free_vars([A, B]); {proj, A, _} -> free_vars(A);
{op, _, As} -> free_vars(As); {set_proj, A, _, B} -> free_vars([A, B]);
{'let', X, A, B} -> free_vars([A, {lam, [X], B}]); {op, _, As} -> free_vars(As);
{funcall, A, Bs} -> free_vars([A | Bs]); {'let', X, A, B} -> free_vars([A, {lam, [X], B}]);
{lam, Xs, B} -> free_vars(B) -- lists:sort(Xs); {funcall, A, Bs} -> free_vars([A | Bs]);
{closure, _, A} -> free_vars(A); {lam, Xs, B} -> free_vars(B) -- lists:sort(Xs);
{switch, A} -> free_vars(A); {closure, _, A} -> free_vars(A);
{split, _, X, As} -> free_vars([{var, X} | As]); {switch, A} -> free_vars(A);
{nosplit, A} -> free_vars(A); {split, _, X, As} -> free_vars([{var, X} | As]);
{'case', P, A} -> free_vars(A) -- lists:sort(pat_vars(P)) {nosplit, A} -> free_vars(A);
{'case', P, A} -> free_vars(A) -- lists:sort(pat_vars(P))
end. end.
get_named_args(NamedArgsT, Args) -> get_named_args(NamedArgsT, Args) ->
@ -1031,26 +1034,35 @@ get_named_arg({named_arg_t, _, {id, _, Name}, _, Default}, Args) ->
-spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). -spec rename([{var_name(), var_name()}], fexpr()) -> fexpr().
rename(Ren, Expr) -> rename(Ren, Expr) ->
case Expr of case Expr of
{int, _} -> Expr; {int, _} -> Expr;
{string, _} -> Expr; {string, _} -> Expr;
{bool, _} -> Expr; {account_pubkey, _} -> Expr;
{account_pubkey, _} -> Expr; {contract_pubkey, _} -> Expr;
{contract_pubkey, _} -> Expr; {oracle_pubkey, _} -> Expr;
{oracle_pubkey, _} -> Expr; {oracle_query_id, _} -> Expr;
{oracle_query_id, _} -> Expr; {bool, _} -> Expr;
nil -> nil; nil -> nil;
{var, X} -> {var, rename_var(Ren, X)}; {var, X} -> {var, rename_var(Ren, X)};
{def, D, Es} -> {def, D, [rename(Ren, E) || E <- Es]}; {def, D, Es} -> {def, D, [rename(Ren, E) || E <- Es]};
{con, Ar, I, Es} -> {con, Ar, I, [rename(Ren, E) || E <- Es]}; {def_u, _, _} -> Expr;
{tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; {builtin, B, Es} -> {builtin, B, [rename(Ren, E) || E <- Es]};
{proj, E, I} -> {proj, rename(Ren, E), I}; {builtin_u, _, _} -> Expr;
{set_proj, R, I, E} -> {set_proj, rename(Ren, R), I, rename(Ren, E)}; {remote, Ct, F, Es} -> {remote, rename(Ren, Ct), F, [rename(Ren, E) || E <- Es]};
{op, Op, Es} -> {op, Op, [rename(Ren, E) || E <- Es]}; {remote_u, Ct, F, Ar} -> {remote_u, rename(Ren, Ct), F, Ar};
{funcall, Fun, Es} -> {funcall, rename(Ren, Fun), [rename(Ren, E) || E <- Es]}; {con, Ar, I, Es} -> {con, Ar, I, [rename(Ren, E) || E <- Es]};
{tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]};
{proj, E, I} -> {proj, rename(Ren, E), I};
{set_proj, R, I, E} -> {set_proj, rename(Ren, R), I, rename(Ren, E)};
{op, Op, Es} -> {op, Op, [rename(Ren, E) || E <- Es]};
{funcall, Fun, Es} -> {funcall, rename(Ren, Fun), [rename(Ren, E) || E <- Es]};
{closure, F, Env} -> {closure, F, rename(Ren, Env)};
{switch, Split} -> {switch, rename_split(Ren, Split)};
{lam, Xs, B} ->
{Zs, Ren1} = rename_bindings(Ren, Xs),
{lam, Zs, rename(Ren1, B)};
{'let', X, E, Body} -> {'let', X, E, Body} ->
{Z, Ren1} = rename_binding(Ren, X), {Z, Ren1} = rename_binding(Ren, X),
{'let', Z, rename(Ren, E), rename(Ren1, Body)}; {'let', Z, rename(Ren, E), rename(Ren1, Body)}
{switch, Split} -> {switch, rename_split(Ren, Split)}
end. end.
rename_var(Ren, X) -> proplists:get_value(X, Ren, X). rename_var(Ren, X) -> proplists:get_value(X, Ren, X).
@ -1207,7 +1219,7 @@ 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_fexpr({def_u, Fun, Ar}) ->
pp_beside([pp_fun_name(Fun), pp_text("/"), pp_text(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);
@ -1246,13 +1258,12 @@ pp_fexpr({op, Op, As}) ->
pp_fexpr({'let', X, A, B}) -> pp_fexpr({'let', X, A, B}) ->
pp_par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), pp_par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]),
pp_fexpr(B)]); pp_fexpr(B)]);
pp_fexpr({builtin, B, none}) -> pp_text(B); pp_fexpr({builtin_u, B, N}) ->
pp_fexpr({builtin, B, N}) when is_integer(N) ->
pp_beside([pp_text(B), pp_text("/"), pp_text(N)]); pp_beside([pp_text(B), pp_text("/"), pp_text(N)]);
pp_fexpr({builtin, B, As}) when is_list(As) -> pp_fexpr({builtin, B, As}) ->
pp_call(pp_text(B), As); pp_call(pp_text(B), As);
pp_fexpr({remote_u, Ct, Fun, _Ar}) -> pp_fexpr({remote_u, Ct, Fun, Ar}) ->
pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun)]); pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun), pp_text("/"), pp_text(Ar)]);
pp_fexpr({remote, Ct, Fun, As}) -> pp_fexpr({remote, Ct, Fun, As}) ->
pp_call(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun)]), As); pp_call(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun)]), As);
pp_fexpr({funcall, Fun, As}) -> pp_fexpr({funcall, Fun, As}) ->

View File

@ -377,18 +377,18 @@ call_to_scode(Env, CallCode, Args) ->
[[to_scode(notail(Env), A) || A <- lists:reverse(Args)], [[to_scode(notail(Env), A) || A <- lists:reverse(Args)],
CallCode]. CallCode].
builtin_to_scode(_Env, get_state, none) -> builtin_to_scode(_Env, get_state, []) ->
[push(?s)]; [push(?s)];
builtin_to_scode(Env, set_state, [_] = Args) -> builtin_to_scode(Env, set_state, [_] = Args) ->
call_to_scode(Env, [aeb_fate_code:store(?s, ?a), call_to_scode(Env, [aeb_fate_code:store(?s, ?a),
aeb_fate_code:tuple(0)], Args); aeb_fate_code:tuple(0)], Args);
builtin_to_scode(_Env, event, [_] = _Args) -> builtin_to_scode(_Env, event, [_] = _Args) ->
?TODO(fate_event_instruction); ?TODO(fate_event_instruction);
builtin_to_scode(_Env, map_empty, none) -> builtin_to_scode(_Env, map_empty, []) ->
[aeb_fate_code:map_empty(?a)]; [aeb_fate_code:map_empty(?a)];
builtin_to_scode(_Env, bits_none, none) -> builtin_to_scode(_Env, bits_none, []) ->
[aeb_fate_code:bits_none(?a)]; [aeb_fate_code:bits_none(?a)];
builtin_to_scode(_Env, bits_all, none) -> builtin_to_scode(_Env, bits_all, []) ->
[aeb_fate_code:bits_all(?a)]; [aeb_fate_code:bits_all(?a)];
builtin_to_scode(Env, abort, [_] = Args) -> builtin_to_scode(Env, abort, [_] = Args) ->
call_to_scode(Env, aeb_fate_code:abort(?a), Args); call_to_scode(Env, aeb_fate_code:abort(?a), Args);
@ -397,31 +397,31 @@ builtin_to_scode(Env, chain_spend, [_, _] = Args) ->
aeb_fate_code:tuple(0)], Args); aeb_fate_code:tuple(0)], Args);
builtin_to_scode(Env, chain_balance, [_] = Args) -> builtin_to_scode(Env, chain_balance, [_] = Args) ->
call_to_scode(Env, aeb_fate_code:balance_other(?a, ?a), Args); call_to_scode(Env, aeb_fate_code:balance_other(?a, ?a), Args);
builtin_to_scode(_Env, chain_block_hash, [{builtin, chain_block_height, none}]) -> builtin_to_scode(_Env, chain_block_hash, [{builtin, chain_block_height, []}]) ->
[aeb_fate_code:blockhash(?a)]; [aeb_fate_code:blockhash(?a)];
builtin_to_scode(_Env, chain_block_hash, [_]) -> builtin_to_scode(_Env, chain_block_hash, [_]) ->
?TODO(fate_block_hash_at_height_instruction); ?TODO(fate_block_hash_at_height_instruction);
builtin_to_scode(_Env, chain_coinbase, none) -> builtin_to_scode(_Env, chain_coinbase, []) ->
[aeb_fate_code:beneficiary(?a)]; [aeb_fate_code:beneficiary(?a)];
builtin_to_scode(_Env, chain_timestamp, none) -> builtin_to_scode(_Env, chain_timestamp, []) ->
[aeb_fate_code:timestamp(?a)]; [aeb_fate_code:timestamp(?a)];
builtin_to_scode(_Env, chain_block_height, none) -> builtin_to_scode(_Env, chain_block_height, []) ->
[aeb_fate_code:generation(?a)]; [aeb_fate_code:generation(?a)];
builtin_to_scode(_Env, chain_difficulty, none) -> builtin_to_scode(_Env, chain_difficulty, []) ->
[aeb_fate_code:difficulty(?a)]; [aeb_fate_code:difficulty(?a)];
builtin_to_scode(_Env, chain_gas_limit, none) -> builtin_to_scode(_Env, chain_gas_limit, []) ->
[aeb_fate_code:gaslimit(?a)]; [aeb_fate_code:gaslimit(?a)];
builtin_to_scode(_Env, contract_balance, none) -> builtin_to_scode(_Env, contract_balance, []) ->
[aeb_fate_code:balance(?a)]; [aeb_fate_code:balance(?a)];
builtin_to_scode(_Env, contract_address, none) -> builtin_to_scode(_Env, contract_address, []) ->
[aeb_fate_code:address(?a)]; [aeb_fate_code:address(?a)];
builtin_to_scode(_Env, call_origin, none) -> builtin_to_scode(_Env, call_origin, []) ->
[aeb_fate_code:origin(?a)]; [aeb_fate_code:origin(?a)];
builtin_to_scode(_Env, call_caller, none) -> builtin_to_scode(_Env, call_caller, []) ->
[aeb_fate_code:caller(?a)]; [aeb_fate_code:caller(?a)];
builtin_to_scode(_Env, call_value, none) -> builtin_to_scode(_Env, call_value, []) ->
?TODO(fate_call_value_instruction); ?TODO(fate_call_value_instruction);
builtin_to_scode(_Env, call_gas_price, none) -> builtin_to_scode(_Env, call_gas_price, []) ->
[aeb_fate_code:gasprice(?a)]; [aeb_fate_code:gasprice(?a)];
builtin_to_scode(_Env, call_gas_left, []) -> builtin_to_scode(_Env, call_gas_left, []) ->
[aeb_fate_code:gas(?a)]; [aeb_fate_code:gas(?a)];
@ -459,7 +459,7 @@ builtin_to_scode(_Env, crypto_sha256, [_] = _Args) ->
?TODO(fate_crypto_sha256_instruction); ?TODO(fate_crypto_sha256_instruction);
builtin_to_scode(_Env, crypto_blake2b, [_] = _Args) -> builtin_to_scode(_Env, crypto_blake2b, [_] = _Args) ->
?TODO(fate_crypto_blake2b_instruction); ?TODO(fate_crypto_blake2b_instruction);
builtin_to_scode(_Env, auth_tx_hash, none) -> builtin_to_scode(_Env, auth_tx_hash, []) ->
?TODO(fate_auth_tx_hash_instruction); ?TODO(fate_auth_tx_hash_instruction);
builtin_to_scode(_, B, Args) -> builtin_to_scode(_, B, Args) ->
?TODO({builtin, B, Args}). ?TODO({builtin, B, Args}).