From 182f30133b9e391b3559c91228b23e63668517a3 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 7 May 2019 09:39:50 +0200 Subject: [PATCH] Clearer distinction between applied and unapplied top-level things (def/builtin) in fcode --- src/aeso_ast_to_fcode.erl | 129 ++++++++++++++++++++----------------- src/aeso_fcode_to_fate.erl | 34 +++++----- 2 files changed, 87 insertions(+), 76 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 1fb1d35..270e2dd 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -44,7 +44,6 @@ | {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()]} | {tuple, [fexpr()]} @@ -53,9 +52,15 @@ | {op, op(), [fexpr()]} | {'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(), 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()]} | {nosplit, fexpr()}. @@ -102,7 +107,7 @@ -type type_def() :: fun(([ftype()]) -> ftype()). -type tag() :: non_neg_integer(). --type arities() :: [non_neg_integer()]. +-type arities() :: [arity()]. -record(con_tag, { tag :: tag(), arities :: arities() }). -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), FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1], 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}; + {builtin_u, B, _Ar} -> builtin_to_fcode(B, FArgs); + {def_u, F, _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 @@ -470,7 +474,7 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT, %% Maps expr_to_fcode(_Env, _Type, {map, _, []}) -> - {builtin, map_empty, none}; + {builtin, map_empty, []}; expr_to_fcode(Env, Type, {map, Ann, KVs}) -> %% Cheaper to do incremental map_update than building the list and doing %% map_from_list (I think). @@ -786,12 +790,12 @@ make_closure(FVs, Xs, Body) -> lambda_lift_expr({lam, Xs, Body}) -> FVs = free_vars({lam, Xs, 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) ], Args = [{var, X} || X <- Xs], Body = case Tag of - builtin -> builtin_to_fcode(F, Args); - def -> {def, F, Args} + builtin_u -> builtin_to_fcode(F, Args); + def_u -> {def, F, Args} end, make_closure([], Xs, Body); lambda_lift_expr({remote_u, Ct, F, Ar}) -> @@ -813,9 +817,7 @@ lambda_lift_expr(Expr) -> {var, _} -> 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)}; - {builtin, _, _} -> Expr; + {builtin, B, As} -> {builtin, B, 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)}; {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) -> 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, Ar}, _} -> {def, Fun, Ar} + {_, {B, none}} -> {builtin, B, []}; + {_, {B, Ar}} -> {builtin_u, B, Ar}; + {{Fun, Ar}, _} -> {def_u, Fun, Ar} end. init_fresh_names() -> @@ -992,25 +995,25 @@ free_vars(Expr) -> {oracle_query_id, _} -> []; {bool, _} -> []; nil -> []; - {def, _, As} when is_list(As) -> []; - {def, _, _} -> []; - {remote_u, Ct, _, _} -> free_vars(Ct); + {def, _, As} -> free_vars(As); + {def_u, _, _} -> []; {remote, Ct, _, As} -> free_vars([Ct | As]); - {builtin, _, As} when is_list(As) -> free_vars(As); - {builtin, _, _} -> []; - {con, _, _, As} -> free_vars(As); - {tuple, As} -> free_vars(As); - {proj, A, _} -> free_vars(A); - {set_proj, A, _, B} -> free_vars([A, B]); - {op, _, As} -> free_vars(As); - {'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); - {switch, A} -> free_vars(A); - {split, _, X, As} -> free_vars([{var, X} | As]); - {nosplit, A} -> free_vars(A); - {'case', P, A} -> free_vars(A) -- lists:sort(pat_vars(P)) + {remote_u, Ct, _, _} -> free_vars(Ct); + {builtin, _, As} -> free_vars(As); + {builtin_u, _, _} -> []; + {con, _, _, As} -> free_vars(As); + {tuple, As} -> free_vars(As); + {proj, A, _} -> free_vars(A); + {set_proj, A, _, B} -> free_vars([A, B]); + {op, _, As} -> free_vars(As); + {'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); + {switch, A} -> free_vars(A); + {split, _, X, As} -> free_vars([{var, X} | As]); + {nosplit, A} -> free_vars(A); + {'case', P, A} -> free_vars(A) -- lists:sort(pat_vars(P)) end. 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(). rename(Ren, Expr) -> case Expr of - {int, _} -> Expr; - {string, _} -> Expr; - {bool, _} -> Expr; - {account_pubkey, _} -> Expr; - {contract_pubkey, _} -> Expr; - {oracle_pubkey, _} -> Expr; - {oracle_query_id, _} -> Expr; - nil -> nil; - {var, X} -> {var, rename_var(Ren, X)}; - {def, D, Es} -> {def, D, [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]}; + {int, _} -> Expr; + {string, _} -> Expr; + {account_pubkey, _} -> Expr; + {contract_pubkey, _} -> Expr; + {oracle_pubkey, _} -> Expr; + {oracle_query_id, _} -> Expr; + {bool, _} -> Expr; + nil -> nil; + {var, X} -> {var, rename_var(Ren, X)}; + {def, D, Es} -> {def, D, [rename(Ren, E) || E <- Es]}; + {def_u, _, _} -> Expr; + {builtin, B, Es} -> {builtin, B, [rename(Ren, E) || E <- Es]}; + {builtin_u, _, _} -> Expr; + {remote, Ct, F, Es} -> {remote, rename(Ren, Ct), F, [rename(Ren, E) || E <- Es]}; + {remote_u, Ct, F, Ar} -> {remote_u, rename(Ren, Ct), F, Ar}; + {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} -> {Z, Ren1} = rename_binding(Ren, X), - {'let', Z, rename(Ren, E), rename(Ren1, Body)}; - {switch, Split} -> {switch, rename_split(Ren, Split)} + {'let', Z, rename(Ren, E), rename(Ren1, Body)} end. rename_var(Ren, X) -> proplists:get_value(X, Ren, X). @@ -1207,7 +1219,7 @@ 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_fexpr({def_u, Fun, Ar}) -> pp_beside([pp_fun_name(Fun), pp_text("/"), pp_text(Ar)]); pp_fexpr({def, 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_par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), pp_fexpr(B)]); -pp_fexpr({builtin, B, none}) -> pp_text(B); -pp_fexpr({builtin, B, N}) when is_integer(N) -> +pp_fexpr({builtin_u, B, 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_fexpr({remote_u, Ct, Fun, _Ar}) -> - pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun)]); +pp_fexpr({remote_u, Ct, Fun, Ar}) -> + pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun), pp_text("/"), pp_text(Ar)]); 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}) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 34bd815..03275bc 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -377,18 +377,18 @@ call_to_scode(Env, CallCode, Args) -> [[to_scode(notail(Env), A) || A <- lists:reverse(Args)], CallCode]. -builtin_to_scode(_Env, get_state, none) -> +builtin_to_scode(_Env, get_state, []) -> [push(?s)]; builtin_to_scode(Env, set_state, [_] = Args) -> call_to_scode(Env, [aeb_fate_code:store(?s, ?a), aeb_fate_code:tuple(0)], Args); builtin_to_scode(_Env, event, [_] = _Args) -> ?TODO(fate_event_instruction); -builtin_to_scode(_Env, map_empty, none) -> +builtin_to_scode(_Env, map_empty, []) -> [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)]; -builtin_to_scode(_Env, bits_all, none) -> +builtin_to_scode(_Env, bits_all, []) -> [aeb_fate_code:bits_all(?a)]; builtin_to_scode(Env, abort, [_] = 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); builtin_to_scode(Env, chain_balance, [_] = 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)]; builtin_to_scode(_Env, chain_block_hash, [_]) -> ?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)]; -builtin_to_scode(_Env, chain_timestamp, none) -> +builtin_to_scode(_Env, chain_timestamp, []) -> [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)]; -builtin_to_scode(_Env, chain_difficulty, none) -> +builtin_to_scode(_Env, chain_difficulty, []) -> [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)]; -builtin_to_scode(_Env, contract_balance, none) -> +builtin_to_scode(_Env, contract_balance, []) -> [aeb_fate_code:balance(?a)]; -builtin_to_scode(_Env, contract_address, none) -> +builtin_to_scode(_Env, contract_address, []) -> [aeb_fate_code:address(?a)]; -builtin_to_scode(_Env, call_origin, none) -> +builtin_to_scode(_Env, call_origin, []) -> [aeb_fate_code:origin(?a)]; -builtin_to_scode(_Env, call_caller, none) -> +builtin_to_scode(_Env, call_caller, []) -> [aeb_fate_code:caller(?a)]; -builtin_to_scode(_Env, call_value, none) -> +builtin_to_scode(_Env, call_value, []) -> ?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)]; builtin_to_scode(_Env, call_gas_left, []) -> [aeb_fate_code:gas(?a)]; @@ -459,7 +459,7 @@ builtin_to_scode(_Env, crypto_sha256, [_] = _Args) -> ?TODO(fate_crypto_sha256_instruction); builtin_to_scode(_Env, crypto_blake2b, [_] = _Args) -> ?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); builtin_to_scode(_, B, Args) -> ?TODO({builtin, B, Args}).