From 8a5c64ad45171bee4f2eb20ba052a2c40081efdc Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 15:05:38 +0200 Subject: [PATCH] Compile function calls (to fully saturated top-level functions only) --- src/aeso_ast_to_fcode.erl | 20 +++++--- src/aeso_fcode_to_fate.erl | 102 ++++++++++++++++++++++++++++--------- 2 files changed, 91 insertions(+), 31 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 218fc7d..57e06d4 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -35,7 +35,7 @@ | {oracle_query_id, binary()} | {bool, false | true} | nil - | {var, var_name()} + | {var, sophia_name()} | {con, arities(), tag(), [fexpr()]} | {tuple, [fexpr()]} | {proj, fexpr(), integer()} @@ -43,6 +43,7 @@ | {op, binop(), fexpr(), fexpr()} | {op, unop(), fexpr()} | {'let', var_name(), fexpr(), fexpr()} + | {funcall, fexpr(), [fexpr()]} | {switch, fsplit()}. -type fsplit() :: {split, ftype(), var_name(), [fcase()]} @@ -73,7 +74,8 @@ | name | channel | bits - | {variant, [[ftype()]]}. + | {variant, [[ftype()]]} + | any. -type fun_def() :: #{ attrs := [attribute()], args := [{var_name(), ftype()}], @@ -244,11 +246,8 @@ type_to_fcode(Env, Sub, {tuple_t, _, Types}) -> type_to_fcode(Env, Sub, {record_t, Fields}) -> FieldType = fun({field_t, _, _, Ty}) -> Ty end, type_to_fcode(Env, Sub, {tuple_t, [], lists:map(FieldType, Fields)}); -type_to_fcode(_Env, Sub, {tvar, _, X} = Type) -> - case maps:get(X, Sub, not_found) of - not_found -> {todo, polymorphism, Type}; - FType -> FType - end; +type_to_fcode(_Env, Sub, {tvar, _, X}) -> + maps:get(X, Sub, any); type_to_fcode(_Env, _Sub, Type) -> error({todo, Type}). @@ -275,7 +274,8 @@ expr_to_fcode(_Env, _Type, {oracle_pubkey, _, K}) -> {oracle_pubkey, K}; expr_to_fcode(_Env, _Type, {oracle_query_id, _, K}) -> {oracle_query_id, K}; %% Variables -expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; +expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, [X]}; +expr_to_fcode(_Env, _Type, {qid, _, X}) -> {var, X}; %% Constructors expr_to_fcode(Env, Type, {C, _, _} = Con) when C == con; C == qcon -> @@ -369,6 +369,10 @@ expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) -> '!' -> {op, '!', expr_to_fcode(Env, A)} end; +%% Function calls +expr_to_fcode(Env, _Type, {app, _Ann, Fun, Args}) -> + {funcall, expr_to_fcode(Env, Fun), [expr_to_fcode(Env, Arg) || Arg <- Args]}; + expr_to_fcode(_Env, Type, Expr) -> error({todo, {Expr, ':', Type}}). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 58cf387..1ba49c7 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -90,7 +90,7 @@ Op =:= 'BITS_DIFF' orelse false)). --record(env, { vars = [], locals = [], tailpos = true }). +-record(env, { contract, vars = [], locals = [], tailpos = true }). %% -- Debugging -------------------------------------------------------------- @@ -104,11 +104,11 @@ debug(Tag, Options, Fmt, Args) -> %% -- Main ------------------------------------------------------------------- %% @doc Main entry point. -compile(ICode, Options) -> - #{ contract_name := _ContractName, +compile(FCode, Options) -> + #{ contract_name := ContractName, state_type := _StateType, - functions := Functions } = ICode, - SFuns = functions_to_scode(Functions, Options), + functions := Functions } = FCode, + SFuns = functions_to_scode(ContractName, Functions, Options), SFuns1 = optimize_scode(SFuns, Options), BBFuns = to_basic_blocks(SFuns1, Options), FateCode = #{ functions => BBFuns, @@ -121,18 +121,19 @@ make_function_name(init) -> <<"init">>; make_function_name({entrypoint, Name}) -> Name; make_function_name({local_fun, Xs}) -> list_to_binary("." ++ string:join(Xs, ".")). -functions_to_scode(Functions, Options) -> +functions_to_scode(ContractName, Functions, Options) -> + FunNames = maps:keys(Functions), maps:from_list( - [ {make_function_name(Name), function_to_scode(Name, Args, Body, Type, Options)} + [ {make_function_name(Name), function_to_scode(ContractName, FunNames, Name, Args, Body, Type, Options)} || {Name, #{args := Args, body := Body, return := Type}} <- maps:to_list(Functions), Name /= init ]). %% TODO: skip init for now -function_to_scode(Name, Args, Body, ResType, Options) -> +function_to_scode(ContractName, Functions, Name, Args, Body, ResType, Options) -> debug(scode, Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, ResType, Body]), ArgTypes = [ type_to_scode(T) || {_, T} <- Args ], - SCode = to_scode(init_env(Args), Body), + SCode = to_scode(init_env(ContractName, Functions, Args), Body), debug(scode, Options, " scode: ~p\n", [SCode]), {{ArgTypes, type_to_scode(ResType)}, SCode}. @@ -147,15 +148,17 @@ type_to_scode(T) -> T. %% -- Environment functions -- -init_env(Args) -> - #env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], - tailpos = true }. +init_env(ContractName, FunNames, Args) -> + #env{ vars = [ {[X], {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], + contract = ContractName, + locals = FunNames, + tailpos = true }. next_var(#env{ vars = Vars }) -> 1 + lists:max([-1 | [J || {_, {var, J}} <- Vars]]). bind_var(Name, Var, Env = #env{ vars = Vars }) -> - Env#env{ vars = [{Name, Var} | Vars] }. + Env#env{ vars = [{[Name], Var} | Vars] }. bind_local(Name, Env) -> I = next_var(Env), @@ -163,10 +166,30 @@ bind_local(Name, Env) -> notail(Env) -> Env#env{ tailpos = false }. -lookup_var(Env = #env{ vars = Vars }, X) -> +code_error(Err) -> error(Err). + +lookup_var(Env, X = [N | _]) when is_integer(N) -> + lookup_var(Env, [X]); +lookup_var(Env, X) -> + case resolve_name(Env, X) of + {var, Var} -> Var; + _ -> code_error({unbound_variable, X, Env}) + end. + +resolve_name(#env{ vars = Vars, contract = Contract, locals = Funs }, X) -> case lists:keyfind(X, 1, Vars) of - false -> error({unbound_variable, X, Env}); - {_, Var} -> Var + {_, Var} -> {var, Var}; + false -> + case X of + [Lib, Fun] -> + EntryPoint = Lib == Contract andalso lists:member({entrypoint, Fun}, Funs), + LocalFun = lists:member({local_fun, X}, Funs), + if EntryPoint -> {def, make_function_name({entrypoint, Fun})}; + LocalFun -> {def, make_function_name({local_fun, X})}; + true -> not_found end; + _ -> + not_found + end end. %% -- The compiler -- @@ -200,21 +223,21 @@ to_scode(Env, {var, X}) -> to_scode(Env, {con, Ar, I, As}) -> N = length(As), - [[to_scode(Env, A) || A <- As], + [[to_scode(notail(Env), A) || A <- As], aeb_fate_code:variant(?a, ?i(Ar), ?i(I), ?i(N))]; to_scode(Env, {tuple, As}) -> N = length(As), - [[ to_scode(Env, A) || A <- As ], + [[ to_scode(notail(Env), A) || A <- As ], aeb_fate_code:tuple(N)]; to_scode(Env, {proj, E, I}) -> - [to_scode(Env, E), + [to_scode(notail(Env), E), aeb_fate_code:element_op(?a, ?i(I), ?a)]; to_scode(Env, {set_proj, R, I, E}) -> - [to_scode(Env, E), - to_scode(Env, R), + [to_scode(notail(Env), E), + to_scode(notail(Env), R), aeb_fate_code:setelement(?a, ?i(I), ?a, ?a)]; to_scode(Env, {op, Op, A, B}) -> @@ -230,10 +253,29 @@ to_scode(Env, {'let', X, {var, Y}, Body}) -> to_scode(Env1, Body); to_scode(Env, {'let', X, Expr, Body}) -> {I, Env1} = bind_local(X, Env), - [ to_scode(Env, Expr), + [ to_scode(notail(Env), Expr), aeb_fate_code:store({var, I}, {stack, 0}), to_scode(Env1, Body) ]; +to_scode(Env, {funcall, Fun, Args}) -> + case Fun of + {var, X} -> + case resolve_name(Env, X) of + {def, F} -> + Lbl = aeb_fate_data:make_string(F), + Call = if Env#env.tailpos -> aeb_fate_code:call_t(Lbl); + true -> aeb_fate_code:call(Lbl) end, + [ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)], + Call ]; + {var, Y} -> + ?TODO({call_to_unknown_function, Y}); + not_found -> + code_error({unbound_variable, X, Env}) + end; + _ -> + ?TODO({funcall, Fun}) + end; + to_scode(Env, {switch, Case}) -> split_to_scode(Env, Case); @@ -873,7 +915,8 @@ to_basic_blocks(Funs, Options) -> bb(_Name, Code, _Options) -> Blocks0 = blocks(Code), - Blocks = optimize_blocks(Blocks0), + Blocks1 = optimize_blocks(Blocks0), + Blocks = lists:flatmap(fun split_calls/1, Blocks1), Labels = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]), BBs = [ set_labels(Labels, B) || B <- Blocks ], maps:from_list(BBs). @@ -1027,6 +1070,19 @@ use_returnr(['RETURN', {'PUSH', A} | Code]) -> [{'RETURNR', A} | Code]; use_returnr(Code) -> Code. +%% -- Split basic blocks at CALL instructions -- +%% Calls can only return to a new basic block. + +split_calls({Ref, Code}) -> + split_calls(Ref, Code, [], []). + +split_calls(Ref, [], Acc, Blocks) -> + lists:reverse([{Ref, lists:reverse(Acc)} | Blocks]); +split_calls(Ref, [I = {CALL, _} | Code], Acc, Blocks) when CALL == 'CALL'; CALL == 'CALL_R' -> + split_calls(make_ref(), Code, [], [{Ref, lists:reverse([I | Acc])} | Blocks]); +split_calls(Ref, [I | Code], Acc, Blocks) -> + split_calls(Ref, Code, [I | Acc], Blocks). + %% -- Translate label refs to indices -- set_labels(Labels, {Ref, Code}) when is_reference(Ref) ->