From d2dbb98b7f028c1d446f567b072ebc398506267e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 26 Mar 2019 11:17:44 +0100 Subject: [PATCH 01/87] Update to changes in icode format --- src/aeso_icode_to_fate.erl | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/aeso_icode_to_fate.erl b/src/aeso_icode_to_fate.erl index 245d8d7..ae57b8b 100644 --- a/src/aeso_icode_to_fate.erl +++ b/src/aeso_icode_to_fate.erl @@ -40,12 +40,19 @@ compile(ICode, Options) -> functions := Functions } = ICode, SFuns = functions_to_scode(Functions, Options), SFuns1 = optimize_scode(SFuns, Options), - to_basic_blocks(SFuns1, Options). + BBFuns = to_basic_blocks(SFuns1, Options), + #{ functions => BBFuns }. + +is_init([_, "init"]) -> true; +is_init(_Other) -> false. + +make_function_name([_, Name]) -> list_to_binary(Name); +make_function_name(Other) -> error({todo, namespace_stuff, Other}). functions_to_scode(Functions, Options) -> maps:from_list( - [ {list_to_binary(Name), function_to_scode(Name, Args, Body, Type, Options)} - || {Name, _Ann, Args, Body, Type} <- Functions, Name /= "init" ]). %% TODO: skip init for now + [ {make_function_name(Name), function_to_scode(Name, Args, Body, Type, Options)} + || {Name, _Ann, Args, Body, Type} <- Functions, not is_init(Name) ]). %% TODO: skip init for now function_to_scode(Name, Args, Body, Type, Options) -> debug(Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, Type, Body]), -- 2.30.2 From bc8b2d1c815245fdb01b77cc144668cd66eeb572 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 1 Apr 2019 11:37:28 +0200 Subject: [PATCH 02/87] Start on new intermediate code for FATE --- src/aeso_ast_to_fcode.erl | 260 ++++++++++++++++++ ...ode_to_fate.erl => aeso_fcode_to_fate.erl} | 55 ++-- 2 files changed, 277 insertions(+), 38 deletions(-) create mode 100644 src/aeso_ast_to_fcode.erl rename src/{aeso_icode_to_fate.erl => aeso_fcode_to_fate.erl} (85%) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl new file mode 100644 index 0000000..14ab6ed --- /dev/null +++ b/src/aeso_ast_to_fcode.erl @@ -0,0 +1,260 @@ +%%%------------------------------------------------------------------- +%%% @author Ulf Norell +%%% @copyright (C) 2019, Aeternity Anstalt +%%% @doc +%%% Compiler from Aeterinty Sophia language to Fate intermediate code. +%%% @end +%%% Created : 26 Mar 2019 +%%% +%%%------------------------------------------------------------------- +-module(aeso_ast_to_fcode). + +-export([ast_to_fcode/2]). +-export_type([fcode/0, fexpr/0, fun_def/0]). + +%% -- Type definitions ------------------------------------------------------- + +-type option() :: none(). + +-type attribute() :: stateful | pure. + +-type fun_name() :: {entrypoint, binary()} + | {local_fun, [string()]} + | init. +-type var_name() :: string(). +-type sophia_name() :: [string()]. + +-type binop() :: '+' | '-' | '=='. + +-type fexpr() :: {integer, integer()} + | {bool, false | true} + | {var, var_name()} + | {binop, ftype(), binop(), fexpr(), fexpr()} + | {'if', fexpr(), fexpr(), fexpr()} + | {todo, term()}. +-type ftype() :: aeb_fate_data:fate_type_type(). + +-type fun_def() :: #{ attrs := [attribute()], + args := [{var_name(), ftype()}], + return := ftype(), + body := fexpr() }. + +-type fcode() :: #{ contract_name := string(), + state_type := ftype(), + event_type := ftype() | none, + functions := #{ fun_name() => fun_def() } }. + +-type type_env() :: #{ sophia_name() => fun(([ftype()]) -> ftype()) }. +-type fun_env() :: #{ sophia_name() => fun_name() }. + +-type context() :: {main_contract, string()} + | {namespace, string()} + | {abstract_contract, string()}. + +-type env() :: #{ type_env := type_env(), + fun_env := fun_env(), + options := [], + context => context(), + functions := #{ fun_name() => fun_def() } }. + +%% -- Entrypoint ------------------------------------------------------------- + +%% Main entrypoint. Takes typed syntax produced by aeso_ast_infer_types:infer/1,2 +%% and produces Fate intermediate code. +-spec ast_to_fcode(aeso_syntax:ast(), [option()]) -> fcode(). +ast_to_fcode(Code, Options) -> + to_fcode(init_env(Options), Code). + +%% -- Environment ------------------------------------------------------------ + +-spec init_env([option()]) -> env(). +init_env(Options) -> + #{ type_env => init_type_env(), + fun_env => #{}, %% TODO: builtin functions here? + options => Options, + functions => #{} }. + +-define(type(T), fun([]) -> T end). +-define(type(X, T), fun([X]) -> T end). +-define(type(X, Y, T), fun([X, Y]) -> T end). + +-spec init_type_env() -> type_env(). +init_type_env() -> + #{ ["int"] => ?type(integer), + ["bool"] => ?type(boolean), + ["bits"] => ?type(bits), + ["string"] => ?type(string), + ["address"] => ?type(address), + ["hash"] => ?type(hash), + ["signature"] => ?type(signature), + ["oracle"] => ?type(_, _, oracle), + ["oracle_query"] => ?type(_, _, oracle_query), %% TODO: not in Fate + ["list"] => ?type(T, {list, T}), + ["map"] => ?type(K, V, {map, K, V}), + ["option"] => ?type(T, {variant, [[], [T]]}), + ["Chain", "ttl"] => ?type({variant, [[integer], [integer]]}) + }. + +%% -- Compilation ------------------------------------------------------------ + +-spec to_fcode(env(), aeso_syntax:ast()) -> fcode(). +to_fcode(Env, [{contract, _, {con, _, Main}, Decls}]) -> + #{ functions := Funs } = Env1 = + decls_to_fcode(Env#{ context => {main_contract, Main} }, Decls), + StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}), + EventType = lookup_type(Env1, [Main, "event"], [], none), + #{ contract_name => Main, + state_type => StateType, + event_type => EventType, + functions => Funs }; +to_fcode(Env, [{contract, _, {con, _, Con}, Decls} | Code]) -> + Env1 = decls_to_fcode(Env#{ context => {abstract_contract, Con} }, Decls), + to_fcode(Env1, Code); +to_fcode(Env, [{namespace, _, {con, _, Con}, Decls} | Code]) -> + Env1 = decls_to_fcode(Env#{ context => {namespace, Con} }, Decls), + to_fcode(Env1, Code). + +-spec decls_to_fcode(env(), [aeso_syntax:decl()]) -> env(). +decls_to_fcode(Env, Decls) -> + %% First compute mapping from Sophia names to fun_names and add it to the + %% environment. + Env1 = add_fun_env(Env, Decls), + lists:foldl(fun(D, E) -> decl_to_fcode(E, D) end, + Env1, Decls). + +-spec decl_to_fcode(env(), aeso_syntax:decl()) -> env(). +decl_to_fcode(Env, {type_decl, _, _, _}) -> Env; +decl_to_fcode(Env, {fun_decl, _, _, _}) -> Env; +decl_to_fcode(Env, Decl = {type_def, _Ann, {id, _, _Name}, _Args, _Def}) -> + error({todo, Decl}), + Env; +decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, Ret, Body}) -> + Attrs = get_attributes(Ann), + FName = lookup_fun(Env, qname(Env, Name)), + FArgs = args_to_fcode(Env, Args), + FBody = expr_to_fcode(Env, Body), + Def = #{ attrs => Attrs, + args => FArgs, + return => type_to_fcode(Env, Ret), + body => FBody }, + NewFuns = Funs#{ FName => Def }, + Env#{ functions := NewFuns }. + +-spec type_to_fcode(env(), aeso_syntax:type()) -> ftype(). +type_to_fcode(Env, {app_t, T = {Id, _, _}, Types}) when Id == id; Id == qid -> + lookup_type(Env, T, [type_to_fcode(Env, Type) || Type <- Types]); +type_to_fcode(Env, T = {Id, _, _}) when Id == id; Id == qid -> + lookup_type(Env, T, []); +type_to_fcode(_Env, Type) -> + {todo, Type}. + +-spec args_to_fcode(env(), [aeso_syntax:arg()]) -> [{var_name(), ftype()}]. +args_to_fcode(Env, Args) -> + [ {Name, type_to_fcode(Env, Type)} || {arg, _, {id, _, Name}, Type} <- Args ]. + +-spec expr_to_fcode(env(), aeso_syntax:expr()) -> fexpr(). +expr_to_fcode(Env, {typed, _, Expr, Type}) -> + expr_to_fcode(Env, type_to_fcode(Env, Type), Expr); +expr_to_fcode(Env, Expr) -> + expr_to_fcode(Env, no_type, Expr). + +-spec expr_to_fcode(env(), ftype() | no_type, aeso_syntax:expr()) -> fexpr(). + +%% Literals +expr_to_fcode(_Env, _Type, {int, _, N}) -> {integer, N}; +expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; + +%% Variables +expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; + +%% Conditionals +expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> + {'if', expr_to_fcode(Env, Cond), + expr_to_fcode(Env, Then), + expr_to_fcode(Env, Else)}; + +%% Binary operator +expr_to_fcode(Env, Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> + FOp = binop_to_fcode(Op), + {binop, Type, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; + +expr_to_fcode(_Env, Type, Expr) -> + {todo, {Expr, '::', Type}}. + +binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. + +%% -- Optimisations ---------------------------------------------------------- + +%% - Translate && and || to ifte +%% - Deadcode elimination + +%% -- Helper functions ------------------------------------------------------- + +%% -- Types -- + +-spec lookup_type(env(), aeso_syntax:id() | aeso_syntax:qid() | sophia_name(), [ftype()]) -> ftype(). +lookup_type(Env, {id, _, Name}, Args) -> + lookup_type(Env, [Name], Args); +lookup_type(Env, {qid, _, Name}, Args) -> + lookup_type(Env, Name, Args); +lookup_type(Env, Name, Args) -> + case lookup_type(Env, Name, Args, not_found) of + not_found -> error({unknown_type, Name}); + Type -> Type + end. + +-spec lookup_type(env(), sophia_name(), [ftype()], ftype()) -> ftype(). +lookup_type(#{ type_env := TypeEnv }, Name, Args, Default) -> + case maps:get(Name, TypeEnv, false) of + false -> Default; + Fun -> Fun(Args) + end. + +%% -- Names -- + +-spec add_fun_env(env(), [aeso_syntax:decl()]) -> fun_env(). +add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{}; %% no functions from abstract contracts +add_fun_env(Env = #{ fun_env := FunEnv }, Decls) -> + Entry = fun({letfun, Ann, {id, _, Name}, _, _, _}) -> + [{qname(Env, Name), make_fun_name(Env, Ann, Name)}]; + (_) -> [] end, + FunEnv1 = maps:from_list(lists:flatmap(Entry, Decls)), + Env#{ fun_env := maps:merge(FunEnv, FunEnv1) }. + +make_fun_name(#{ context := Context }, Ann, Name) -> + Private = proplists:get_value(private, Ann, false) orelse + proplists:get_value(internal, Ann, false), + case Context of + {main_contract, Main} -> + if Private -> {local_fun, [Main, Name]}; + Name == "init" -> init; + true -> {entrypoint, list_to_binary(Name)} + end; + {namespace, Lib} -> + {local_fun, [Lib, Name]} + end. + +-spec current_namespace(env()) -> string(). +current_namespace(#{ context := Cxt }) -> + case Cxt of + {abstract_contract, Con} -> Con; + {main_contract, Con} -> Con; + {namespace, NS} -> NS + end. + +-spec qname(env(), string()) -> sophia_name(). +qname(Env, Name) -> + [current_namespace(Env), Name]. + +-spec lookup_fun(env(), sophia_name()) -> fun_name(). +lookup_fun(#{ fun_env := FunEnv }, Name) -> + case maps:get(Name, FunEnv, false) of + false -> error({unbound_name, Name}); + FName -> FName + end. + +%% -- Attributes -- + +get_attributes(Ann) -> + [stateful || proplists:get_value(stateful, Ann, false)]. + diff --git a/src/aeso_icode_to_fate.erl b/src/aeso_fcode_to_fate.erl similarity index 85% rename from src/aeso_icode_to_fate.erl rename to src/aeso_fcode_to_fate.erl index ae57b8b..71e5f53 100644 --- a/src/aeso_icode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -7,9 +7,7 @@ %%% Created : 11 Jan 2019 %%% %%%------------------------------------------------------------------- --module(aeso_icode_to_fate). - --include("aeso_icode.hrl"). +-module(aeso_fcode_to_fate). -export([compile/2]). @@ -43,37 +41,25 @@ compile(ICode, Options) -> BBFuns = to_basic_blocks(SFuns1, Options), #{ functions => BBFuns }. -is_init([_, "init"]) -> true; -is_init(_Other) -> false. - -make_function_name([_, Name]) -> list_to_binary(Name); -make_function_name(Other) -> error({todo, namespace_stuff, Other}). +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) -> maps:from_list( [ {make_function_name(Name), function_to_scode(Name, Args, Body, Type, Options)} - || {Name, _Ann, Args, Body, Type} <- Functions, not is_init(Name) ]). %% TODO: skip init for now + || {Name, #{args := Args, + body := Body, + return := Type}} <- maps:to_list(Functions), + Name /= init ]). %% TODO: skip init for now -function_to_scode(Name, Args, Body, Type, Options) -> - debug(Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, Type, Body]), - ArgTypes = [ icode_type_to_fate(T) || {_, T} <- Args ], - ResType = icode_type_to_fate(Type), +function_to_scode(Name, Args, Body, ResType, Options) -> + debug(Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, ResType, Body]), + ArgTypes = [ T || {_, T} <- Args ], SCode = to_scode(init_env(Args), Body), debug(Options, " scode: ~p\n", [SCode]), {{ArgTypes, ResType}, SCode}. -%% -- Types ------------------------------------------------------------------ - -%% TODO: the Fate types don't seem to be specified anywhere... -icode_type_to_fate(word) -> integer; -icode_type_to_fate(string) -> string; -icode_type_to_fate({tuple, Types}) -> - {tuple, lists:map(fun icode_type_to_fate/1, Types)}; -icode_type_to_fate({list, Type}) -> - {list, icode_type_to_fate(Type)}; -icode_type_to_fate(typerep) -> typerep; -icode_type_to_fate(Type) -> ?TODO(Type). - %% -- Phase I ---------------------------------------------------------------- %% Icode to structured assembly @@ -96,21 +82,22 @@ lookup_var(#env{ args = Args, stack = S }, X) -> %% -- The compiler -- -to_scode(_Env, #integer{ value = N }) -> +to_scode(_Env, {integer, N}) -> [aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring -to_scode(Env, #var_ref{name = X}) -> +to_scode(Env, {var, X}) -> case lookup_var(Env, X) of false -> error({unbound_variable, X, Env}); {stack, N} -> [aeb_fate_code:dup(?i(N))]; {arg, N} -> [aeb_fate_code:push({arg, N})] end; -to_scode(Env, #binop{ op = Op, left = A, right = B }) -> + +to_scode(Env, {binop, Type, Op, A, B}) -> [ to_scode(notail(Env), B) - , to_scode(push_env(binop_type_r(Op), Env), A) + , to_scode(push_env(Type, Env), A) , binop_to_scode(Op) ]; -to_scode(Env, #ifte{decision = Dec, then = Then, else = Else}) -> +to_scode(Env, {'if', Dec, Then, Else}) -> [ to_scode(notail(Env), Dec) , {ifte, to_scode(Env, Then), to_scode(Env, Else)} ]; @@ -118,14 +105,6 @@ to_scode(_Env, Icode) -> ?TODO(Icode). %% -- Operators -- -binop_types('+') -> {word, word}; -binop_types('-') -> {word, word}; -binop_types('==') -> {word, word}; -binop_types(Op) -> ?TODO(Op). - -%% binop_type_l(Op) -> element(1, binop_types(Op)). -binop_type_r(Op) -> element(2, binop_types(Op)). - binop_to_scode('+') -> add_a_a_a(); %% Optimization introduces other variants binop_to_scode('-') -> sub_a_a_a(); binop_to_scode('==') -> eq_a_a_a(). -- 2.30.2 From 33bb8a37d0f5b9ed7bfd83d56b34d1ec9d59d55f Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 1 Apr 2019 13:47:01 +0200 Subject: [PATCH 03/87] Compile `let` to FATE --- src/aeso_ast_to_fcode.erl | 33 ++++++++++++++++++++++++-- src/aeso_fcode_to_fate.erl | 48 +++++++++++++++++++++++++------------- 2 files changed, 63 insertions(+), 18 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 14ab6ed..f042ad2 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -31,9 +31,15 @@ | {var, var_name()} | {binop, ftype(), binop(), fexpr(), fexpr()} | {'if', fexpr(), fexpr(), fexpr()} - | {todo, term()}. + | {switch, fexpr(), [falt()]}. + +-type fpat() :: {var, var_name()}. + +-type falt() :: {fpat(), fexpr()}. + -type ftype() :: aeb_fate_data:fate_type_type(). + -type fun_def() :: #{ attrs := [attribute()], args := [{var_name(), ftype()}], return := ftype(), @@ -173,20 +179,43 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> expr_to_fcode(Env, Then), expr_to_fcode(Env, Else)}; +%% Blocks +expr_to_fcode(Env, _Type, {block, _, Stmts}) -> + stmts_to_fcode(Env, Stmts); + %% Binary operator expr_to_fcode(Env, Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> FOp = binop_to_fcode(Op), {binop, Type, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; expr_to_fcode(_Env, Type, Expr) -> - {todo, {Expr, '::', Type}}. + {todo, {Expr, ':', Type}}. binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. +-spec pat_to_fcode(env(), aeso_syntax:pattern()) -> fpat(). +pat_to_fcode(Env, {typed, _, Pat, Type}) -> + pat_to_fcode(Env, type_to_fcode(Env, Type), Pat); +pat_to_fcode(Env, Pat) -> + pat_to_fcode(Env, no_type, Pat). + +-spec pat_to_fcode(env(), ftype() | no_type, aeso_syntax:pattern()) -> fpat(). +pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; +pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. + +-spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). +stmts_to_fcode(Env, [{letval, _, Pat, _, Expr} | Stmts]) -> + {switch, expr_to_fcode(Env, Expr), + [{pat_to_fcode(Env, Pat), stmts_to_fcode(Env, Stmts)}]}; + +stmts_to_fcode(Env, [Expr]) -> + expr_to_fcode(Env, Expr). + %% -- Optimisations ---------------------------------------------------------- %% - Translate && and || to ifte %% - Deadcode elimination +%% - Simplified case trees (FATE has special instructions for shallow matching) %% -- Helper functions ------------------------------------------------------- diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 71e5f53..8065df9 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -18,7 +18,7 @@ -define(i(__X__), {immediate, __X__}). -define(a, {stack, 0}). --record(env, { args = [], stack = [], tailpos = true }). +-record(env, { args = [], stack = [], locals = [], tailpos = true }). %% -- Debugging -------------------------------------------------------------- @@ -69,15 +69,18 @@ init_env(Args) -> #env{ args = Args, stack = [], tailpos = true }. push_env(Type, Env) -> - Env#env{ stack = [{"_", Type} | Env#env.stack] }. + Env#env{ stack = [Type | Env#env.stack] }. + +bind_local(Name, Env = #env{ locals = Locals }) -> + {length(Locals), Env#env{ locals = Locals ++ [Name] }}. notail(Env) -> Env#env{ tailpos = false }. -lookup_var(#env{ args = Args, stack = S }, X) -> - case {keyfind_index(X, 1, S), keyfind_index(X, 1, Args)} of - {false, false} -> false; +lookup_var(Env = #env{ args = Args, locals = Locals }, X) -> + case {find_index(X, Locals), keyfind_index(X, 1, Args)} of + {false, false} -> error({unbound_variable, X, Env}); {false, Arg} -> {arg, Arg}; - {Local, _} -> {stack, Local} + {Local, _} -> {var, Local} end. %% -- The compiler -- @@ -86,23 +89,30 @@ to_scode(_Env, {integer, N}) -> [aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring to_scode(Env, {var, X}) -> - case lookup_var(Env, X) of - false -> error({unbound_variable, X, Env}); - {stack, N} -> [aeb_fate_code:dup(?i(N))]; - {arg, N} -> [aeb_fate_code:push({arg, N})] - end; + [aeb_fate_code:push(lookup_var(Env, X))]; to_scode(Env, {binop, Type, Op, A, B}) -> - [ to_scode(notail(Env), B) - , to_scode(push_env(Type, Env), A) - , binop_to_scode(Op) ]; + [ to_scode(notail(Env), B), + to_scode(push_env(Type, Env), A), + binop_to_scode(Op) ]; to_scode(Env, {'if', Dec, Then, Else}) -> - [ to_scode(notail(Env), Dec) - , {ifte, to_scode(Env, Then), to_scode(Env, Else)} ]; + [ to_scode(notail(Env), Dec), + {ifte, to_scode(Env, Then), to_scode(Env, Else)} ]; + +to_scode(Env, {switch, Expr, Alts}) -> + [ to_scode(notail(Env), Expr), + alts_to_scode(Env, Alts) ]; to_scode(_Env, Icode) -> ?TODO(Icode). +alts_to_scode(Env, [{{var, X}, Body}]) -> + {I, Env1} = bind_local(X, Env), + [ aeb_fate_code:store({var, I}, {stack, 0}), + to_scode(Env1, Body) ]; +alts_to_scode(_Env, Alts) -> + ?TODO(Alts). + %% -- Operators -- binop_to_scode('+') -> add_a_a_a(); %% Optimization introduces other variants @@ -283,3 +293,9 @@ keyfind_index(X, J, Xs) -> [] -> false end. +find_index(X, Xs) -> + case lists:keyfind(X, 2, with_ixs(Xs)) of + {I, _} -> I; + false -> false + end. + -- 2.30.2 From 216fbc6144e012a2ca6f0f79a890e34cab126521 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 1 Apr 2019 14:23:49 +0200 Subject: [PATCH 04/87] Fix and improve broken bytecode optimisations --- src/aeso_ast_to_fcode.erl | 1 + src/aeso_fcode_to_fate.erl | 45 ++++++++++++++++++++++++++------------ 2 files changed, 32 insertions(+), 14 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index f042ad2..c596ed9 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -216,6 +216,7 @@ stmts_to_fcode(Env, [Expr]) -> %% - Translate && and || to ifte %% - Deadcode elimination %% - Simplified case trees (FATE has special instructions for shallow matching) +%% - Constant propagation %% -- Helper functions ------------------------------------------------------- diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 8065df9..6b824da 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -15,8 +15,25 @@ -define(TODO(What), error({todo, ?FILE, ?LINE, ?FUNCTION_NAME, What})). --define(i(__X__), {immediate, __X__}). +-define(i(X), {immediate, X}). -define(a, {stack, 0}). +-define(IsStackArg(X), (element(1, X) =:= stack)). + +-define(IsBinOp(Op), + (Op =:= 'ADD' orelse + Op =:= 'SUB' orelse + Op =:= 'MUL' orelse + Op =:= 'DIV' orelse + Op =:= 'MOD' orelse + Op =:= 'POW' orelse + Op =:= 'LT' orelse + Op =:= 'GT' orelse + Op =:= 'EQ' orelse + Op =:= 'ELT' orelse + Op =:= 'EGT' orelse + Op =:= 'NEQ' orelse + Op =:= 'AND' orelse + Op =:= 'OR')). -record(env, { args = [], stack = [], locals = [], tailpos = true }). @@ -122,7 +139,7 @@ binop_to_scode('==') -> eq_a_a_a(). add_a_a_a() -> aeb_fate_code:add(?a, ?a, ?a). sub_a_a_a() -> aeb_fate_code:sub(?a, ?a, ?a). -eq_a_a_a() -> aeb_fate_code:eq(?a, ?a, ?a). +eq_a_a_a() -> aeb_fate_code:eq(?a, ?a, ?a). %% -- Phase II --------------------------------------------------------------- %% Optimize @@ -154,23 +171,23 @@ simpl_s({ifte, Then, Else}) -> {ifte, simplify(Then), simplify(Else)}; simpl_s(I) -> I. -%% add_i 0 --> nop -simpl_top({'ADD', _, ?i(0), _}, Code) -> Code; -%% push n, add_a --> add_i n -simpl_top({'PUSH', ?a, ?i(N)}, - [{'ADD', ?a, ?a, ?a} | Code]) -> - simpl_top( aeb_fate_code:add(?a, ?i(N), ?a), Code); -%% push n, add_i m --> add_i (n + m) -simpl_top({'PUSH', ?a, ?i(N)}, [{'ADD', ?a, ?i(M), ?a} | Code]) -> - simpl_top(aeb_fate_code:push(?i(N + M)), Code); -%% add_i n, add_i m --> add_i (n + m) -simpl_top({'ADD', ?a, ?i(N), ?a}, [{'ADD', ?a, ?i(M), ?a} | Code]) -> - simpl_top({'ADD', ?a, ?i(N + M), ?a}, Code); +%% Removing pushes that are immediately consumed. +simpl_top({'PUSH', A}, [{Op, R, ?a, B} | Code]) when ?IsBinOp(Op) -> + simpl_top({Op, R, A, B}, Code); +simpl_top({'PUSH', B}, [{Op, R, A, ?a} | Code]) when not ?IsStackArg(A), ?IsBinOp(Op) -> + simpl_top({Op, R, A, B}, Code); +simpl_top({'PUSH', A}, [{Op1, ?a, B, C}, {Op2, R, ?a, ?a} | Code]) when ?IsBinOp(Op1), ?IsBinOp(Op2) -> + simpl_top({Op1, ?a, B, C}, [{Op2, R, ?a, A} | Code]); + +%% Writing directly to memory instead of going through the accumulator. +simpl_top({Op, ?a, A, B}, [{'STORE', R, ?a} | Code]) when ?IsBinOp(Op) -> + simpl_top({Op, R, A, B}, Code); simpl_top(I, Code) -> [I | Code]. %% Desugar and specialize desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_code:inc()]; +desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_code:dec()]; desugar({ifte, Then, Else}) -> [{ifte, desugar(Then), desugar(Else)}]; desugar(Code) when is_list(Code) -> lists:flatmap(fun desugar/1, Code); -- 2.30.2 From d37ef8cec2cee5216c92c6c08ed4d56071a82108 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 1 Apr 2019 16:04:59 +0200 Subject: [PATCH 05/87] Basic tuple patterns --- src/aeso_ast_to_fcode.erl | 18 ++++++++++++++++-- src/aeso_fcode_to_fate.erl | 23 +++++++++++++++++++---- 2 files changed, 35 insertions(+), 6 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index c596ed9..fe4addd 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -33,9 +33,10 @@ | {'if', fexpr(), fexpr(), fexpr()} | {switch, fexpr(), [falt()]}. --type fpat() :: {var, var_name()}. +-type fpat() :: {var, var_name()} + | {tuple, [fpat()]}. --type falt() :: {fpat(), fexpr()}. +-type falt() :: {'case', fpat(), fexpr()}. -type ftype() :: aeb_fate_data:fate_type_type(). @@ -151,6 +152,8 @@ type_to_fcode(Env, {app_t, T = {Id, _, _}, Types}) when Id == id; Id == qid -> lookup_type(Env, T, [type_to_fcode(Env, Type) || Type <- Types]); type_to_fcode(Env, T = {Id, _, _}) when Id == id; Id == qid -> lookup_type(Env, T, []); +type_to_fcode(Env, {tuple_t, _, Types}) -> + {tuple, [type_to_fcode(Env, T) || T <- Types]}; type_to_fcode(_Env, Type) -> {todo, Type}. @@ -179,6 +182,11 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> expr_to_fcode(Env, Then), expr_to_fcode(Env, Else)}; +%% Switch +expr_to_fcode(Env, _Type, {switch, _, Expr, Alts}) -> + {switch, expr_to_fcode(Env, Expr), + [ alt_to_fcode(Env, Alt) || Alt <- Alts ]}; + %% Blocks expr_to_fcode(Env, _Type, {block, _, Stmts}) -> stmts_to_fcode(Env, Stmts); @@ -193,6 +201,10 @@ expr_to_fcode(_Env, Type, Expr) -> binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. +-spec alt_to_fcode(env(), aeso_syntax:alt()) -> falt(). +alt_to_fcode(Env, {'case', _, Pat, Expr}) -> + {'case', pat_to_fcode(Env, Pat), expr_to_fcode(Env, Expr)}. + -spec pat_to_fcode(env(), aeso_syntax:pattern()) -> fpat(). pat_to_fcode(Env, {typed, _, Pat, Type}) -> pat_to_fcode(Env, type_to_fcode(Env, Type), Pat); @@ -201,6 +213,8 @@ pat_to_fcode(Env, Pat) -> -spec pat_to_fcode(env(), ftype() | no_type, aeso_syntax:pattern()) -> fpat(). pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; +pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> + {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 6b824da..f1b4b5b 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -56,7 +56,11 @@ compile(ICode, Options) -> SFuns = functions_to_scode(Functions, Options), SFuns1 = optimize_scode(SFuns, Options), BBFuns = to_basic_blocks(SFuns1, Options), - #{ functions => BBFuns }. + FateCode = #{ functions => BBFuns, + symbols => #{}, + annotations => #{} }, + debug(Options, "~s\n", [aeb_fate_asm:pp(FateCode)]), + FateCode. make_function_name(init) -> <<"init">>; make_function_name({entrypoint, Name}) -> Name; @@ -123,10 +127,22 @@ to_scode(Env, {switch, Expr, Alts}) -> to_scode(_Env, Icode) -> ?TODO(Icode). -alts_to_scode(Env, [{{var, X}, Body}]) -> +alts_to_scode(Env, [{'case', {var, X}, Body}]) -> {I, Env1} = bind_local(X, Env), [ aeb_fate_code:store({var, I}, {stack, 0}), to_scode(Env1, Body) ]; +alts_to_scode(Env, Alts = [{'case', {tuple, Pats}, Body}]) -> + Xs = lists:flatmap(fun({var, X}) -> [X]; (_) -> [] end, Pats), + case length(Xs) == length(Pats) of + false -> ?TODO(Alts); + true -> + {Is, Env1} = lists:foldl(fun(X, {Is, E}) -> {I, E1} = bind_local(X, E), {[I|Is], E1} end, + {[], Env}, Xs), + [ [[aeb_fate_code:dup(), + aeb_fate_code:element_op({var, X}, ?i(J), ?a)] + || {J, X} <- with_ixs(lists:reverse(Is))], + to_scode(Env1, Body) ] + end; alts_to_scode(_Env, Alts) -> ?TODO(Alts). @@ -201,12 +217,11 @@ to_basic_blocks(Funs, Options) -> bb(Name, Code ++ [aeb_fate_code:return()], Options)}} || {Name, {{Args, Res}, Code}} <- maps:to_list(Funs) ]). -bb(Name, Code, Options) -> +bb(_Name, Code, _Options) -> Blocks0 = blocks(Code), Blocks = optimize_blocks(Blocks0), Labels = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]), BBs = [ set_labels(Labels, B) || B <- Blocks ], - debug(Options, "Final code for ~s:\n ~p\n", [Name, BBs]), maps:from_list(BBs). %% -- Break up scode into basic blocks -- -- 2.30.2 From 200f80cc8964b052d5e0db7c825358b70b0be02d Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 11:18:48 +0200 Subject: [PATCH 06/87] Compile shallow matching on tuples --- src/aeso_ast_to_fcode.erl | 1 + src/aeso_fcode_to_fate.erl | 36 ++++++++++++++++++++++++------------ 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index fe4addd..bb81cb8 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -229,6 +229,7 @@ stmts_to_fcode(Env, [Expr]) -> %% - Translate && and || to ifte %% - Deadcode elimination +%% - Unused variable analysis (replace by _) %% - Simplified case trees (FATE has special instructions for shallow matching) %% - Constant propagation diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index f1b4b5b..4baf147 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -17,7 +17,6 @@ -define(i(X), {immediate, X}). -define(a, {stack, 0}). --define(IsStackArg(X), (element(1, X) =:= stack)). -define(IsBinOp(Op), (Op =:= 'ADD' orelse @@ -26,14 +25,15 @@ Op =:= 'DIV' orelse Op =:= 'MOD' orelse Op =:= 'POW' orelse - Op =:= 'LT' orelse - Op =:= 'GT' orelse - Op =:= 'EQ' orelse + Op =:= 'LT' orelse + Op =:= 'GT' orelse + Op =:= 'EQ' orelse Op =:= 'ELT' orelse Op =:= 'EGT' orelse Op =:= 'NEQ' orelse Op =:= 'AND' orelse - Op =:= 'OR')). + Op =:= 'OR' orelse + Op =:= 'ELEMENT')). -record(env, { args = [], stack = [], locals = [], tailpos = true }). @@ -133,19 +133,31 @@ alts_to_scode(Env, [{'case', {var, X}, Body}]) -> to_scode(Env1, Body) ]; alts_to_scode(Env, Alts = [{'case', {tuple, Pats}, Body}]) -> Xs = lists:flatmap(fun({var, X}) -> [X]; (_) -> [] end, Pats), - case length(Xs) == length(Pats) of + N = length(Pats), + case length(Xs) == N of false -> ?TODO(Alts); true -> - {Is, Env1} = lists:foldl(fun(X, {Is, E}) -> {I, E1} = bind_local(X, E), {[I|Is], E1} end, - {[], Env}, Xs), - [ [[aeb_fate_code:dup(), - aeb_fate_code:element_op({var, X}, ?i(J), ?a)] - || {J, X} <- with_ixs(lists:reverse(Is))], - to_scode(Env1, Body) ] + {Code, Env1} = match_tuple(Env, Xs), + [Code, to_scode(Env1, Body)] end; alts_to_scode(_Env, Alts) -> ?TODO(Alts). +%% Tuple is in the accumulator. Arguments are the variable names. +match_tuple(Env, Xs) -> + match_tuple(Env, 0, Xs). + +match_tuple(Env, I, ["_" | Xs]) -> + match_tuple(Env, I + 1, Xs); +match_tuple(Env, I, [X | Xs]) -> + {J, Env1} = bind_local(X, Env), + {Code, Env2} = match_tuple(Env1, I + 1, Xs), + {[ [aeb_fate_code:dup() || [] /= [Y || Y <- Xs, Y /= "_"]], %% Don't DUP the last one + aeb_fate_code:element_op({var, J}, ?i(I), ?a), + Code], Env2}; +match_tuple(Env, _, []) -> + {[], Env}. + %% -- Operators -- binop_to_scode('+') -> add_a_a_a(); %% Optimization introduces other variants -- 2.30.2 From 68ee18fe70ed323d71f6ca94807ad312c0b48388 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 11:19:13 +0200 Subject: [PATCH 07/87] Liveness analysis for local variables --- src/aeso_fcode_to_fate.erl | 258 +++++++++++++++++++++++++++++++++++-- 1 file changed, 244 insertions(+), 14 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 4baf147..603cb55 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -185,12 +185,187 @@ optimize_fun(_Funs, Name, {{Args, Res}, Code}, Options) -> Code0 = flatten(Code), debug(Options, "Optimizing ~s\n", [Name]), debug(Options, " original : ~p\n", [Code0]), - Code1 = simplify(Code0), + ACode = annotate_code(Code0), + debug(Options, " annotated : ~p\n", [ACode]), + Code1 = simplify(ACode), debug(Options, " simplified: ~p\n", [Code1]), Code2 = desugar(Code1), debug(Options, " desugared : ~p\n", [Code2]), {{Args, Res}, Code2}. +%% -- Analysis -- + +annotate_code(Code) -> + {WCode, _} = ann_writes(Code, ordsets:new(), []), + ann_reads(WCode, ordsets:new(), []). + +%% Reverses the code +ann_writes([{ifte, Then, Else} | Code], Writes, Acc) -> + {Then1, WritesThen} = ann_writes(Then, Writes, []), + {Else1, WritesElse} = ann_writes(Else, Writes, []), + Writes1 = ordsets:union(Writes, ordsets:intersection(WritesThen, WritesElse)), + ann_writes(Code, Writes1, [{ifte, Then1, Else1} | Acc]); +ann_writes([I | Code], Writes, Acc) -> + #{ write := Ws } = readwrite(I), + Writes1 = ordsets:union(Writes, Ws), + Ann = #{ writes_in => Writes, writes_out => Writes1 }, + ann_writes(Code, Writes1, [{Ann, I} | Acc]); +ann_writes([], Writes, Acc) -> + {Acc, Writes}. + +%% Takes reversed code and unreverses it. +ann_reads([{ifte, Then, Else} | Code], Reads, Acc) -> + {Then1, ReadsThen} = ann_reads(Then, Reads, []), + {Else1, ReadsElse} = ann_reads(Else, Reads, []), + Reads1 = ordsets:union(Reads, ordsets:union(ReadsThen, ReadsElse)), + ann_reads(Code, Reads1, [{ifte, Then1, Else1} | Acc]); +ann_reads([{Ann, I} | Code], Reads, Acc) -> + #{ writes_in := WritesIn, writes_out := WritesOut } = Ann, + #{ read := Rs, write := Ws } = readwrite(I), + Reads1 = + case length(Ws) == 1 andalso not ordsets:is_element(hd(Ws), Reads) of + %% This is a little bit dangerous: if writing to a dead variable, we ignore + %% the reads. Relies on dead writes to be removed by the optimisations below. + true -> Reads; + false -> ordsets:union(Reads, Rs) + end, + LiveIn = ordsets:intersection(Reads1, WritesIn), + LiveOut = ordsets:intersection(Reads, WritesOut), + Ann1 = #{ live_in => LiveIn, live_out => LiveOut }, + ann_reads(Code, Reads1, [{Ann1, I} | Acc]); +ann_reads([], _, Acc) -> Acc. + +%% Which variables/args does an instruction read/write. Stack usage is more +%% complicated so not tracked. +readwrite(I) -> + Set = fun(L) when is_list(L) -> ordsets:from_list([X || X <- L, X /= ?a]); + (X) -> ordsets:from_list([X || X /= ?a]) end, + WR = fun(W, R) -> #{read => Set(R), write => Set(W)} end, + R = fun(X) -> WR([], X) end, + W = fun(X) -> WR(X, []) end, + None = WR([], []), + case I of + 'RETURN' -> None; + {'RETURNR', A} -> R(A); + {'CALL', _} -> None; + {'CALL_R', A, _} -> R(A); + {'CALL_T', _} -> None; + {'CALL_TR', A, _} -> R(A); + {'JUMP', _} -> None; + {'JUMPIF', A, _} -> R(A); + {'SWITCH_V2', A, _, _} -> R(A); + {'SWITCH_V3', A, _, _, _} -> R(A); + {'SWITCH_VN', A, _} -> R(A); + {'PUSH', A} -> R(A); + 'DUPA' -> None; + {'DUP', A} -> R(A); + {'POP', A} -> W(A); + {'STORE', A, B} -> WR(A, B); + 'INCA' -> None; + {'INC', A} -> WR(A, A); + 'DECA' -> None; + {'DEC', A} -> WR(A, A); + {'ADD', A, B, C} -> WR(A, [B, C]); + {'SUB', A, B, C} -> WR(A, [B, C]); + {'MUL', A, B, C} -> WR(A, [B, C]); + {'DIV', A, B, C} -> WR(A, [B, C]); + {'MOD', A, B, C} -> WR(A, [B, C]); + {'POW', A, B, C} -> WR(A, [B, C]); + {'LT', A, B, C} -> WR(A, [B, C]); + {'GT', A, B, C} -> WR(A, [B, C]); + {'EQ', A, B, C} -> WR(A, [B, C]); + {'ELT', A, B, C} -> WR(A, [B, C]); + {'EGT', A, B, C} -> WR(A, [B, C]); + {'NEQ', A, B, C} -> WR(A, [B, C]); + {'AND', A, B, C} -> WR(A, [B, C]); + {'OR', A, B, C} -> WR(A, [B, C]); + {'NOT', A, B} -> WR(A, B); + {'TUPLE', _} -> None; + {'ELEMENT', A, B, C} -> WR(A, [B, C]); + {'MAP_EMPTY', A} -> W(A); + {'MAP_LOOKUP', A, B, C} -> WR(A, [B, C]); + {'MAP_LOOKUPD', A, B, C, D} -> WR(A, [B, C, D]); + {'MAP_UPDATE', A, B, C, D} -> WR(A, [B, C, D]); + {'MAP_DELETE', A, B, C} -> WR(A, [B, C]); + {'MAP_MEMBER', A, B, C} -> WR(A, [B, C]); + {'MAP_FROM_LIST', A, B} -> WR(A, B); + {'NIL', A} -> W(A); + {'IS_NIL', A, B} -> WR(A, B); + {'CONS', A, B, C} -> WR(A, [B, C]); + {'HD', A, B} -> WR(A, B); + {'TL', A, B} -> WR(A, B); + {'LENGTH', A, B} -> WR(A, B); + {'STR_EQ', A, B, C} -> WR(A, [B, C]); + {'STR_JOIN', A, B, C} -> WR(A, [B, C]); + {'INT_TO_STR', A, B} -> WR(A, B); + {'ADDR_TO_STR', A, B} -> WR(A, B); + {'STR_REVERSE', A, B} -> WR(A, B); + {'INT_TO_ADDR', A, B} -> WR(A, B); + {'VARIANT', A, B, C, D} -> WR(A, [B, C, D]); + {'VARIANT_TEST', A, B, C} -> WR(A, [B, C]); + {'VARIANT_ELEMENT', A, B, C} -> WR(A, [B, C]); + 'BITS_NONEA' -> None; + {'BITS_NONE', A} -> W(A); + 'BITS_ALLA' -> None; + {'BITS_ALL', A} -> W(A); + {'BITS_ALL_N', A, B} -> WR(A, B); + {'BITS_SET', A, B, C} -> WR(A, [B, C]); + {'BITS_CLEAR', A, B, C} -> WR(A, [B, C]); + {'BITS_TEST', A, B, C} -> WR(A, [B, C]); + {'BITS_SUM', A, B} -> WR(A, B); + {'BITS_OR', A, B, C} -> WR(A, [B, C]); + {'BITS_AND', A, B, C} -> WR(A, [B, C]); + {'BITS_DIFF', A, B, C} -> WR(A, [B, C]); + {'ADDRESS', A} -> W(A); + {'BALANCE', A} -> W(A); + {'ORIGIN', A} -> W(A); + {'CALLER', A} -> W(A); + {'GASPRICE', A} -> W(A); + {'BLOCKHASH', A} -> W(A); + {'BENEFICIARY', A} -> W(A); + {'TIMESTAMP', A} -> W(A); + {'GENERATION', A} -> W(A); + {'MICROBLOCK', A} -> W(A); + {'DIFFICULTY', A} -> W(A); + {'GASLIMIT', A} -> W(A); + {'GAS', A} -> W(A); + {'LOG0', A, B} -> R([A, B]); + {'LOG1', A, B, C} -> R([A, B, C]); + {'LOG2', A, B, C, D} -> R([A, B, C, D]); + {'LOG3', A, B, C, D, E} -> R([A, B, C, D, E]); + {'LOG4', A, B, C, D, E, F} -> R([A, B, C, D, E, F]); + 'DEACTIVATE' -> None; + {'SPEND', A, B} -> R([A, B]); + {'ORACLE_REGISTER', A, B, C, D, E, F} -> WR(A, [B, C, D, E, F]); + 'ORACLE_QUERY' -> None; %% TODO + 'ORACLE_RESPOND' -> None; %% TODO + 'ORACLE_EXTEND' -> None; %% TODO + 'ORACLE_GET_ANSWER' -> None; %% TODO + 'ORACLE_GET_QUESTION' -> None; %% TODO + 'ORACLE_QUERY_FEE' -> None; %% TODO + 'AENS_RESOLVE' -> None; %% TODO + 'AENS_PRECLAIM' -> None; %% TODO + 'AENS_CLAIM' -> None; %% TODO + 'AENS_UPDATE' -> None; %% TODO + 'AENS_TRANSFER' -> None; %% TODO + 'AENS_REVOKE' -> None; %% TODO + 'ECVERIFY' -> None; %% TODO + 'SHA3' -> None; %% TODO + 'SHA256' -> None; %% TODO + 'BLAKE2B' -> None; %% TODO + {'ABORT', A} -> R(A); + {'EXIT', A} -> R(A); + 'NOP' -> None + end. + +merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> + #{ live_in => LiveIn, live_out => LiveOut }. + +%% live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn). +live_out(R, #{ live_out := LiveOut }) -> ordsets:is_element(R, LiveOut). + +%% -- Optimizations -- + simplify([]) -> []; simplify([I | Code]) -> simpl_top(simpl_s(I), simplify(Code)). @@ -199,27 +374,82 @@ simpl_s({ifte, Then, Else}) -> {ifte, simplify(Then), simplify(Else)}; simpl_s(I) -> I. +simpl_top(I, Code) -> + %% io:format("simpl_top\n I = ~120p\n Is = ~120p\n", [I, Code]), + simpl_top1(I, Code). + %% Removing pushes that are immediately consumed. -simpl_top({'PUSH', A}, [{Op, R, ?a, B} | Code]) when ?IsBinOp(Op) -> - simpl_top({Op, R, A, B}, Code); -simpl_top({'PUSH', B}, [{Op, R, A, ?a} | Code]) when not ?IsStackArg(A), ?IsBinOp(Op) -> - simpl_top({Op, R, A, B}, Code); -simpl_top({'PUSH', A}, [{Op1, ?a, B, C}, {Op2, R, ?a, ?a} | Code]) when ?IsBinOp(Op1), ?IsBinOp(Op2) -> - simpl_top({Op1, ?a, B, C}, [{Op2, R, ?a, A} | Code]); +simpl_top1({Ann1, {'PUSH', A}}, [{Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> + simpl_top({merge_ann(Ann1, Ann2), {Op, R, A, B}}, Code); +simpl_top1({Ann1, {'PUSH', B}}, [{Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> + simpl_top({merge_ann(Ann1, Ann2), {Op, R, A, B}}, Code); +simpl_top1({Ann, {'PUSH', A}}, [{Ann1, {Op1, ?a, B, C}}, {Ann2, {Op2, R, ?a, ?a}} | Code]) when ?IsBinOp(Op1), ?IsBinOp(Op2) -> + simpl_top({merge_ann(Ann, Ann1), {Op1, ?a, B, C}}, [{Ann2, {Op2, R, ?a, A}} | Code]); + +%% Simplify PUSH followed by POP +simpl_top1({Ann1, {'PUSH', A}}, [{Ann2, {'POP', B}} | Code]) -> + case live_out(B, Ann2) of + true -> simpl_top({merge_ann(Ann1, Ann2), {'STORE', B, A}}, Code); + false -> Code + end; + +%% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations +simpl_top1(I = {Ann, {'PUSH', A}}, [{_, 'DUPA'} | Code]) -> + #{ live_in := Live } = Ann, + Ann1 = #{ live_in => Live, live_out => Live }, + simpl_top({Ann1, {'PUSH', A}}, simpl_top(I, Code)); + +%% Move PUSH A past an operator. Make sure the next instruction isn't writing +%% to A, pushing to the stack or reading the accumulator. +simpl_top1({Ann1, {'PUSH', A}}, [{Ann2, I = {Op, R, B, C}} | Code]) when ?IsBinOp(Op), A /= R, A /= ?a, B /= ?a, C /= ?a -> + #{ live_in := Live1, live_out := Live2 } = Ann1, + #{ live_in := Live2, live_out := Live3 } = Ann2, + Live2_ = ordsets:union([Live1, Live2, Live3]), %% Conservative approximation + Ann1_ = #{ live_in => Live1, live_out => Live2_ }, + Ann2_ = #{ live_in => Live2_, live_out => Live3 }, + simpl_top({Ann1_, I}, simpl_top({Ann2_, {'PUSH', A}}, Code)); %% Writing directly to memory instead of going through the accumulator. -simpl_top({Op, ?a, A, B}, [{'STORE', R, ?a} | Code]) when ?IsBinOp(Op) -> - simpl_top({Op, R, A, B}, Code); +simpl_top1({Ann1, {Op, ?a, A, B}}, [{Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> + simpl_top({merge_ann(Ann1, Ann2), {Op, R, A, B}}, Code); -simpl_top(I, Code) -> [I | Code]. +%% Shortcut write followed by final read +simpl_top1(I = {Ann1, {Op, R = {var, _}, A, B}}, Code0 = [{Ann2, J} | Code]) when ?IsBinOp(Op) -> + Copy = case J of + {'PUSH', R} -> {write_to, ?a}; + {'STORE', S, R} -> {write_to, S}; + _ -> false + end, + case {live_out(R, Ann2), Copy} of + {false, {write_to, X}} -> + simpl_top({merge_ann(Ann1, Ann2), {Op, X, A, B}}, Code); + _ -> simpl_top2(I, Code0) + end; -%% Desugar and specialize -desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_code:inc()]; -desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_code:dec()]; +simpl_top1(I, Code) -> simpl_top2(I, Code). %% simpl_top2 to get fallthrough + +%% Remove writes to dead variables +simpl_top2(I = {Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> + case live_out(R, Ann) of + false -> + %% Subtle: we still have to pop the stack if any of the arguments + %% came from there. In this case we pop to R, which we know is + %% unused. + io:format("Removing write to dead var: ~p\n", [I]), + lists:foldr(fun simpl_top/2, Code, + [{Ann, {'POP', R}} || X <- [A, B], X == ?a]); + true -> [I | Code] + end; +simpl_top2(I, Code) -> [I | Code]. + + +%% Desugar and specialize and remove annotations +desugar({_Ann, {'ADD', ?a, ?i(1), ?a}}) -> [aeb_fate_code:inc()]; +desugar({_Ann, {'SUB', ?a, ?a, ?i(1)}}) -> [aeb_fate_code:dec()]; desugar({ifte, Then, Else}) -> [{ifte, desugar(Then), desugar(Else)}]; desugar(Code) when is_list(Code) -> lists:flatmap(fun desugar/1, Code); -desugar(I) -> [I]. +desugar({_Ann, I}) -> [I]. %% -- Phase III -------------------------------------------------------------- %% Constructing basic blocks -- 2.30.2 From 47a48812b8d5d40cd7f48b49dab07ffbdc6eb513 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 11:28:46 +0200 Subject: [PATCH 08/87] Fix minor bug --- src/aeso_ast_to_fcode.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index bb81cb8..1ba0f5a 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -220,7 +220,7 @@ pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). stmts_to_fcode(Env, [{letval, _, Pat, _, Expr} | Stmts]) -> {switch, expr_to_fcode(Env, Expr), - [{pat_to_fcode(Env, Pat), stmts_to_fcode(Env, Stmts)}]}; + [{'case', pat_to_fcode(Env, Pat), stmts_to_fcode(Env, Stmts)}]}; stmts_to_fcode(Env, [Expr]) -> expr_to_fcode(Env, Expr). -- 2.30.2 From e224aadff7efd27999c1579559bb96d6ad4b927a Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 11:32:57 +0200 Subject: [PATCH 09/87] Use RETURNR when possible --- src/aeso_fcode_to_fate.erl | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 603cb55..06ff395 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -197,7 +197,8 @@ optimize_fun(_Funs, Name, {{Args, Res}, Code}, Options) -> annotate_code(Code) -> {WCode, _} = ann_writes(Code, ordsets:new(), []), - ann_reads(WCode, ordsets:new(), []). + {RCode, _} = ann_reads(WCode, ordsets:new(), []), + RCode. %% Reverses the code ann_writes([{ifte, Then, Else} | Code], Writes, Acc) -> @@ -233,7 +234,7 @@ ann_reads([{Ann, I} | Code], Reads, Acc) -> LiveOut = ordsets:intersection(Reads, WritesOut), Ann1 = #{ live_in => LiveIn, live_out => LiveOut }, ann_reads(Code, Reads1, [{Ann1, I} | Acc]); -ann_reads([], _, Acc) -> Acc. +ann_reads([], Reads, Acc) -> {Acc, Reads}. %% Which variables/args does an instruction read/write. Stack usage is more %% complicated so not tracked. @@ -500,7 +501,8 @@ optimize_blocks(Blocks) -> RBlocks1 = reorder_blocks(RBlocks, []), RBlocks2 = [ {Ref, inline_block(RBlockMap, Ref, Code)} || {Ref, Code} <- RBlocks1 ], RBlocks3 = remove_dead_blocks(RBlocks2), - Rev(RBlocks3). + RBlocks4 = [ {Ref, use_returnr(Code)} || {Ref, Code} <- RBlocks3 ], + Rev(RBlocks4). %% Choose the next block based on the final jump. reorder_blocks([], Acc) -> @@ -547,6 +549,10 @@ chase_labels([L | Ls], Map, Live) -> New = lists:flatmap(Jump, Code), chase_labels(New ++ Ls, Map, Live#{ L => true }). +%% Replace PUSH, RETURN by RETURNR +use_returnr(['RETURN', {'PUSH', A} | Code]) -> + [{'RETURNR', A} | Code]; +use_returnr(Code) -> Code. %% -- Translate label refs to indices -- -- 2.30.2 From 185487afda2c9062c895ca9626bea534aa1d3b1e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 11:56:58 +0200 Subject: [PATCH 10/87] Nicer debug printing --- src/aeso_fcode_to_fate.erl | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 06ff395..d257bf1 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -184,15 +184,29 @@ flatten_s(I) -> I. optimize_fun(_Funs, Name, {{Args, Res}, Code}, Options) -> Code0 = flatten(Code), debug(Options, "Optimizing ~s\n", [Name]), - debug(Options, " original : ~p\n", [Code0]), ACode = annotate_code(Code0), - debug(Options, " annotated : ~p\n", [ACode]), + debug(Options, " original:\n~s\n", [pp_ann(" ", ACode)]), Code1 = simplify(ACode), - debug(Options, " simplified: ~p\n", [Code1]), + debug(Options, " optimized:\n~s\n", [pp_ann(" ", Code1)]), Code2 = desugar(Code1), - debug(Options, " desugared : ~p\n", [Code2]), {{Args, Res}, Code2}. +pp_ann(Ind, [{ifte, Then, Else} | Code]) -> + [Ind, "IF-THEN\n", + pp_ann(" " ++ Ind, Then), + Ind, "ELSE\n", + pp_ann(" " ++ Ind, Else), + pp_ann(Ind, Code)]; +pp_ann(Ind, [{#{ live_in := In, live_out := Out }, I} | Code]) -> + Fmt = fun([]) -> "()"; + (Xs) -> string:join([lists:concat(["var", N]) || {var, N} <- Xs], " ") + end, + Op = [Ind, aeb_fate_pp:format_op(I, #{})], + Ann = [[" % ", Fmt(In), " -> ", Fmt(Out)] || In ++ Out /= []], + [io_lib:format("~-40s~s\n", [Op, Ann]), + pp_ann(Ind, Code)]; +pp_ann(_, []) -> []. + %% -- Analysis -- annotate_code(Code) -> @@ -406,7 +420,7 @@ simpl_top1({Ann1, {'PUSH', A}}, [{Ann2, I = {Op, R, B, C}} | Code]) when ?IsBinO #{ live_in := Live1, live_out := Live2 } = Ann1, #{ live_in := Live2, live_out := Live3 } = Ann2, Live2_ = ordsets:union([Live1, Live2, Live3]), %% Conservative approximation - Ann1_ = #{ live_in => Live1, live_out => Live2_ }, + Ann1_ = #{ live_in => Live1, live_out => Live2_ }, Ann2_ = #{ live_in => Live2_, live_out => Live3 }, simpl_top({Ann1_, I}, simpl_top({Ann2_, {'PUSH', A}}, Code)); @@ -436,7 +450,6 @@ simpl_top2(I = {Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> %% Subtle: we still have to pop the stack if any of the arguments %% came from there. In this case we pop to R, which we know is %% unused. - io:format("Removing write to dead var: ~p\n", [I]), lists:foldr(fun simpl_top/2, Code, [{Ann, {'POP', R}} || X <- [A, B], X == ?a]); true -> [I | Code] -- 2.30.2 From 3ec156a4b4e40362f9e7443be2becb9f66900abe Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 13:38:51 +0200 Subject: [PATCH 11/87] Refactor optimization rules --- src/aeso_fcode_to_fate.erl | 315 ++++++++++++++++++++----------------- 1 file changed, 172 insertions(+), 143 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index d257bf1..76cfb99 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -39,9 +39,9 @@ %% -- Debugging -------------------------------------------------------------- -%% debug(Options, Fmt) -> debug(Options, Fmt, []). -debug(Options, Fmt, Args) -> - case proplists:get_value(debug, Options, true) of +debug(Tag, Options, Fmt, Args) -> + Tags = proplists:get_value(debug, Options, []), + case Tags == all orelse lists:member(Tag, Tags) orelse Tag == any andalso Tags /= [] of true -> io:format(Fmt, Args); false -> ok end. @@ -59,7 +59,7 @@ compile(ICode, Options) -> FateCode = #{ functions => BBFuns, symbols => #{}, annotations => #{} }, - debug(Options, "~s\n", [aeb_fate_asm:pp(FateCode)]), + debug(compile, Options, "~s\n", [aeb_fate_asm:pp(FateCode)]), FateCode. make_function_name(init) -> <<"init">>; @@ -75,10 +75,10 @@ functions_to_scode(Functions, Options) -> Name /= init ]). %% TODO: skip init for now function_to_scode(Name, Args, Body, ResType, Options) -> - debug(Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, ResType, Body]), + debug(scode, Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, ResType, Body]), ArgTypes = [ T || {_, T} <- Args ], SCode = to_scode(init_env(Args), Body), - debug(Options, " scode: ~p\n", [SCode]), + debug(scode, Options, " scode: ~p\n", [SCode]), {{ArgTypes, ResType}, SCode}. %% -- Phase I ---------------------------------------------------------------- @@ -183,11 +183,11 @@ flatten_s(I) -> I. optimize_fun(_Funs, Name, {{Args, Res}, Code}, Options) -> Code0 = flatten(Code), - debug(Options, "Optimizing ~s\n", [Name]), + debug(opt, Options, "Optimizing ~s\n", [Name]), ACode = annotate_code(Code0), - debug(Options, " original:\n~s\n", [pp_ann(" ", ACode)]), - Code1 = simplify(ACode), - debug(Options, " optimized:\n~s\n", [pp_ann(" ", Code1)]), + debug(opt, Options, " original:\n~s\n", [pp_ann(" ", ACode)]), + Code1 = simplify(ACode, Options), + debug(opt, Options, " optimized:\n~s\n", [pp_ann(" ", Code1)]), Code2 = desugar(Code1), {{Args, Res}, Code2}. @@ -221,7 +221,7 @@ ann_writes([{ifte, Then, Else} | Code], Writes, Acc) -> Writes1 = ordsets:union(Writes, ordsets:intersection(WritesThen, WritesElse)), ann_writes(Code, Writes1, [{ifte, Then1, Else1} | Acc]); ann_writes([I | Code], Writes, Acc) -> - #{ write := Ws } = readwrite(I), + #{ write := Ws } = attributes(I), Writes1 = ordsets:union(Writes, Ws), Ann = #{ writes_in => Writes, writes_out => Writes1 }, ann_writes(Code, Writes1, [{Ann, I} | Acc]); @@ -236,11 +236,12 @@ ann_reads([{ifte, Then, Else} | Code], Reads, Acc) -> ann_reads(Code, Reads1, [{ifte, Then1, Else1} | Acc]); ann_reads([{Ann, I} | Code], Reads, Acc) -> #{ writes_in := WritesIn, writes_out := WritesOut } = Ann, - #{ read := Rs, write := Ws } = readwrite(I), + #{ read := Rs, write := Ws, pure := Pure } = attributes(I), Reads1 = - case length(Ws) == 1 andalso not ordsets:is_element(hd(Ws), Reads) of + case Pure andalso length(Ws) == 1 andalso not ordsets:is_element(hd(Ws), Reads) of %% This is a little bit dangerous: if writing to a dead variable, we ignore - %% the reads. Relies on dead writes to be removed by the optimisations below. + %% the reads. Relies on dead writes to be removed by the + %% optimisations below (r_write_to_dead_var). true -> Reads; false -> ordsets:union(Reads, Rs) end, @@ -250,15 +251,15 @@ ann_reads([{Ann, I} | Code], Reads, Acc) -> ann_reads(Code, Reads1, [{Ann1, I} | Acc]); ann_reads([], Reads, Acc) -> {Acc, Reads}. -%% Which variables/args does an instruction read/write. Stack usage is more -%% complicated so not tracked. -readwrite(I) -> +%% Read/write to variables and purity. +attributes(I) -> Set = fun(L) when is_list(L) -> ordsets:from_list([X || X <- L, X /= ?a]); (X) -> ordsets:from_list([X || X /= ?a]) end, - WR = fun(W, R) -> #{read => Set(R), write => Set(W)} end, + WR = fun(W, R) -> #{read => Set(R), write => Set(W), pure => false} end, R = fun(X) -> WR([], X) end, W = fun(X) -> WR(X, []) end, None = WR([], []), + Pure = fun(A) -> A#{ pure := true } end, case I of 'RETURN' -> None; {'RETURNR', A} -> R(A); @@ -266,84 +267,84 @@ readwrite(I) -> {'CALL_R', A, _} -> R(A); {'CALL_T', _} -> None; {'CALL_TR', A, _} -> R(A); - {'JUMP', _} -> None; - {'JUMPIF', A, _} -> R(A); - {'SWITCH_V2', A, _, _} -> R(A); - {'SWITCH_V3', A, _, _, _} -> R(A); - {'SWITCH_VN', A, _} -> R(A); - {'PUSH', A} -> R(A); - 'DUPA' -> None; - {'DUP', A} -> R(A); - {'POP', A} -> W(A); - {'STORE', A, B} -> WR(A, B); - 'INCA' -> None; - {'INC', A} -> WR(A, A); - 'DECA' -> None; - {'DEC', A} -> WR(A, A); - {'ADD', A, B, C} -> WR(A, [B, C]); - {'SUB', A, B, C} -> WR(A, [B, C]); - {'MUL', A, B, C} -> WR(A, [B, C]); - {'DIV', A, B, C} -> WR(A, [B, C]); - {'MOD', A, B, C} -> WR(A, [B, C]); - {'POW', A, B, C} -> WR(A, [B, C]); - {'LT', A, B, C} -> WR(A, [B, C]); - {'GT', A, B, C} -> WR(A, [B, C]); - {'EQ', A, B, C} -> WR(A, [B, C]); - {'ELT', A, B, C} -> WR(A, [B, C]); - {'EGT', A, B, C} -> WR(A, [B, C]); - {'NEQ', A, B, C} -> WR(A, [B, C]); - {'AND', A, B, C} -> WR(A, [B, C]); - {'OR', A, B, C} -> WR(A, [B, C]); - {'NOT', A, B} -> WR(A, B); - {'TUPLE', _} -> None; - {'ELEMENT', A, B, C} -> WR(A, [B, C]); - {'MAP_EMPTY', A} -> W(A); - {'MAP_LOOKUP', A, B, C} -> WR(A, [B, C]); - {'MAP_LOOKUPD', A, B, C, D} -> WR(A, [B, C, D]); - {'MAP_UPDATE', A, B, C, D} -> WR(A, [B, C, D]); - {'MAP_DELETE', A, B, C} -> WR(A, [B, C]); - {'MAP_MEMBER', A, B, C} -> WR(A, [B, C]); - {'MAP_FROM_LIST', A, B} -> WR(A, B); - {'NIL', A} -> W(A); - {'IS_NIL', A, B} -> WR(A, B); - {'CONS', A, B, C} -> WR(A, [B, C]); - {'HD', A, B} -> WR(A, B); - {'TL', A, B} -> WR(A, B); - {'LENGTH', A, B} -> WR(A, B); - {'STR_EQ', A, B, C} -> WR(A, [B, C]); - {'STR_JOIN', A, B, C} -> WR(A, [B, C]); - {'INT_TO_STR', A, B} -> WR(A, B); - {'ADDR_TO_STR', A, B} -> WR(A, B); - {'STR_REVERSE', A, B} -> WR(A, B); - {'INT_TO_ADDR', A, B} -> WR(A, B); - {'VARIANT', A, B, C, D} -> WR(A, [B, C, D]); - {'VARIANT_TEST', A, B, C} -> WR(A, [B, C]); - {'VARIANT_ELEMENT', A, B, C} -> WR(A, [B, C]); - 'BITS_NONEA' -> None; - {'BITS_NONE', A} -> W(A); - 'BITS_ALLA' -> None; - {'BITS_ALL', A} -> W(A); - {'BITS_ALL_N', A, B} -> WR(A, B); - {'BITS_SET', A, B, C} -> WR(A, [B, C]); - {'BITS_CLEAR', A, B, C} -> WR(A, [B, C]); - {'BITS_TEST', A, B, C} -> WR(A, [B, C]); - {'BITS_SUM', A, B} -> WR(A, B); - {'BITS_OR', A, B, C} -> WR(A, [B, C]); - {'BITS_AND', A, B, C} -> WR(A, [B, C]); - {'BITS_DIFF', A, B, C} -> WR(A, [B, C]); - {'ADDRESS', A} -> W(A); - {'BALANCE', A} -> W(A); - {'ORIGIN', A} -> W(A); - {'CALLER', A} -> W(A); - {'GASPRICE', A} -> W(A); - {'BLOCKHASH', A} -> W(A); - {'BENEFICIARY', A} -> W(A); - {'TIMESTAMP', A} -> W(A); - {'GENERATION', A} -> W(A); - {'MICROBLOCK', A} -> W(A); - {'DIFFICULTY', A} -> W(A); - {'GASLIMIT', A} -> W(A); - {'GAS', A} -> W(A); + {'JUMP', _} -> Pure(None); + {'JUMPIF', A, _} -> Pure(R(A)); + {'SWITCH_V2', A, _, _} -> Pure(R(A)); + {'SWITCH_V3', A, _, _, _} -> Pure(R(A)); + {'SWITCH_VN', A, _} -> Pure(R(A)); + {'PUSH', A} -> Pure(R(A)); + 'DUPA' -> Pure(None); + {'DUP', A} -> Pure(R(A)); + {'POP', A} -> Pure(W(A)); + {'STORE', A, B} -> Pure(WR(A, B)); + 'INCA' -> Pure(None); + {'INC', A} -> Pure(WR(A, A)); + 'DECA' -> Pure(None); + {'DEC', A} -> Pure(WR(A, A)); + {'ADD', A, B, C} -> Pure(WR(A, [B, C])); + {'SUB', A, B, C} -> Pure(WR(A, [B, C])); + {'MUL', A, B, C} -> Pure(WR(A, [B, C])); + {'DIV', A, B, C} -> Pure(WR(A, [B, C])); + {'MOD', A, B, C} -> Pure(WR(A, [B, C])); + {'POW', A, B, C} -> Pure(WR(A, [B, C])); + {'LT', A, B, C} -> Pure(WR(A, [B, C])); + {'GT', A, B, C} -> Pure(WR(A, [B, C])); + {'EQ', A, B, C} -> Pure(WR(A, [B, C])); + {'ELT', A, B, C} -> Pure(WR(A, [B, C])); + {'EGT', A, B, C} -> Pure(WR(A, [B, C])); + {'NEQ', A, B, C} -> Pure(WR(A, [B, C])); + {'AND', A, B, C} -> Pure(WR(A, [B, C])); + {'OR', A, B, C} -> Pure(WR(A, [B, C])); + {'NOT', A, B} -> Pure(WR(A, B)); + {'TUPLE', _} -> Pure(None); + {'ELEMENT', A, B, C} -> Pure(WR(A, [B, C])); + {'MAP_EMPTY', A} -> Pure(W(A)); + {'MAP_LOOKUP', A, B, C} -> Pure(WR(A, [B, C])); + {'MAP_LOOKUPD', A, B, C, D} -> Pure(WR(A, [B, C, D])); + {'MAP_UPDATE', A, B, C, D} -> Pure(WR(A, [B, C, D])); + {'MAP_DELETE', A, B, C} -> Pure(WR(A, [B, C])); + {'MAP_MEMBER', A, B, C} -> Pure(WR(A, [B, C])); + {'MAP_FROM_LIST', A, B} -> Pure(WR(A, B)); + {'NIL', A} -> Pure(W(A)); + {'IS_NIL', A, B} -> Pure(WR(A, B)); + {'CONS', A, B, C} -> Pure(WR(A, [B, C])); + {'HD', A, B} -> Pure(WR(A, B)); + {'TL', A, B} -> Pure(WR(A, B)); + {'LENGTH', A, B} -> Pure(WR(A, B)); + {'STR_EQ', A, B, C} -> Pure(WR(A, [B, C])); + {'STR_JOIN', A, B, C} -> Pure(WR(A, [B, C])); + {'INT_TO_STR', A, B} -> Pure(WR(A, B)); + {'ADDR_TO_STR', A, B} -> Pure(WR(A, B)); + {'STR_REVERSE', A, B} -> Pure(WR(A, B)); + {'INT_TO_ADDR', A, B} -> Pure(WR(A, B)); + {'VARIANT', A, B, C, D} -> Pure(WR(A, [B, C, D])); + {'VARIANT_TEST', A, B, C} -> Pure(WR(A, [B, C])); + {'VARIANT_ELEMENT', A, B, C} -> Pure(WR(A, [B, C])); + 'BITS_NONEA' -> Pure(None); + {'BITS_NONE', A} -> Pure(W(A)); + 'BITS_ALLA' -> Pure(None); + {'BITS_ALL', A} -> Pure(W(A)); + {'BITS_ALL_N', A, B} -> Pure(WR(A, B)); + {'BITS_SET', A, B, C} -> Pure(WR(A, [B, C])); + {'BITS_CLEAR', A, B, C} -> Pure(WR(A, [B, C])); + {'BITS_TEST', A, B, C} -> Pure(WR(A, [B, C])); + {'BITS_SUM', A, B} -> Pure(WR(A, B)); + {'BITS_OR', A, B, C} -> Pure(WR(A, [B, C])); + {'BITS_AND', A, B, C} -> Pure(WR(A, [B, C])); + {'BITS_DIFF', A, B, C} -> Pure(WR(A, [B, C])); + {'ADDRESS', A} -> Pure(W(A)); + {'BALANCE', A} -> Pure(W(A)); + {'ORIGIN', A} -> Pure(W(A)); + {'CALLER', A} -> Pure(W(A)); + {'GASPRICE', A} -> Pure(W(A)); + {'BLOCKHASH', A} -> Pure(W(A)); + {'BENEFICIARY', A} -> Pure(W(A)); + {'TIMESTAMP', A} -> Pure(W(A)); + {'GENERATION', A} -> Pure(W(A)); + {'MICROBLOCK', A} -> Pure(W(A)); + {'DIFFICULTY', A} -> Pure(W(A)); + {'GASLIMIT', A} -> Pure(W(A)); + {'GAS', A} -> Pure(W(A)); {'LOG0', A, B} -> R([A, B]); {'LOG1', A, B, C} -> R([A, B, C]); {'LOG2', A, B, C, D} -> R([A, B, C, D]); @@ -364,72 +365,102 @@ readwrite(I) -> 'AENS_UPDATE' -> None; %% TODO 'AENS_TRANSFER' -> None; %% TODO 'AENS_REVOKE' -> None; %% TODO - 'ECVERIFY' -> None; %% TODO - 'SHA3' -> None; %% TODO - 'SHA256' -> None; %% TODO - 'BLAKE2B' -> None; %% TODO + 'ECVERIFY' -> Pure(None); %% TODO + 'SHA3' -> Pure(None); %% TODO + 'SHA256' -> Pure(None); %% TODO + 'BLAKE2B' -> Pure(None); %% TODO {'ABORT', A} -> R(A); {'EXIT', A} -> R(A); - 'NOP' -> None + 'NOP' -> Pure(None) end. merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> #{ live_in => LiveIn, live_out => LiveOut }. +%% When swapping two instructions +swap_ann(#{ live_in := Live1, live_out := Live2 }, #{ live_in := Live2, live_out := Live3 }) -> + Live2_ = ordsets:union([Live1, Live2, Live3]), %% Conservative approximation + {#{ live_in => Live1, live_out => Live2_ }, + #{ live_in => Live2_, live_out => Live3 }}. + %% live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn). live_out(R, #{ live_out := LiveOut }) -> ordsets:is_element(R, LiveOut). %% -- Optimizations -- -simplify([]) -> []; -simplify([I | Code]) -> - simpl_top(simpl_s(I), simplify(Code)). +simplify([], _) -> []; +simplify([I | Code], Options) -> + simpl_top(simpl_s(I, Options), simplify(Code, Options), Options). -simpl_s({ifte, Then, Else}) -> - {ifte, simplify(Then), simplify(Else)}; -simpl_s(I) -> I. +simpl_s({ifte, Then, Else}, Options) -> + {ifte, simplify(Then, Options), simplify(Else, Options)}; +simpl_s(I, _) -> I. -simpl_top(I, Code) -> - %% io:format("simpl_top\n I = ~120p\n Is = ~120p\n", [I, Code]), - simpl_top1(I, Code). +simpl_top(I, Code, Options) -> + apply_rules(rules(), I, Code, Options). + +apply_rules([], I, Code, _) -> + [I | Code]; +apply_rules([{_RName, Rule} | Rules], I, Code, Options) -> + Cons = fun(X, Xs) -> simpl_top(X, Xs, Options) end, + case Rule(I, Code) of + false -> apply_rules(Rules, I, Code, Options); + {New, Rest} -> + debug(opt_rules, Options, "Applied ~p:\n~s ==>\n~s", [_RName, pp_ann(" ", [I | Code]), pp_ann(" ", New ++ Rest)]), + lists:foldr(Cons, Rest, New) + end. + +-define(RULE(Name), {Name, fun Name/2}). + +rules() -> + [?RULE(r_push_consume), + ?RULE(r_dup_to_push), + ?RULE(r_swap_instrs), + ?RULE(r_one_shot_var), + ?RULE(r_write_to_dead_var) + ]. %% Removing pushes that are immediately consumed. -simpl_top1({Ann1, {'PUSH', A}}, [{Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> - simpl_top({merge_ann(Ann1, Ann2), {Op, R, A, B}}, Code); -simpl_top1({Ann1, {'PUSH', B}}, [{Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> - simpl_top({merge_ann(Ann1, Ann2), {Op, R, A, B}}, Code); -simpl_top1({Ann, {'PUSH', A}}, [{Ann1, {Op1, ?a, B, C}}, {Ann2, {Op2, R, ?a, ?a}} | Code]) when ?IsBinOp(Op1), ?IsBinOp(Op2) -> - simpl_top({merge_ann(Ann, Ann1), {Op1, ?a, B, C}}, [{Ann2, {Op2, R, ?a, A}} | Code]); - -%% Simplify PUSH followed by POP -simpl_top1({Ann1, {'PUSH', A}}, [{Ann2, {'POP', B}} | Code]) -> +r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> + {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; +r_push_consume({Ann1, {'PUSH', B}}, [{Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> + {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; +r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {'POP', B}} | Code]) -> case live_out(B, Ann2) of - true -> simpl_top({merge_ann(Ann1, Ann2), {'STORE', B, A}}, Code); - false -> Code + true -> {[{merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; + false -> {[], Code} end; +%% Writing directly to memory instead of going through the accumulator. +r_push_consume({Ann1, {Op, ?a, A, B}}, [{Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> + {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; + +r_push_consume(_, _) -> false. %% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations -simpl_top1(I = {Ann, {'PUSH', A}}, [{_, 'DUPA'} | Code]) -> +r_dup_to_push(I = {Ann, {'PUSH', A}}, [{_, 'DUPA'} | Code]) -> #{ live_in := Live } = Ann, Ann1 = #{ live_in => Live, live_out => Live }, - simpl_top({Ann1, {'PUSH', A}}, simpl_top(I, Code)); + {[{Ann1, {'PUSH', A}}, I], Code}; +r_dup_to_push(_, _) -> false. %% Move PUSH A past an operator. Make sure the next instruction isn't writing %% to A, pushing to the stack or reading the accumulator. -simpl_top1({Ann1, {'PUSH', A}}, [{Ann2, I = {Op, R, B, C}} | Code]) when ?IsBinOp(Op), A /= R, A /= ?a, B /= ?a, C /= ?a -> - #{ live_in := Live1, live_out := Live2 } = Ann1, - #{ live_in := Live2, live_out := Live3 } = Ann2, - Live2_ = ordsets:union([Live1, Live2, Live3]), %% Conservative approximation - Ann1_ = #{ live_in => Live1, live_out => Live2_ }, - Ann2_ = #{ live_in => Live2_, live_out => Live3 }, - simpl_top({Ann1_, I}, simpl_top({Ann2_, {'PUSH', A}}, Code)); +r_swap_instrs({Ann1, {'PUSH', A}}, [{Ann2, I = {Op, R, B, C}} | Code]) when ?IsBinOp(Op), A /= R, A /= ?a, B /= ?a, C /= ?a -> + {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), + {[{Ann1_, I}, {Ann2_, {'PUSH', A}}], Code}; -%% Writing directly to memory instead of going through the accumulator. -simpl_top1({Ann1, {Op, ?a, A, B}}, [{Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> - simpl_top({merge_ann(Ann1, Ann2), {Op, R, A, B}}, Code); +%% Move writes to a variable as late as possible +r_swap_instrs({Ann1, I1 = {Op1, R = {var, _}, A, B}}, [{Ann2, I2 = {Op2, S, C, D}} | Code]) + when ?IsBinOp(Op1), ?IsBinOp(Op2), + element(1, S) /= var orelse S < R, + S /= A, S /= B, C /= R, D /= R, + A /= ?a andalso B /= ?a orelse S /= ?a andalso C /= ?a andalso D /= ?a -> + {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), + {[{Ann1_, I2}, {Ann2_, I1}], Code}; +r_swap_instrs(_, _) -> false. %% Shortcut write followed by final read -simpl_top1(I = {Ann1, {Op, R = {var, _}, A, B}}, Code0 = [{Ann2, J} | Code]) when ?IsBinOp(Op) -> +r_one_shot_var({Ann1, {Op, R = {var, _}, A, B}}, [{Ann2, J} | Code]) when ?IsBinOp(Op) -> Copy = case J of {'PUSH', R} -> {write_to, ?a}; {'STORE', S, R} -> {write_to, S}; @@ -437,24 +468,22 @@ simpl_top1(I = {Ann1, {Op, R = {var, _}, A, B}}, Code0 = [{Ann2, J} | Code]) whe end, case {live_out(R, Ann2), Copy} of {false, {write_to, X}} -> - simpl_top({merge_ann(Ann1, Ann2), {Op, X, A, B}}, Code); - _ -> simpl_top2(I, Code0) + {[{merge_ann(Ann1, Ann2), {Op, X, A, B}}], Code}; + _ -> false end; - -simpl_top1(I, Code) -> simpl_top2(I, Code). %% simpl_top2 to get fallthrough +r_one_shot_var(_, _) -> false. %% Remove writes to dead variables -simpl_top2(I = {Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> +r_write_to_dead_var({Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> case live_out(R, Ann) of false -> %% Subtle: we still have to pop the stack if any of the arguments %% came from there. In this case we pop to R, which we know is %% unused. - lists:foldr(fun simpl_top/2, Code, - [{Ann, {'POP', R}} || X <- [A, B], X == ?a]); - true -> [I | Code] + {[{Ann, {'POP', R}} || X <- [A, B], X == ?a], Code}; + true -> false end; -simpl_top2(I, Code) -> [I | Code]. +r_write_to_dead_var(_, _) -> false. %% Desugar and specialize and remove annotations -- 2.30.2 From 788840f0fadb1771714566d2cf5c33a19ee411c4 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 13:39:01 +0200 Subject: [PATCH 12/87] Compile tuple construction --- src/aeso_ast_to_fcode.erl | 4 ++++ src/aeso_fcode_to_fate.erl | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 1ba0f5a..b8eb91e 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -176,6 +176,10 @@ expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; %% Variables expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; +%% Tuples +expr_to_fcode(Env, _Type, {tuple, _, Es}) -> + {tuple, [expr_to_fcode(Env, E) || E <- Es]}; + %% Conditionals expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> {'if', expr_to_fcode(Env, Cond), diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 76cfb99..40a75df 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -112,6 +112,11 @@ to_scode(_Env, {integer, N}) -> to_scode(Env, {var, X}) -> [aeb_fate_code:push(lookup_var(Env, X))]; +to_scode(Env, {tuple, As}) -> + N = length(As), + [[ to_scode(Env, A) || A <- As ], + aeb_fate_code:tuple(N)]; + to_scode(Env, {binop, Type, Op, A, B}) -> [ to_scode(notail(Env), B), to_scode(push_env(Type, Env), A), -- 2.30.2 From ac25a8fc55ca62570d50991192a7ec842c473600 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 15:03:31 +0200 Subject: [PATCH 13/87] Improve instruction analysis and generalize some optimizations --- src/aeso_fcode_to_fate.erl | 358 +++++++++++++++++++++---------------- 1 file changed, 206 insertions(+), 152 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 40a75df..c007d19 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -10,6 +10,7 @@ -module(aeso_fcode_to_fate). -export([compile/2]). +-compile([export_all, no_warn_export_all]). %% -- Preamble --------------------------------------------------------------- @@ -226,7 +227,7 @@ ann_writes([{ifte, Then, Else} | Code], Writes, Acc) -> Writes1 = ordsets:union(Writes, ordsets:intersection(WritesThen, WritesElse)), ann_writes(Code, Writes1, [{ifte, Then1, Else1} | Acc]); ann_writes([I | Code], Writes, Acc) -> - #{ write := Ws } = attributes(I), + Ws = var_writes(I), Writes1 = ordsets:union(Writes, Ws), Ann = #{ writes_in => Writes, writes_out => Writes1 }, ann_writes(Code, Writes1, [{Ann, I} | Acc]); @@ -241,14 +242,14 @@ ann_reads([{ifte, Then, Else} | Code], Reads, Acc) -> ann_reads(Code, Reads1, [{ifte, Then1, Else1} | Acc]); ann_reads([{Ann, I} | Code], Reads, Acc) -> #{ writes_in := WritesIn, writes_out := WritesOut } = Ann, - #{ read := Rs, write := Ws, pure := Pure } = attributes(I), + #{ read := Rs, write := W, pure := Pure } = attributes(I), Reads1 = - case Pure andalso length(Ws) == 1 andalso not ordsets:is_element(hd(Ws), Reads) of + case {W, Pure andalso not ordsets:is_element(W, Reads)} of %% This is a little bit dangerous: if writing to a dead variable, we ignore %% the reads. Relies on dead writes to be removed by the %% optimisations below (r_write_to_dead_var). - true -> Reads; - false -> ordsets:union(Reads, Rs) + {{var, _}, true} -> Reads; + _ -> ordsets:union(Reads, Rs) end, LiveIn = ordsets:intersection(Reads1, WritesIn), LiveOut = ordsets:intersection(Reads, WritesOut), @@ -256,127 +257,151 @@ ann_reads([{Ann, I} | Code], Reads, Acc) -> ann_reads(Code, Reads1, [{Ann1, I} | Acc]); ann_reads([], Reads, Acc) -> {Acc, Reads}. -%% Read/write to variables and purity. +%% Instruction attributes: reads, writes and purity (pure means no side-effects +%% aside from the reads and writes). attributes(I) -> - Set = fun(L) when is_list(L) -> ordsets:from_list([X || X <- L, X /= ?a]); - (X) -> ordsets:from_list([X || X /= ?a]) end, - WR = fun(W, R) -> #{read => Set(R), write => Set(W), pure => false} end, - R = fun(X) -> WR([], X) end, - W = fun(X) -> WR(X, []) end, - None = WR([], []), - Pure = fun(A) -> A#{ pure := true } end, + Set = fun(L) when is_list(L) -> ordsets:from_list(L); + (X) -> ordsets:from_list([X]) end, + Attr = fun(W, R, P) -> #{read => Set(R), write => W, pure => P} end, + Pure = fun(W, R) -> Attr(W, R, true) end, + Impure = fun(W, R) -> Attr(W, R, false) end, case I of - 'RETURN' -> None; - {'RETURNR', A} -> R(A); - {'CALL', _} -> None; - {'CALL_R', A, _} -> R(A); - {'CALL_T', _} -> None; - {'CALL_TR', A, _} -> R(A); - {'JUMP', _} -> Pure(None); - {'JUMPIF', A, _} -> Pure(R(A)); - {'SWITCH_V2', A, _, _} -> Pure(R(A)); - {'SWITCH_V3', A, _, _, _} -> Pure(R(A)); - {'SWITCH_VN', A, _} -> Pure(R(A)); - {'PUSH', A} -> Pure(R(A)); - 'DUPA' -> Pure(None); - {'DUP', A} -> Pure(R(A)); - {'POP', A} -> Pure(W(A)); - {'STORE', A, B} -> Pure(WR(A, B)); - 'INCA' -> Pure(None); - {'INC', A} -> Pure(WR(A, A)); - 'DECA' -> Pure(None); - {'DEC', A} -> Pure(WR(A, A)); - {'ADD', A, B, C} -> Pure(WR(A, [B, C])); - {'SUB', A, B, C} -> Pure(WR(A, [B, C])); - {'MUL', A, B, C} -> Pure(WR(A, [B, C])); - {'DIV', A, B, C} -> Pure(WR(A, [B, C])); - {'MOD', A, B, C} -> Pure(WR(A, [B, C])); - {'POW', A, B, C} -> Pure(WR(A, [B, C])); - {'LT', A, B, C} -> Pure(WR(A, [B, C])); - {'GT', A, B, C} -> Pure(WR(A, [B, C])); - {'EQ', A, B, C} -> Pure(WR(A, [B, C])); - {'ELT', A, B, C} -> Pure(WR(A, [B, C])); - {'EGT', A, B, C} -> Pure(WR(A, [B, C])); - {'NEQ', A, B, C} -> Pure(WR(A, [B, C])); - {'AND', A, B, C} -> Pure(WR(A, [B, C])); - {'OR', A, B, C} -> Pure(WR(A, [B, C])); - {'NOT', A, B} -> Pure(WR(A, B)); - {'TUPLE', _} -> Pure(None); - {'ELEMENT', A, B, C} -> Pure(WR(A, [B, C])); - {'MAP_EMPTY', A} -> Pure(W(A)); - {'MAP_LOOKUP', A, B, C} -> Pure(WR(A, [B, C])); - {'MAP_LOOKUPD', A, B, C, D} -> Pure(WR(A, [B, C, D])); - {'MAP_UPDATE', A, B, C, D} -> Pure(WR(A, [B, C, D])); - {'MAP_DELETE', A, B, C} -> Pure(WR(A, [B, C])); - {'MAP_MEMBER', A, B, C} -> Pure(WR(A, [B, C])); - {'MAP_FROM_LIST', A, B} -> Pure(WR(A, B)); - {'NIL', A} -> Pure(W(A)); - {'IS_NIL', A, B} -> Pure(WR(A, B)); - {'CONS', A, B, C} -> Pure(WR(A, [B, C])); - {'HD', A, B} -> Pure(WR(A, B)); - {'TL', A, B} -> Pure(WR(A, B)); - {'LENGTH', A, B} -> Pure(WR(A, B)); - {'STR_EQ', A, B, C} -> Pure(WR(A, [B, C])); - {'STR_JOIN', A, B, C} -> Pure(WR(A, [B, C])); - {'INT_TO_STR', A, B} -> Pure(WR(A, B)); - {'ADDR_TO_STR', A, B} -> Pure(WR(A, B)); - {'STR_REVERSE', A, B} -> Pure(WR(A, B)); - {'INT_TO_ADDR', A, B} -> Pure(WR(A, B)); - {'VARIANT', A, B, C, D} -> Pure(WR(A, [B, C, D])); - {'VARIANT_TEST', A, B, C} -> Pure(WR(A, [B, C])); - {'VARIANT_ELEMENT', A, B, C} -> Pure(WR(A, [B, C])); - 'BITS_NONEA' -> Pure(None); - {'BITS_NONE', A} -> Pure(W(A)); - 'BITS_ALLA' -> Pure(None); - {'BITS_ALL', A} -> Pure(W(A)); - {'BITS_ALL_N', A, B} -> Pure(WR(A, B)); - {'BITS_SET', A, B, C} -> Pure(WR(A, [B, C])); - {'BITS_CLEAR', A, B, C} -> Pure(WR(A, [B, C])); - {'BITS_TEST', A, B, C} -> Pure(WR(A, [B, C])); - {'BITS_SUM', A, B} -> Pure(WR(A, B)); - {'BITS_OR', A, B, C} -> Pure(WR(A, [B, C])); - {'BITS_AND', A, B, C} -> Pure(WR(A, [B, C])); - {'BITS_DIFF', A, B, C} -> Pure(WR(A, [B, C])); - {'ADDRESS', A} -> Pure(W(A)); - {'BALANCE', A} -> Pure(W(A)); - {'ORIGIN', A} -> Pure(W(A)); - {'CALLER', A} -> Pure(W(A)); - {'GASPRICE', A} -> Pure(W(A)); - {'BLOCKHASH', A} -> Pure(W(A)); - {'BENEFICIARY', A} -> Pure(W(A)); - {'TIMESTAMP', A} -> Pure(W(A)); - {'GENERATION', A} -> Pure(W(A)); - {'MICROBLOCK', A} -> Pure(W(A)); - {'DIFFICULTY', A} -> Pure(W(A)); - {'GASLIMIT', A} -> Pure(W(A)); - {'GAS', A} -> Pure(W(A)); - {'LOG0', A, B} -> R([A, B]); - {'LOG1', A, B, C} -> R([A, B, C]); - {'LOG2', A, B, C, D} -> R([A, B, C, D]); - {'LOG3', A, B, C, D, E} -> R([A, B, C, D, E]); - {'LOG4', A, B, C, D, E, F} -> R([A, B, C, D, E, F]); - 'DEACTIVATE' -> None; - {'SPEND', A, B} -> R([A, B]); - {'ORACLE_REGISTER', A, B, C, D, E, F} -> WR(A, [B, C, D, E, F]); - 'ORACLE_QUERY' -> None; %% TODO - 'ORACLE_RESPOND' -> None; %% TODO - 'ORACLE_EXTEND' -> None; %% TODO - 'ORACLE_GET_ANSWER' -> None; %% TODO - 'ORACLE_GET_QUESTION' -> None; %% TODO - 'ORACLE_QUERY_FEE' -> None; %% TODO - 'AENS_RESOLVE' -> None; %% TODO - 'AENS_PRECLAIM' -> None; %% TODO - 'AENS_CLAIM' -> None; %% TODO - 'AENS_UPDATE' -> None; %% TODO - 'AENS_TRANSFER' -> None; %% TODO - 'AENS_REVOKE' -> None; %% TODO - 'ECVERIFY' -> Pure(None); %% TODO - 'SHA3' -> Pure(None); %% TODO - 'SHA256' -> Pure(None); %% TODO - 'BLAKE2B' -> Pure(None); %% TODO - {'ABORT', A} -> R(A); - {'EXIT', A} -> R(A); - 'NOP' -> Pure(None) + 'RETURN' -> Impure(pc, []); + {'RETURNR', A} -> Impure(pc, A); + {'CALL', _} -> Impure(?a, []); + {'CALL_R', A, _} -> Impure(?a, A); + {'CALL_T', _} -> Impure(pc, []); + {'CALL_TR', A, _} -> Impure(pc, A); + {'JUMP', _} -> Impure(pc, []); + {'JUMPIF', A, _} -> Impure(pc, A); + {'SWITCH_V2', A, _, _} -> Impure(pc, A); + {'SWITCH_V3', A, _, _, _} -> Impure(pc, A); + {'SWITCH_VN', A, _} -> Impure(pc, A); + {'PUSH', A} -> Pure(?a, A); + 'DUPA' -> Pure(?a, []); + {'DUP', A} -> Pure(?a, A); + {'POP', A} -> Pure(A, ?a); + {'STORE', A, B} -> Pure(A, B); + 'INCA' -> Pure(?a, ?a); + {'INC', A} -> Pure(A, A); + 'DECA' -> Pure(?a, []); + {'DEC', A} -> Pure(A, A); + {'ADD', A, B, C} -> Pure(A, [B, C]); + {'SUB', A, B, C} -> Pure(A, [B, C]); + {'MUL', A, B, C} -> Pure(A, [B, C]); + {'DIV', A, B, C} -> Pure(A, [B, C]); + {'MOD', A, B, C} -> Pure(A, [B, C]); + {'POW', A, B, C} -> Pure(A, [B, C]); + {'LT', A, B, C} -> Pure(A, [B, C]); + {'GT', A, B, C} -> Pure(A, [B, C]); + {'EQ', A, B, C} -> Pure(A, [B, C]); + {'ELT', A, B, C} -> Pure(A, [B, C]); + {'EGT', A, B, C} -> Pure(A, [B, C]); + {'NEQ', A, B, C} -> Pure(A, [B, C]); + {'AND', A, B, C} -> Pure(A, [B, C]); + {'OR', A, B, C} -> Pure(A, [B, C]); + {'NOT', A, B} -> Pure(A, B); + {'TUPLE', _} -> Pure(?a, []); + {'ELEMENT', A, B, C} -> Pure(A, [B, C]); + {'MAP_EMPTY', A} -> Pure(A, []); + {'MAP_LOOKUP', A, B, C} -> Pure(A, [B, C]); + {'MAP_LOOKUPD', A, B, C, D} -> Pure(A, [B, C, D]); + {'MAP_UPDATE', A, B, C, D} -> Pure(A, [B, C, D]); + {'MAP_DELETE', A, B, C} -> Pure(A, [B, C]); + {'MAP_MEMBER', A, B, C} -> Pure(A, [B, C]); + {'MAP_FROM_LIST', A, B} -> Pure(A, B); + {'NIL', A} -> Pure(A, []); + {'IS_NIL', A, B} -> Pure(A, B); + {'CONS', A, B, C} -> Pure(A, [B, C]); + {'HD', A, B} -> Pure(A, B); + {'TL', A, B} -> Pure(A, B); + {'LENGTH', A, B} -> Pure(A, B); + {'STR_EQ', A, B, C} -> Pure(A, [B, C]); + {'STR_JOIN', A, B, C} -> Pure(A, [B, C]); + {'INT_TO_STR', A, B} -> Pure(A, B); + {'ADDR_TO_STR', A, B} -> Pure(A, B); + {'STR_REVERSE', A, B} -> Pure(A, B); + {'INT_TO_ADDR', A, B} -> Pure(A, B); + {'VARIANT', A, B, C, D} -> Pure(A, [B, C, D]); + {'VARIANT_TEST', A, B, C} -> Pure(A, [B, C]); + {'VARIANT_ELEMENT', A, B, C} -> Pure(A, [B, C]); + 'BITS_NONEA' -> Pure(?a, []); + {'BITS_NONE', A} -> Pure(A, []); + 'BITS_ALLA' -> Pure(?a, []); + {'BITS_ALL', A} -> Pure(A, []); + {'BITS_ALL_N', A, B} -> Pure(A, B); + {'BITS_SET', A, B, C} -> Pure(A, [B, C]); + {'BITS_CLEAR', A, B, C} -> Pure(A, [B, C]); + {'BITS_TEST', A, B, C} -> Pure(A, [B, C]); + {'BITS_SUM', A, B} -> Pure(A, B); + {'BITS_OR', A, B, C} -> Pure(A, [B, C]); + {'BITS_AND', A, B, C} -> Pure(A, [B, C]); + {'BITS_DIFF', A, B, C} -> Pure(A, [B, C]); + {'ADDRESS', A} -> Pure(A, []); + {'BALANCE', A} -> Pure(A, []); + {'ORIGIN', A} -> Pure(A, []); + {'CALLER', A} -> Pure(A, []); + {'GASPRICE', A} -> Pure(A, []); + {'BLOCKHASH', A} -> Pure(A, []); + {'BENEFICIARY', A} -> Pure(A, []); + {'TIMESTAMP', A} -> Pure(A, []); + {'GENERATION', A} -> Pure(A, []); + {'MICROBLOCK', A} -> Pure(A, []); + {'DIFFICULTY', A} -> Pure(A, []); + {'GASLIMIT', A} -> Pure(A, []); + {'GAS', A} -> Impure(?a, A); + {'LOG0', A, B} -> Impure(none, [A, B]); + {'LOG1', A, B, C} -> Impure(none, [A, B, C]); + {'LOG2', A, B, C, D} -> Impure(none, [A, B, C, D]); + {'LOG3', A, B, C, D, E} -> Impure(none, [A, B, C, D, E]); + {'LOG4', A, B, C, D, E, F} -> Impure(none, [A, B, C, D, E, F]); + 'DEACTIVATE' -> Impure(none, []); + {'SPEND', A, B} -> Impure(none, [A, B]); + {'ORACLE_REGISTER', A, B, C, D, E, F} -> Impure(A, [B, C, D, E, F]); + 'ORACLE_QUERY' -> Impure(?a, []); %% TODO + 'ORACLE_RESPOND' -> Impure(?a, []); %% TODO + 'ORACLE_EXTEND' -> Impure(?a, []); %% TODO + 'ORACLE_GET_ANSWER' -> Impure(?a, []); %% TODO + 'ORACLE_GET_QUESTION' -> Impure(?a, []); %% TODO + 'ORACLE_QUERY_FEE' -> Impure(?a, []); %% TODO + 'AENS_RESOLVE' -> Impure(?a, []); %% TODO + 'AENS_PRECLAIM' -> Impure(?a, []); %% TODO + 'AENS_CLAIM' -> Impure(?a, []); %% TODO + 'AENS_UPDATE' -> Impure(?a, []); %% TODO + 'AENS_TRANSFER' -> Impure(?a, []); %% TODO + 'AENS_REVOKE' -> Impure(?a, []); %% TODO + 'ECVERIFY' -> Pure(?a, []); %% TODO + 'SHA3' -> Pure(?a, []); %% TODO + 'SHA256' -> Pure(?a, []); %% TODO + 'BLAKE2B' -> Pure(?a, []); %% TODO + {'ABORT', A} -> Impure(pc, A); + {'EXIT', A} -> Impure(pc, A); + 'NOP' -> Pure(none, []) + end. + +var_writes(I) -> + #{ write := W } = attributes(I), + case W of + {var, _} -> [W]; + _ -> [] + end. + +independent({ifte, _, _}, _) -> false; +independent(_, {ifte, _, _}) -> false; +independent(I, J) -> + #{ write := WI, read := RI, pure := PureI } = attributes(I), + #{ write := WJ, read := RJ, pure := PureJ } = attributes(J), + + StackI = lists:member(?a, [WI | RI]), + StackJ = lists:member(?a, [WJ | RJ]), + + if WI == pc; WJ == pc -> false; %% no jumps + not (PureI or PureJ) -> false; %% at least one is pure + StackI and StackJ -> false; %% cannot both use the stack + true -> + %% and cannot write to each other's inputs + not lists:member(WI, RJ) andalso + not lists:member(WJ, RI) end. merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> @@ -404,27 +429,38 @@ simpl_s(I, _) -> I. simpl_top(I, Code, Options) -> apply_rules(rules(), I, Code, Options). -apply_rules([], I, Code, _) -> - [I | Code]; -apply_rules([{_RName, Rule} | Rules], I, Code, Options) -> +apply_rules(Rules, I, Code, Options) -> Cons = fun(X, Xs) -> simpl_top(X, Xs, Options) end, - case Rule(I, Code) of - false -> apply_rules(Rules, I, Code, Options); - {New, Rest} -> - debug(opt_rules, Options, "Applied ~p:\n~s ==>\n~s", [_RName, pp_ann(" ", [I | Code]), pp_ann(" ", New ++ Rest)]), + case apply_rules_once(Rules, I, Code) of + false -> [I | Code]; + {RName, New, Rest} -> + debug(opt_rules, Options, "Applied ~p:\n~s ==>\n~s", [RName, pp_ann(" ", [I | Code]), pp_ann(" ", New ++ Rest)]), lists:foldr(Cons, Rest, New) end. +apply_rules_once([], _, _) -> + false; +apply_rules_once([{RName, Rule} | Rules], I, Code) -> + case Rule(I, Code) of + false -> apply_rules_once(Rules, I, Code); + {New, Rest} -> {RName, New, Rest} + end. + -define(RULE(Name), {Name, fun Name/2}). -rules() -> +merge_rules() -> [?RULE(r_push_consume), - ?RULE(r_dup_to_push), - ?RULE(r_swap_instrs), ?RULE(r_one_shot_var), ?RULE(r_write_to_dead_var) ]. +rules() -> + merge_rules() ++ + [?RULE(r_dup_to_push), + ?RULE(r_swap_push), + ?RULE(r_swap_write) + ]. + %% Removing pushes that are immediately consumed. r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; @@ -442,27 +478,45 @@ r_push_consume({Ann1, {Op, ?a, A, B}}, [{Ann2, {'STORE', R, ?a}} | Code]) when ? r_push_consume(_, _) -> false. %% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations -r_dup_to_push(I = {Ann, {'PUSH', A}}, [{_, 'DUPA'} | Code]) -> - #{ live_in := Live } = Ann, - Ann1 = #{ live_in => Live, live_out => Live }, - {[{Ann1, {'PUSH', A}}, I], Code}; +r_dup_to_push({Ann1, Push={'PUSH', _}}, [{Ann2, 'DUPA'} | Code]) -> + #{ live_in := LiveIn } = Ann1, + Ann1_ = Ann1#{ live_out => LiveIn }, + Ann2_ = Ann2#{ live_in => LiveIn }, + {[{Ann1_, Push}, {Ann2_, Push}], Code}; r_dup_to_push(_, _) -> false. -%% Move PUSH A past an operator. Make sure the next instruction isn't writing -%% to A, pushing to the stack or reading the accumulator. -r_swap_instrs({Ann1, {'PUSH', A}}, [{Ann2, I = {Op, R, B, C}} | Code]) when ?IsBinOp(Op), A /= R, A /= ?a, B /= ?a, C /= ?a -> - {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), - {[{Ann1_, I}, {Ann2_, {'PUSH', A}}], Code}; +%% Move PUSH A past non-stack instructions. +r_swap_push({Ann1, Push = {'PUSH', _}}, [{Ann2, I} | Code]) -> + case independent(Push, I) of + true -> + {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), + {[{Ann1_, I}, {Ann2_, Push}], Code}; + false -> false + end; +r_swap_push(_, _) -> false. -%% Move writes to a variable as late as possible -r_swap_instrs({Ann1, I1 = {Op1, R = {var, _}, A, B}}, [{Ann2, I2 = {Op2, S, C, D}} | Code]) - when ?IsBinOp(Op1), ?IsBinOp(Op2), - element(1, S) /= var orelse S < R, - S /= A, S /= B, C /= R, D /= R, - A /= ?a andalso B /= ?a orelse S /= ?a andalso C /= ?a andalso D /= ?a -> - {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), - {[{Ann1_, I2}, {Ann2_, I1}], Code}; -r_swap_instrs(_, _) -> false. +%% Match up writes to variables with instructions further down. +r_swap_write({AnnI, I}, [{AnnJ, J} | Code]) -> + case {var_writes(I), independent(I, J)} of + {[_], true} -> + {AnnJ_, AnnI_} = swap_ann(AnnI, AnnJ), + r_swap_write([{AnnJ_, J}], {AnnI_, I}, Code); + _ -> false + end; +r_swap_write(_, _) -> false. + +r_swap_write(Pre, {AnnI, I}, Code0 = [{AnnJ, J} | Code]) -> + case apply_rules_once(merge_rules(), {AnnI, I}, Code0) of + {_, New, Rest} -> {lists:reverse(Pre) ++ New, Rest}; + false -> + case independent(I, J) of + false -> false; + true -> + {AnnJ_, AnnI_} = swap_ann(AnnI, AnnJ), + r_swap_write([{AnnJ_, J} | Pre], {AnnI_, I}, Code) + end + end; +r_swap_write(_, _, []) -> false. %% Shortcut write followed by final read r_one_shot_var({Ann1, {Op, R = {var, _}, A, B}}, [{Ann2, J} | Code]) when ?IsBinOp(Op) -> -- 2.30.2 From 41387ce0b165067a311bc71fb486e2ae4e071456 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 18:26:44 +0200 Subject: [PATCH 14/87] Compile nested pattern matching to case trees (Only tuple and variable patterns so far) --- src/aeso_ast_to_fcode.erl | 108 ++++++++++++++++++++++++++++++++----- src/aeso_fcode_to_fate.erl | 48 +++++++++-------- 2 files changed, 121 insertions(+), 35 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index b8eb91e..7bb2548 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -31,13 +31,22 @@ | {var, var_name()} | {binop, ftype(), binop(), fexpr(), fexpr()} | {'if', fexpr(), fexpr(), fexpr()} - | {switch, fexpr(), [falt()]}. + | {'let', var_name(), fexpr(), fexpr()} + | {switch, fcase()}. +-type fcase() :: {split, ftype(), var_name(), [fsplit_case()], fdefault()} + | {nosplit, [var_name()], fexpr()}. + +-type fsplit_case() :: {'case', fsplit_pat(), fcase()}. +-type fsplit_pat() :: {tuple, [var_name()]}. + +-type fdefault() :: nodefault | {default, fcase()}. + +%% Intermediate format before case trees (fcase() and fsplit()). +-type falt() :: {'case', [fpat()], fexpr()}. -type fpat() :: {var, var_name()} | {tuple, [fpat()]}. --type falt() :: {'case', fpat(), fexpr()}. - -type ftype() :: aeb_fate_data:fate_type_type(). @@ -126,8 +135,12 @@ decls_to_fcode(Env, Decls) -> %% First compute mapping from Sophia names to fun_names and add it to the %% environment. Env1 = add_fun_env(Env, Decls), - lists:foldl(fun(D, E) -> decl_to_fcode(E, D) end, - Env1, Decls). + lists:foldl(fun(D, E) -> + init_fresh_names(), + R = decl_to_fcode(E, D), + clear_fresh_names(), + R + end, Env1, Decls). -spec decl_to_fcode(env(), aeso_syntax:decl()) -> env(). decl_to_fcode(Env, {type_decl, _, _, _}) -> Env; @@ -187,9 +200,10 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> expr_to_fcode(Env, Else)}; %% Switch -expr_to_fcode(Env, _Type, {switch, _, Expr, Alts}) -> - {switch, expr_to_fcode(Env, Expr), - [ alt_to_fcode(Env, Alt) || Alt <- Alts ]}; +expr_to_fcode(Env, _, {switch, _, Expr = {typed, _, _, Type}, Alts}) -> + X = fresh_name(), + {'let', X, expr_to_fcode(Env, Expr), + {switch, alts_to_fcode(Env, type_to_fcode(Env, Type), X, Alts)}}; %% Blocks expr_to_fcode(Env, _Type, {block, _, Stmts}) -> @@ -205,9 +219,68 @@ expr_to_fcode(_Env, Type, Expr) -> binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. +-spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fcase(). +alts_to_fcode(Env, Type, X, Alts) -> + split_tree(Env, [{X, Type}], [alt_to_fcode(Env, Alt) || Alt <- Alts]). + +%% Invariant: the number of variables matches the number of patterns in each falt. +-spec split_tree(env(), [{var_name(), ftype()}], [falt()]) -> fcase(). +split_tree(_Env, [], [{'case', [], Expr}]) -> + {nosplit, Expr}; +split_tree(Env, Vars, Alts) -> + case next_split(Alts) of + {nosplit, Xs, Expr} -> {nosplit, Xs, Expr}; + {split, I, Splits} -> + {Vars1, [{X, T} | Vars2]} = lists:split(I, Vars), + Cases = [{'case', Pat, split_tree(Env, Vars1 ++ split_vars(Pat, T) ++ Vars2, As)} + || {Pat, As} <- Splits], + {split, T, X, Cases, nodefault} + end. + +-spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}]. +split_vars({tuple, Xs}, {tuple, Ts}) -> + lists:zip(Xs, Ts). + +%% TODO: catchalls +-spec next_split([falt()]) -> {nosplit, [var_name()], fexpr()} | {split, integer(), [{fsplit_pat(), [falt()]}]}. +next_split([]) -> + {nosplit, {abort, <<"Non-exhaustive pattern">>}}; +next_split(Alts = [{'case', Pats, Body} | _]) -> + NotMatch = fun({var, _}) -> true; (_) -> false end, + case lists:splitwith(NotMatch, Pats) of + {Vars, []} -> {nosplit, [X || {var, X} <- Vars], Body}; + {Vars, _} -> + I = length(Vars), + Splits = group_by_split_pat([ split_alt(I, Alt) || Alt <- Alts ]), + {split, I, Splits} + end. + +-spec split_alt(integer(), falt()) -> {fsplit_pat() | default, falt()}. +split_alt(I, {'case', Pats, Body}) -> + {Pats1, [Pat | Pats2]} = lists:split(I, Pats), + {FPat, InnerPats} = split_pat(Pat), + {FPat, {'case', Pats1 ++ InnerPats ++ Pats2, Body}}. + +-spec split_pat(fpat()) -> {fsplit_pat() | default, [fpat()]}. +split_pat({var, X}) -> {default, [{var, X}]}; +split_pat({tuple, Pats}) -> + Var = fun({var, X}) -> X; (_) -> fresh_name() end, + Xs = [Var(P) || P <- Pats], + {{tuple, Xs}, Pats}. + +-spec group_by_split_pat([{fsplit_pat() | default, falt()}]) -> [{fsplit_pat(), [falt()]}]. +group_by_split_pat(Alts) -> + Tag = fun(default) -> default; + ({tuple, _}) -> tuple end, + Grouped = maps:values(lists:foldr( + fun({Pat, _} = Alt, Map) -> + maps:update_with(Tag(Pat), fun(As) -> [Alt | As] end, [Alt], Map) + end, #{}, Alts)), + [ {Pat, [As || {_, As} <- G]} || G = [{Pat, _} | _] <- Grouped ]. + -spec alt_to_fcode(env(), aeso_syntax:alt()) -> falt(). alt_to_fcode(Env, {'case', _, Pat, Expr}) -> - {'case', pat_to_fcode(Env, Pat), expr_to_fcode(Env, Expr)}. + {'case', [pat_to_fcode(Env, Pat)], expr_to_fcode(Env, Expr)}. -spec pat_to_fcode(env(), aeso_syntax:pattern()) -> fpat(). pat_to_fcode(Env, {typed, _, Pat, Type}) -> @@ -222,9 +295,8 @@ pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). -stmts_to_fcode(Env, [{letval, _, Pat, _, Expr} | Stmts]) -> - {switch, expr_to_fcode(Env, Expr), - [{'case', pat_to_fcode(Env, Pat), stmts_to_fcode(Env, Stmts)}]}; +stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> + {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(Env, Stmts)}; stmts_to_fcode(Env, [Expr]) -> expr_to_fcode(Env, Expr). @@ -302,6 +374,18 @@ lookup_fun(#{ fun_env := FunEnv }, Name) -> FName -> FName end. +init_fresh_names() -> + put('%fresh', 0). + +clear_fresh_names() -> + erase('%fresh'). + +-spec fresh_name() -> var_name(). +fresh_name() -> + N = get('%fresh'), + put('%fresh', N + 1), + lists:concat(["%", N]). + %% -- Attributes -- get_attributes(Ann) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index c007d19..efc93da 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -94,15 +94,16 @@ push_env(Type, Env) -> Env#env{ stack = [Type | Env#env.stack] }. bind_local(Name, Env = #env{ locals = Locals }) -> - {length(Locals), Env#env{ locals = Locals ++ [Name] }}. + I = length(Locals), + {I, Env#env{ locals = [{Name, I} | Locals] }}. notail(Env) -> Env#env{ tailpos = false }. lookup_var(Env = #env{ args = Args, locals = Locals }, X) -> - case {find_index(X, Locals), keyfind_index(X, 1, Args)} of - {false, false} -> error({unbound_variable, X, Env}); - {false, Arg} -> {arg, Arg}; - {Local, _} -> {var, Local} + case {lists:keyfind(X, 1, Locals), keyfind_index(X, 1, Args)} of + {false, false} -> error({unbound_variable, X, Env}); + {false, Arg} -> {arg, Arg}; + {{_, Local}, _} -> {var, Local} end. %% -- The compiler -- @@ -127,27 +128,26 @@ to_scode(Env, {'if', Dec, Then, Else}) -> [ to_scode(notail(Env), Dec), {ifte, to_scode(Env, Then), to_scode(Env, Else)} ]; -to_scode(Env, {switch, Expr, Alts}) -> - [ to_scode(notail(Env), Expr), - alts_to_scode(Env, Alts) ]; +to_scode(Env, {'let', X, Expr, Body}) -> + {I, Env1} = bind_local(X, Env), + [ to_scode(Env, Expr), + aeb_fate_code:store({var, I}, {stack, 0}), + to_scode(Env1, Body) ]; + +to_scode(Env, {switch, Case}) -> + case_to_scode(Env, Case); to_scode(_Env, Icode) -> ?TODO(Icode). -alts_to_scode(Env, [{'case', {var, X}, Body}]) -> - {I, Env1} = bind_local(X, Env), - [ aeb_fate_code:store({var, I}, {stack, 0}), - to_scode(Env1, Body) ]; -alts_to_scode(Env, Alts = [{'case', {tuple, Pats}, Body}]) -> - Xs = lists:flatmap(fun({var, X}) -> [X]; (_) -> [] end, Pats), - N = length(Pats), - case length(Xs) == N of - false -> ?TODO(Alts); - true -> - {Code, Env1} = match_tuple(Env, Xs), - [Code, to_scode(Env1, Body)] - end; -alts_to_scode(_Env, Alts) -> - ?TODO(Alts). +case_to_scode(Env, {nosplit, _Xs, Expr}) -> + %% TODO: need to worry about variable names? + to_scode(Env, Expr); +case_to_scode(Env, {split, _Type, X, [{'case', {tuple, Xs}, Case}], nodefault}) -> + {Code, Env1} = match_tuple(Env, Xs), + [aeb_fate_code:push(lookup_var(Env, X)), + Code, case_to_scode(Env1, Case)]; +case_to_scode(_, Split = {split, _, _, _, _}) -> + ?TODO({'case', Split}). %% Tuple is in the accumulator. Arguments are the variable names. match_tuple(Env, Xs) -> @@ -466,6 +466,8 @@ r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {Op, R, ?a, B}} | Code]) when ?IsBin {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; r_push_consume({Ann1, {'PUSH', B}}, [{Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; +r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {'STORE', R, ?a}} | Code]) -> + {[{merge_ann(Ann1, Ann2), {'STORE', R, A}}], Code}; r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {'POP', B}} | Code]) -> case live_out(B, Ann2) of true -> {[{merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; -- 2.30.2 From 4b6191aa2545cfb94a925b7f097c70658827ea7c Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 2 Apr 2019 21:39:17 +0200 Subject: [PATCH 15/87] Reannotate and repeat optimization pass once it done Could try hard to keep annotations more precise, but would be more error prone --- src/aeso_fcode_to_fate.erl | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index efc93da..5691eb5 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -190,13 +190,21 @@ flatten_s(I) -> I. optimize_fun(_Funs, Name, {{Args, Res}, Code}, Options) -> Code0 = flatten(Code), debug(opt, Options, "Optimizing ~s\n", [Name]), - ACode = annotate_code(Code0), - debug(opt, Options, " original:\n~s\n", [pp_ann(" ", ACode)]), - Code1 = simplify(ACode, Options), - debug(opt, Options, " optimized:\n~s\n", [pp_ann(" ", Code1)]), + Code1 = simpl_loop(Code0, Options), Code2 = desugar(Code1), {{Args, Res}, Code2}. +simpl_loop(Code, Options) -> + ACode = annotate_code(Code), + debug(opt, Options, " annotated:\n~s\n", [pp_ann(" ", ACode)]), + Code1 = simplify(ACode, Options), + [ debug(opt, Options, " optimized:\n~s\n", [pp_ann(" ", Code1)]) || Code1 /= ACode ], + Code2 = unannotate(Code1), + case Code == Code2 of + true -> Code2; + false -> simpl_loop(Code2, Options) + end. + pp_ann(Ind, [{ifte, Then, Else} | Code]) -> [Ind, "IF-THEN\n", pp_ann(" " ++ Ind, Then), @@ -548,12 +556,18 @@ r_write_to_dead_var(_, _) -> false. %% Desugar and specialize and remove annotations -desugar({_Ann, {'ADD', ?a, ?i(1), ?a}}) -> [aeb_fate_code:inc()]; -desugar({_Ann, {'SUB', ?a, ?a, ?i(1)}}) -> [aeb_fate_code:dec()]; +unannotate({ifte, Then, Else}) -> [{ifte, unannotate(Then), unannotate(Else)}]; +unannotate(Code) when is_list(Code) -> + lists:flatmap(fun unannotate/1, Code); +unannotate({_Ann, I}) -> [I]. + +%% Desugar and specialize and remove annotations +desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_code:inc()]; +desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_code:dec()]; desugar({ifte, Then, Else}) -> [{ifte, desugar(Then), desugar(Else)}]; desugar(Code) when is_list(Code) -> lists:flatmap(fun desugar/1, Code); -desugar({_Ann, I}) -> [I]. +desugar(I) -> [I]. %% -- Phase III -------------------------------------------------------------- %% Constructing basic blocks -- 2.30.2 From d05130a569443f473455f14cc2aa4ec067e21442 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 5 Apr 2019 10:50:47 +0200 Subject: [PATCH 16/87] Get rid of unnecessary STORE instructions --- src/aeso_fcode_to_fate.erl | 37 ++++++++++++++++++++++++++++++++++++- 1 file changed, 36 insertions(+), 1 deletion(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 5691eb5..74450b2 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -466,7 +466,8 @@ rules() -> merge_rules() ++ [?RULE(r_dup_to_push), ?RULE(r_swap_push), - ?RULE(r_swap_write) + ?RULE(r_swap_write), + ?RULE(r_inline) ]. %% Removing pushes that are immediately consumed. @@ -528,6 +529,30 @@ r_swap_write(Pre, {AnnI, I}, Code0 = [{AnnJ, J} | Code]) -> end; r_swap_write(_, _, []) -> false. +%% Inline stores +r_inline(I = {_, {'STORE', R = {var, _}, A = {arg, _}}}, Code) -> + %% Not when A is var unless updating the annotations properly. + r_inline([I], R, A, Code); +r_inline(_, _) -> false. + +r_inline(Acc, R, A, [{Ann, I} | Code]) -> + #{ write := W, pure := Pure } = attributes(I), + Inl = fun(X) when X == R -> A; (X) -> X end, + case not live_in(R, Ann) orelse not Pure orelse lists:member(W, [R, A]) of + true -> false; + false -> + case I of + {Op, S, B, C} when ?IsBinOp(Op), B == R orelse C == R -> + Acc1 = [{Ann, {Op, S, Inl(B), Inl(C)}} | Acc], + case r_inline(Acc1, R, A, Code) of + false -> {lists:reverse(Acc1), Code}; + {New, Rest} -> {New, Rest} + end; + _ -> r_inline([{Ann, I} | Acc], R, A, Code) + end + end; +r_inline(_Acc, _, _, []) -> false. + %% Shortcut write followed by final read r_one_shot_var({Ann1, {Op, R = {var, _}, A, B}}, [{Ann2, J} | Code]) when ?IsBinOp(Op) -> Copy = case J of @@ -552,6 +577,16 @@ r_write_to_dead_var({Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> {[{Ann, {'POP', R}} || X <- [A, B], X == ?a], Code}; true -> false end; +r_write_to_dead_var({Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a -> + case live_out(R, Ann) of + false -> + case Code of + [] -> {[], []}; + [{Ann1, I} | Code1] -> + {[], [{merge_ann(Ann, Ann1), I} | Code1]} + end; + true -> false + end; r_write_to_dead_var(_, _) -> false. -- 2.30.2 From 4814cfbf96ed8a40566edf859c86c455f39bcd4b Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 5 Apr 2019 10:51:32 +0200 Subject: [PATCH 17/87] Keep better track of liveness annotations when swapping instructions --- src/aeso_fcode_to_fate.erl | 43 ++++++++++++++++++++++---------------- 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 74450b2..63adc2a 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -415,13 +415,19 @@ independent(I, J) -> merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> #{ live_in => LiveIn, live_out => LiveOut }. -%% When swapping two instructions -swap_ann(#{ live_in := Live1, live_out := Live2 }, #{ live_in := Live2, live_out := Live3 }) -> - Live2_ = ordsets:union([Live1, Live2, Live3]), %% Conservative approximation - {#{ live_in => Live1, live_out => Live2_ }, - #{ live_in => Live2_, live_out => Live3 }}. +%% Swap two instructions. Precondition: the instructions are independent/2. +swap_instrs({#{ live_in := Live1, live_out := Live2 }, I}, {#{ live_in := Live2, live_out := Live3 }, J}) -> + %% Since I and J are independent the J can't read or write anything in + %% that I writes. + WritesI = ordsets:subtract(Live2, Live1), + %% Any final reads by J, that I does not read should be removed from Live2. + #{ read := ReadsI } = attributes(I), + ReadsJ = ordsets:subtract(Live2, ordsets:union(Live3, ReadsI)), + Live2_ = ordsets:subtract(ordsets:union([Live1, Live2, Live3]), ordsets:union(WritesI, ReadsJ)), + {{#{ live_in => Live1, live_out => Live2_ }, J}, + {#{ live_in => Live2_, live_out => Live3 }, I}}. -%% live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn). +live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn). live_out(R, #{ live_out := LiveOut }) -> ordsets:is_element(R, LiveOut). %% -- Optimizations -- @@ -442,7 +448,7 @@ apply_rules(Rules, I, Code, Options) -> case apply_rules_once(Rules, I, Code) of false -> [I | Code]; {RName, New, Rest} -> - debug(opt_rules, Options, "Applied ~p:\n~s ==>\n~s", [RName, pp_ann(" ", [I | Code]), pp_ann(" ", New ++ Rest)]), + debug(opt_rules, Options, " Applied ~p:\n~s ==>\n~s\n", [RName, pp_ann(" ", [I | Code]), pp_ann(" ", New ++ Rest)]), lists:foldr(Cons, Rest, New) end. @@ -497,34 +503,35 @@ r_dup_to_push({Ann1, Push={'PUSH', _}}, [{Ann2, 'DUPA'} | Code]) -> r_dup_to_push(_, _) -> false. %% Move PUSH A past non-stack instructions. -r_swap_push({Ann1, Push = {'PUSH', _}}, [{Ann2, I} | Code]) -> +r_swap_push(PushA = {_, Push = {'PUSH', _}}, [IA = {_, I} | Code]) -> case independent(Push, I) of true -> - {Ann1_, Ann2_} = swap_ann(Ann1, Ann2), - {[{Ann1_, I}, {Ann2_, Push}], Code}; + {I1, Push1} = swap_instrs(PushA, IA), + {[I1, Push1], Code}; false -> false end; r_swap_push(_, _) -> false. %% Match up writes to variables with instructions further down. -r_swap_write({AnnI, I}, [{AnnJ, J} | Code]) -> +r_swap_write(IA = {_, I}, [JA = {_, J} | Code]) -> case {var_writes(I), independent(I, J)} of {[_], true} -> - {AnnJ_, AnnI_} = swap_ann(AnnI, AnnJ), - r_swap_write([{AnnJ_, J}], {AnnI_, I}, Code); + {J1, I1} = swap_instrs(IA, JA), + r_swap_write([J1], I1, Code); _ -> false end; r_swap_write(_, _) -> false. -r_swap_write(Pre, {AnnI, I}, Code0 = [{AnnJ, J} | Code]) -> - case apply_rules_once(merge_rules(), {AnnI, I}, Code0) of - {_, New, Rest} -> {lists:reverse(Pre) ++ New, Rest}; +r_swap_write(Pre, IA = {_, I}, Code0 = [JA = {_, J} | Code]) -> + case apply_rules_once(merge_rules(), IA, Code0) of + {_Rule, New, Rest} -> + {lists:reverse(Pre) ++ New, Rest}; false -> case independent(I, J) of false -> false; true -> - {AnnJ_, AnnI_} = swap_ann(AnnI, AnnJ), - r_swap_write([{AnnJ_, J} | Pre], {AnnI_, I}, Code) + {J1, I1} = swap_instrs(IA, JA), + r_swap_write([J1 | Pre], I1, Code) end end; r_swap_write(_, _, []) -> false. -- 2.30.2 From 59845dec545bed4a5680610b28fed8cb95b562cb Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 5 Apr 2019 10:53:21 +0200 Subject: [PATCH 18/87] Limit the number of iterations for the optimization loop Should finish in one iteration, but we shouldn't loop if there are bugs or corner cases where it doesn't. --- src/aeso_fcode_to_fate.erl | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 63adc2a..f0c1487 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -187,22 +187,30 @@ flatten(Code) -> lists:map(fun flatten_s/1, lists:flatten(Code)). flatten_s({ifte, Then, Else}) -> {ifte, flatten(Then), flatten(Else)}; flatten_s(I) -> I. +-define(MAX_SIMPL_ITERATIONS, 10). + optimize_fun(_Funs, Name, {{Args, Res}, Code}, Options) -> Code0 = flatten(Code), debug(opt, Options, "Optimizing ~s\n", [Name]), - Code1 = simpl_loop(Code0, Options), + Code1 = simpl_loop(0, Code0, Options), Code2 = desugar(Code1), {{Args, Res}, Code2}. -simpl_loop(Code, Options) -> +simpl_loop(N, Code, Options) when N >= ?MAX_SIMPL_ITERATIONS -> + debug(opt, Options, " No simpl_loop fixed_point after ~p iterations.\n\n", [N]), + Code; +simpl_loop(N, Code, Options) -> ACode = annotate_code(Code), - debug(opt, Options, " annotated:\n~s\n", [pp_ann(" ", ACode)]), + [ debug(opt, Options, " annotated:\n~s\n", [pp_ann(" ", ACode)]) || N == 0 ], Code1 = simplify(ACode, Options), [ debug(opt, Options, " optimized:\n~s\n", [pp_ann(" ", Code1)]) || Code1 /= ACode ], Code2 = unannotate(Code1), case Code == Code2 of - true -> Code2; - false -> simpl_loop(Code2, Options) + true -> + debug(opt, Options, " Reached simpl_loop fixed point after ~p iteration~s.\n\n", + [N, if N /= 1 -> "s"; true -> "" end]), + Code2; + false -> simpl_loop(N + 1, Code2, Options) end. pp_ann(Ind, [{ifte, Then, Else} | Code]) -> -- 2.30.2 From ab13222d295b0e2e176b83d5c3a1eaf9bc90b8e3 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 5 Apr 2019 11:49:13 +0200 Subject: [PATCH 19/87] Pattern matching on booleans --- src/aeso_ast_to_fcode.erl | 13 ++++++-- src/aeso_fcode_to_fate.erl | 61 ++++++++++++++++++++++++++++---------- 2 files changed, 57 insertions(+), 17 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 7bb2548..4897912 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -38,13 +38,15 @@ | {nosplit, [var_name()], fexpr()}. -type fsplit_case() :: {'case', fsplit_pat(), fcase()}. --type fsplit_pat() :: {tuple, [var_name()]}. +-type fsplit_pat() :: {bool, false | true} + | {tuple, [var_name()]}. -type fdefault() :: nodefault | {default, fcase()}. %% Intermediate format before case trees (fcase() and fsplit()). -type falt() :: {'case', [fpat()], fexpr()}. -type fpat() :: {var, var_name()} + | {bool, false | true} | {tuple, [fpat()]}. -type ftype() :: aeb_fate_data:fate_type_type(). @@ -238,6 +240,7 @@ split_tree(Env, Vars, Alts) -> end. -spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}]. +split_vars({bool, _}, boolean) -> []; split_vars({tuple, Xs}, {tuple, Ts}) -> lists:zip(Xs, Ts). @@ -263,6 +266,7 @@ split_alt(I, {'case', Pats, Body}) -> -spec split_pat(fpat()) -> {fsplit_pat() | default, [fpat()]}. split_pat({var, X}) -> {default, [{var, X}]}; +split_pat({bool, B}) -> {{bool, B}, []}; split_pat({tuple, Pats}) -> Var = fun({var, X}) -> X; (_) -> fresh_name() end, Xs = [Var(P) || P <- Pats], @@ -271,7 +275,9 @@ split_pat({tuple, Pats}) -> -spec group_by_split_pat([{fsplit_pat() | default, falt()}]) -> [{fsplit_pat(), [falt()]}]. group_by_split_pat(Alts) -> Tag = fun(default) -> default; - ({tuple, _}) -> tuple end, + ({tuple, _}) -> tuple; + ({bool, B}) -> B + end, Grouped = maps:values(lists:foldr( fun({Pat, _} = Alt, Map) -> maps:update_with(Tag(Pat), fun(As) -> [Alt | As] end, [Alt], Map) @@ -292,6 +298,8 @@ pat_to_fcode(Env, Pat) -> pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; +pat_to_fcode(_Env, _Type, {bool, _, B}) -> + {bool, B}; pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). @@ -307,6 +315,7 @@ stmts_to_fcode(Env, [Expr]) -> %% - Deadcode elimination %% - Unused variable analysis (replace by _) %% - Simplified case trees (FATE has special instructions for shallow matching) +%% - Case specialization %% - Constant propagation %% -- Helper functions ------------------------------------------------------- diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index f0c1487..8ab8b9c 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -111,6 +111,9 @@ lookup_var(Env = #env{ args = Args, locals = Locals }, X) -> to_scode(_Env, {integer, N}) -> [aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring +to_scode(_Env, {bool, B}) -> + [aeb_fate_code:push(?i(B))]; + to_scode(Env, {var, X}) -> [aeb_fate_code:push(lookup_var(Env, X))]; @@ -146,6 +149,16 @@ case_to_scode(Env, {split, _Type, X, [{'case', {tuple, Xs}, Case}], nodefault}) {Code, Env1} = match_tuple(Env, Xs), [aeb_fate_code:push(lookup_var(Env, X)), Code, case_to_scode(Env1, Case)]; +case_to_scode(Env, Split = {split, boolean, X, Cases, nodefault}) -> + Then = lists:keyfind({bool, true}, 2, Cases), + Else = lists:keyfind({bool, false}, 2, Cases), + case {Then, Else} of + {{'case', _, ThenSplit}, {'case', _, ElseSplit}} -> + [aeb_fate_code:push(lookup_var(Env, X)), + {ifte, case_to_scode(Env, ThenSplit), + case_to_scode(Env, ElseSplit)}]; + _ -> ?TODO({'case', Split}) + end; case_to_scode(_, Split = {split, _, _, _, _}) -> ?TODO({'case', Split}). @@ -473,7 +486,8 @@ apply_rules_once([{RName, Rule} | Rules], I, Code) -> merge_rules() -> [?RULE(r_push_consume), ?RULE(r_one_shot_var), - ?RULE(r_write_to_dead_var) + ?RULE(r_write_to_dead_var), + ?RULE(r_write_single_branch) ]. rules() -> @@ -481,7 +495,7 @@ rules() -> [?RULE(r_dup_to_push), ?RULE(r_swap_push), ?RULE(r_swap_write), - ?RULE(r_inline) + ?RULE(r_inline_store) ]. %% Removing pushes that are immediately consumed. @@ -530,27 +544,28 @@ r_swap_write(IA = {_, I}, [JA = {_, J} | Code]) -> end; r_swap_write(_, _) -> false. -r_swap_write(Pre, IA = {_, I}, Code0 = [JA = {_, J} | Code]) -> - case apply_rules_once(merge_rules(), IA, Code0) of - {_Rule, New, Rest} -> +r_swap_write(Pre, IA = {_, I}, Code0 = [JA | Code]) -> + case {apply_rules_once(merge_rules(), IA, Code0), JA} of + {{_Rule, New, Rest}, _} -> {lists:reverse(Pre) ++ New, Rest}; - false -> + {false, {_, J}} -> case independent(I, J) of false -> false; true -> {J1, I1} = swap_instrs(IA, JA), r_swap_write([J1 | Pre], I1, Code) - end + end; + _ -> false end; -r_swap_write(_, _, []) -> false. +r_swap_write(_, _, _) -> false. %% Inline stores -r_inline(I = {_, {'STORE', R = {var, _}, A = {arg, _}}}, Code) -> +r_inline_store(I = {_, {'STORE', R = {var, _}, A = {arg, _}}}, Code) -> %% Not when A is var unless updating the annotations properly. - r_inline([I], R, A, Code); -r_inline(_, _) -> false. + r_inline_store([I], R, A, Code); +r_inline_store(_, _) -> false. -r_inline(Acc, R, A, [{Ann, I} | Code]) -> +r_inline_store(Acc, R, A, [{Ann, I} | Code]) -> #{ write := W, pure := Pure } = attributes(I), Inl = fun(X) when X == R -> A; (X) -> X end, case not live_in(R, Ann) orelse not Pure orelse lists:member(W, [R, A]) of @@ -559,14 +574,14 @@ r_inline(Acc, R, A, [{Ann, I} | Code]) -> case I of {Op, S, B, C} when ?IsBinOp(Op), B == R orelse C == R -> Acc1 = [{Ann, {Op, S, Inl(B), Inl(C)}} | Acc], - case r_inline(Acc1, R, A, Code) of + case r_inline_store(Acc1, R, A, Code) of false -> {lists:reverse(Acc1), Code}; {New, Rest} -> {New, Rest} end; - _ -> r_inline([{Ann, I} | Acc], R, A, Code) + _ -> r_inline_store([{Ann, I} | Acc], R, A, Code) end end; -r_inline(_Acc, _, _, []) -> false. +r_inline_store(_Acc, _, _, _) -> false. %% Shortcut write followed by final read r_one_shot_var({Ann1, {Op, R = {var, _}, A, B}}, [{Ann2, J} | Code]) when ?IsBinOp(Op) -> @@ -604,6 +619,22 @@ r_write_to_dead_var({Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a -> end; r_write_to_dead_var(_, _) -> false. +%% Push variable writes that are only needed in a single branch inside the branch. +r_write_single_branch(IA = {_Ann, I}, [{ifte, Then = [{AnnThen, _} | _], Else = [{AnnElse, _} | _]} | Code]) -> + #{ write := R } = attributes(I), + case R of + {var, _} -> + case {live_in(R, AnnThen), live_in(R, AnnElse)} of + {true, false} -> + {[], [{ifte, [IA | Then], Else} | Code]}; + {false, true} -> + {[], [{ifte, Then, [IA | Else]} | Code]}; + _ -> false + end; + _ -> false + end; +r_write_single_branch(_, _) -> false. + %% Desugar and specialize and remove annotations unannotate({ifte, Then, Else}) -> [{ifte, unannotate(Then), unannotate(Else)}]; -- 2.30.2 From e2c48e1069d2d7e0e1eec361ab3dfae4681f76bd Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 5 Apr 2019 17:43:28 +0200 Subject: [PATCH 20/87] wip: rewrite case tree compiler to handle catch-alls still with debug printing, and can't compile it yet --- src/aeso_ast_to_fcode.erl | 211 +++++++++++++++++++++++++++----------- 1 file changed, 150 insertions(+), 61 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 4897912..204b96b 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -29,19 +29,20 @@ -type fexpr() :: {integer, integer()} | {bool, false | true} | {var, var_name()} + | {tuple, [fexpr()]} | {binop, ftype(), binop(), fexpr(), fexpr()} | {'if', fexpr(), fexpr(), fexpr()} | {'let', var_name(), fexpr(), fexpr()} - | {switch, fcase()}. + | {switch, fsplit()}. --type fcase() :: {split, ftype(), var_name(), [fsplit_case()], fdefault()} - | {nosplit, [var_name()], fexpr()}. +-type fsplit() :: {split, ftype(), var_name(), [fcase()]} + | {nosplit, fexpr()}. + +-type fcase() :: {'case', fsplit_pat(), fsplit()}. --type fsplit_case() :: {'case', fsplit_pat(), fcase()}. -type fsplit_pat() :: {bool, false | true} - | {tuple, [var_name()]}. - --type fdefault() :: nodefault | {default, fcase()}. + | {tuple, [var_name()]} + | {var, var_name()}. %% Intermediate format before case trees (fcase() and fsplit()). -type falt() :: {'case', [fpat()], fexpr()}. @@ -202,10 +203,17 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> expr_to_fcode(Env, Else)}; %% Switch -expr_to_fcode(Env, _, {switch, _, Expr = {typed, _, _, Type}, Alts}) -> - X = fresh_name(), - {'let', X, expr_to_fcode(Env, Expr), - {switch, alts_to_fcode(Env, type_to_fcode(Env, Type), X, Alts)}}; +expr_to_fcode(Env, _, {switch, _, Expr = {typed, _, E, Type}, Alts}) -> + Switch = fun(X) -> + {switch, alts_to_fcode(Env, type_to_fcode(Env, Type), X, Alts)} + end, + case E of + {id, _, X} -> Switch(X); + _ -> + X = fresh_name(), + {'let', X, expr_to_fcode(Env, Expr), + Switch(X)} + end; %% Blocks expr_to_fcode(Env, _Type, {block, _, Stmts}) -> @@ -221,68 +229,140 @@ expr_to_fcode(_Env, Type, Expr) -> binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. --spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fcase(). +-spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fsplit(). alts_to_fcode(Env, Type, X, Alts) -> - split_tree(Env, [{X, Type}], [alt_to_fcode(Env, Alt) || Alt <- Alts]). + FAlts = [alt_to_fcode(Env, Alt) || Alt <- Alts], + split_tree(Env, [{X, Type}], FAlts). -%% Invariant: the number of variables matches the number of patterns in each falt. --spec split_tree(env(), [{var_name(), ftype()}], [falt()]) -> fcase(). -split_tree(_Env, [], [{'case', [], Expr}]) -> - {nosplit, Expr}; -split_tree(Env, Vars, Alts) -> - case next_split(Alts) of - {nosplit, Xs, Expr} -> {nosplit, Xs, Expr}; - {split, I, Splits} -> - {Vars1, [{X, T} | Vars2]} = lists:split(I, Vars), - Cases = [{'case', Pat, split_tree(Env, Vars1 ++ split_vars(Pat, T) ++ Vars2, As)} - || {Pat, As} <- Splits], - {split, T, X, Cases, nodefault} +%% %% Invariant: the number of variables matches the number of patterns in each falt. +-spec split_tree(env(), [{var_name(), ftype()}], [falt()]) -> fsplit(). +split_tree(_Env, _Vars, []) -> + error(non_exhaustive_patterns); %% TODO: nice error +split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> + io:format("split_tree\n Vars = ~p\n Alts = ~120p\n", [Vars, Alts]), + case next_split(Pats) of + false -> + Xs = [ X || {X, _} <- Vars ], + Ys = [ Y || {var, Y} <- Pats ], + Ren = [ {Y, X} || {Y, X} <- lists:zip(Ys, Xs), X /= Y, Y /= "_" ], + %% TODO: Unreachable clauses error + io:format("Renaming: ~p in\n ~p\n", [Ren, Body]), + {nosplit, rename(Ren, Body)}; + I when is_integer(I) -> + io:format(" split_at ~p\n", [I]), + {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars), + SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]), + io:format(" SAlts = ~p\n", [SAlts]), + Cases = [ {'case', SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)} + || {SPat, FAlts} <- SAlts ], + {split, Type, X, Cases} end. +-spec merge_alts(integer(), var_name(), [{fsplit_pat(), falt()}]) -> [{fsplit_pat(), [falt()]}]. +merge_alts(I, X, Alts) -> + lists:foldr(fun(A, As) -> merge_alt(I, X, A, As) end, + [], Alts). + +-spec merge_alt(integer(), var_name(), {fsplit_pat(), falt()}, Alts) -> Alts + when Alts :: [{fsplit_pat(), [falt()]}]. +merge_alt(_, _, {P, A}, []) -> [{P, [A]}]; +merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> + Match = fun({var, _}, {var, _}) -> match; + ({tuple, _}, {tuple, _}) -> match; + ({bool, B}, {bool, B}) -> match; + ({var, _}, _) -> expand; + (_, {var, _}) -> insert; + (_, _) -> mismatch + end, + + case Match(P, Q) of + match -> [{Q, [A | As]} | Rest]; + mismatch -> [{Q, As} | merge_alt(I, X, {P, A}, Rest)]; + expand -> [{Q, [expand(I, X, Q, A) | As]} | Rest]; + insert -> [{P, [A]}, {Q, As} | Rest] + end. + +expand(I, X, Q, {'case', Ps, E}) -> + {Ps0, [{var, Y} | Ps1]} = lists:split(I - 1, Ps), + Qs = case Q of + {tuple, Xs} -> [{var, "_"} || _ <- Xs]; + {bool, _} -> [] + end, + {'case', Ps0 ++ Qs ++ Ps1, rename([{Y, X}], E)}. + +-spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}. +split_alt(I, {'case', Pats, Body}) -> + {Pats0, [Pat | Pats1]} = lists:split(I - 1, Pats), + {SPat, InnerPats} = split_pat(Pat), + {SPat, {'case', Pats0 ++ InnerPats ++ Pats1, Body}}. + +-spec split_pat(fpat()) -> {fsplit_pat(), [fpat()]}. +split_pat(P = {var, X}) -> {{var, fresh_if_blank(X)}, [P]}; +split_pat({bool, B}) -> {{bool, B}, []}; +split_pat({tuple, Pats}) -> + Var = fun({var, X}) -> fresh_if_blank(X); (_) -> fresh_name() end, + Xs = [Var(P) || P <- Pats], + {{tuple, Xs}, Pats}. + -spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}]. split_vars({bool, _}, boolean) -> []; split_vars({tuple, Xs}, {tuple, Ts}) -> - lists:zip(Xs, Ts). + lists:zip(Xs, Ts); +split_vars({var, X}, T) -> [{X, T}]. -%% TODO: catchalls --spec next_split([falt()]) -> {nosplit, [var_name()], fexpr()} | {split, integer(), [{fsplit_pat(), [falt()]}]}. -next_split([]) -> - {nosplit, {abort, <<"Non-exhaustive pattern">>}}; -next_split(Alts = [{'case', Pats, Body} | _]) -> - NotMatch = fun({var, _}) -> true; (_) -> false end, - case lists:splitwith(NotMatch, Pats) of - {Vars, []} -> {nosplit, [X || {var, X} <- Vars], Body}; - {Vars, _} -> - I = length(Vars), - Splits = group_by_split_pat([ split_alt(I, Alt) || Alt <- Alts ]), - {split, I, Splits} +-spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). +rename(Ren, Expr) -> + case Expr of + {integer, _} -> Expr; + {bool, _} -> Expr; + {var, X} -> {var, rename_var(Ren, X)}; + {tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; + {binop, T, Op, E1, E2} -> {binop, T, Op, rename(Ren, E1), rename(Ren, E2)}; + {'if', A, B, C} -> {'if', rename(Ren, A), rename(Ren, B), rename(Ren, C)}; + {'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)} end. --spec split_alt(integer(), falt()) -> {fsplit_pat() | default, falt()}. -split_alt(I, {'case', Pats, Body}) -> - {Pats1, [Pat | Pats2]} = lists:split(I, Pats), - {FPat, InnerPats} = split_pat(Pat), - {FPat, {'case', Pats1 ++ InnerPats ++ Pats2, Body}}. +rename_var(Ren, X) -> proplists:get_value(X, Ren, X). +rename_binding(Ren, X) -> + Ren1 = lists:keydelete(X, 1, Ren), + case lists:keymember(X, 2, Ren) of + false -> {X, Ren1}; + true -> + Z = fresh_name(), + {Z, [{X, Z} | Ren1]} + end. --spec split_pat(fpat()) -> {fsplit_pat() | default, [fpat()]}. -split_pat({var, X}) -> {default, [{var, X}]}; -split_pat({bool, B}) -> {{bool, B}, []}; -split_pat({tuple, Pats}) -> - Var = fun({var, X}) -> X; (_) -> fresh_name() end, - Xs = [Var(P) || P <- Pats], - {{tuple, Xs}, Pats}. +rename_bindings(Ren, []) -> {[], Ren}; +rename_bindings(Ren, [X | Xs]) -> + {Z, Ren1} = rename_binding(Ren, X), + {Zs, Ren2} = rename_bindings(Ren1, Xs), + {[Z | Zs], Ren2}. --spec group_by_split_pat([{fsplit_pat() | default, falt()}]) -> [{fsplit_pat(), [falt()]}]. -group_by_split_pat(Alts) -> - Tag = fun(default) -> default; - ({tuple, _}) -> tuple; - ({bool, B}) -> B - end, - Grouped = maps:values(lists:foldr( - fun({Pat, _} = Alt, Map) -> - maps:update_with(Tag(Pat), fun(As) -> [Alt | As] end, [Alt], Map) - end, #{}, Alts)), - [ {Pat, [As || {_, As} <- G]} || G = [{Pat, _} | _] <- Grouped ]. +rename_pat(Ren, P = {bool, _}) -> {P, Ren}; +rename_pat(Ren, {var, X}) -> + {Z, Ren1} = rename_binding(Ren, X), + {{var, Z}, Ren1}; +rename_pat(Ren, {tuple, Xs}) -> + {Zs, Ren1} = rename_bindings(Ren, Xs), + {{tuple, Zs}, Ren1}. + +rename_split(Ren, {split, Type, X, Cases}) -> + {split, Type, rename_var(Ren, X), [rename_case(Ren, C) || C <- Cases]}. + +rename_case(Ren, {'case', Pat, Split}) -> + {Pat1, Ren1} = rename_pat(Ren, Pat), + {'case', Pat1, rename_split(Ren1, Split)}. + +-spec next_split([fpat()]) -> integer() | false. +next_split(Pats) -> + IsVar = fun({var, _}) -> true; (_) -> false end, + case [ I || {I, P} <- indexed(Pats), not IsVar(P) ] of + [] -> false; + [I | _] -> I + end. -spec alt_to_fcode(env(), aeso_syntax:alt()) -> falt(). alt_to_fcode(Env, {'case', _, Pat, Expr}) -> @@ -395,8 +475,17 @@ fresh_name() -> put('%fresh', N + 1), lists:concat(["%", N]). +-spec fresh_if_blank(var_name()) -> var_name(). +fresh_if_blank("_") -> fresh_name(); +fresh_if_blank(X) -> X. + %% -- Attributes -- get_attributes(Ann) -> [stateful || proplists:get_value(stateful, Ann, false)]. +%% -- Basic utilities -- + +indexed(Xs) -> + lists:zip(lists:seq(1, length(Xs)), Xs). + -- 2.30.2 From 3a095cde7e51d3bdf56782950e67fd423f932118 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 8 Apr 2019 08:59:47 +0200 Subject: [PATCH 21/87] Add missing case in renaming --- src/aeso_ast_to_fcode.erl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 204b96b..d2190ed 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -350,7 +350,8 @@ rename_pat(Ren, {tuple, Xs}) -> {{tuple, Zs}, Ren1}. rename_split(Ren, {split, Type, X, Cases}) -> - {split, Type, rename_var(Ren, X), [rename_case(Ren, C) || C <- Cases]}. + {split, Type, rename_var(Ren, X), [rename_case(Ren, C) || C <- Cases]}; +rename_split(Ren, {nosplit, E}) -> {nosplit, rename(Ren, E)}. rename_case(Ren, {'case', Pat, Split}) -> {Pat1, Ren1} = rename_pat(Ren, Pat), -- 2.30.2 From 66413ae7fee5a62587da241a72f8a8324d0be695 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 8 Apr 2019 13:15:16 +0200 Subject: [PATCH 22/87] Compile case trees all the way to Fate assembly --- src/aeso_fcode_to_fate.erl | 212 +++++++++++++++++++++++++++---------- 1 file changed, 155 insertions(+), 57 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 8ab8b9c..61de8b5 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -14,6 +14,13 @@ %% -- Preamble --------------------------------------------------------------- +-type scode() :: {switch, stype(), [maybe_scode()], maybe_scode()} %% last arg is catch-all + | switch_body + | tuple(). %% FATE instruction + +-type stype() :: tuple | boolean. +-type maybe_scode() :: missing | scode(). + -define(TODO(What), error({todo, ?FILE, ?LINE, ?FUNCTION_NAME, What})). -define(i(X), {immediate, X}). @@ -129,7 +136,7 @@ to_scode(Env, {binop, Type, Op, A, B}) -> to_scode(Env, {'if', Dec, Then, Else}) -> [ to_scode(notail(Env), Dec), - {ifte, to_scode(Env, Then), to_scode(Env, Else)} ]; + {switch, boolean, [to_scode(Env, Else), to_scode(Env, Then)], missing} ]; to_scode(Env, {'let', X, Expr, Body}) -> {I, Env1} = bind_local(X, Env), @@ -138,30 +145,50 @@ to_scode(Env, {'let', X, Expr, Body}) -> to_scode(Env1, Body) ]; to_scode(Env, {switch, Case}) -> - case_to_scode(Env, Case); + split_to_scode(Env, Case); to_scode(_Env, Icode) -> ?TODO(Icode). -case_to_scode(Env, {nosplit, _Xs, Expr}) -> - %% TODO: need to worry about variable names? - to_scode(Env, Expr); -case_to_scode(Env, {split, _Type, X, [{'case', {tuple, Xs}, Case}], nodefault}) -> - {Code, Env1} = match_tuple(Env, Xs), +split_to_scode(Env, {nosplit, Expr}) -> + [switch_body, to_scode(Env, Expr)]; +split_to_scode(Env, {split, {tuple, _}, X, Alts}) -> + {Def, Alts1} = catchall_to_scode(Env, X, Alts), + Alt = case [ {Xs, Split} || {'case', {tuple, Xs}, Split} <- Alts1 ] of + [] -> missing; + [{Xs, S} | _] -> + {Code, Env1} = match_tuple(Env, Xs), + [Code, split_to_scode(Env1, S)] + end, [aeb_fate_code:push(lookup_var(Env, X)), - Code, case_to_scode(Env1, Case)]; -case_to_scode(Env, Split = {split, boolean, X, Cases, nodefault}) -> - Then = lists:keyfind({bool, true}, 2, Cases), - Else = lists:keyfind({bool, false}, 2, Cases), - case {Then, Else} of - {{'case', _, ThenSplit}, {'case', _, ElseSplit}} -> - [aeb_fate_code:push(lookup_var(Env, X)), - {ifte, case_to_scode(Env, ThenSplit), - case_to_scode(Env, ElseSplit)}]; - _ -> ?TODO({'case', Split}) - end; -case_to_scode(_, Split = {split, _, _, _, _}) -> + case Def == missing andalso Alt /= missing of + true -> Alt; % skip the switch if single tuple pattern + false -> {switch, tuple, [Alt], Def} + end]; +split_to_scode(Env, {split, boolean, X, Alts}) -> + {Def, Alts1} = catchall_to_scode(Env, X, Alts), + GetAlt = fun(B) -> + case lists:keyfind({bool, B}, 2, Alts1) of + false -> missing; + {'case', _, S} -> split_to_scode(Env, S) + end + end, + SAlts = [GetAlt(false), GetAlt(true)], + [aeb_fate_code:push(lookup_var(Env, X)), + {switch, boolean, SAlts, Def}]; +split_to_scode(_, Split = {split, _, _, _}) -> ?TODO({'case', Split}). +catchall_to_scode(Env, X, Alts) -> catchall_to_scode(Env, X, Alts, []). + +catchall_to_scode(Env, X, [{'case', {var, Y}, Split} | _], Acc) -> + I = lookup_var(Env, X), + {J, Env1} = bind_local(Y, Env), + {[aeb_fate_code:store({var, J}, I), + split_to_scode(Env1, Split)], lists:reverse(Acc)}; +catchall_to_scode(Env, X, [Alt | Alts], Acc) -> + catchall_to_scode(Env, X, Alts, [Alt | Acc]); +catchall_to_scode(_, _, [], Acc) -> {missing, lists:reverse(Acc)}. + %% Tuple is in the accumulator. Arguments are the variable names. match_tuple(Env, Xs) -> match_tuple(Env, 0, Xs). @@ -195,9 +222,11 @@ optimize_scode(Funs, Options) -> maps:map(fun(Name, Def) -> optimize_fun(Funs, Name, Def, Options) end, Funs). -flatten(Code) -> lists:map(fun flatten_s/1, lists:flatten(Code)). +flatten(missing) -> missing; +flatten(Code) -> lists:map(fun flatten_s/1, lists:flatten(Code)). -flatten_s({ifte, Then, Else}) -> {ifte, flatten(Then), flatten(Else)}; +flatten_s({switch, Type, Alts, Catch}) -> + {switch, Type, [flatten(Alt) || Alt <- Alts], flatten(Catch)}; flatten_s(I) -> I. -define(MAX_SIMPL_ITERATIONS, 10). @@ -226,12 +255,18 @@ simpl_loop(N, Code, Options) -> false -> simpl_loop(N + 1, Code2, Options) end. -pp_ann(Ind, [{ifte, Then, Else} | Code]) -> - [Ind, "IF-THEN\n", - pp_ann(" " ++ Ind, Then), - Ind, "ELSE\n", - pp_ann(" " ++ Ind, Else), +pp_ann(Ind, [{switch, Type, Alts, Def} | Code]) -> + Tags = + case Type of + boolean -> ["FALSE", "TRUE"]; + tuple -> ["(_)"] + end, + [[[Ind, Tag, " =>\n", pp_ann(" " ++ Ind, Alt)] + || {Tag, Alt} <- lists:zip(Tags, Alts), Alt /= missing], + [[Ind, "_ =>\n", pp_ann(" " ++ Ind, Def)] || Def /= missing], pp_ann(Ind, Code)]; +pp_ann(Ind, [switch_body | Code]) -> + [Ind, "SWITCH-BODY\n", pp_ann(Ind, Code)]; pp_ann(Ind, [{#{ live_in := In, live_out := Out }, I} | Code]) -> Fmt = fun([]) -> "()"; (Xs) -> string:join([lists:concat(["var", N]) || {var, N} <- Xs], " ") @@ -250,11 +285,14 @@ annotate_code(Code) -> RCode. %% Reverses the code -ann_writes([{ifte, Then, Else} | Code], Writes, Acc) -> - {Then1, WritesThen} = ann_writes(Then, Writes, []), - {Else1, WritesElse} = ann_writes(Else, Writes, []), - Writes1 = ordsets:union(Writes, ordsets:intersection(WritesThen, WritesElse)), - ann_writes(Code, Writes1, [{ifte, Then1, Else1} | Acc]); +ann_writes(missing, Writes, []) -> {missing, Writes}; +ann_writes([switch_body | Code], Writes, Acc) -> + ann_writes(Code, Writes, [switch_body | Acc]); +ann_writes([{switch, Type, Alts, Def} | Code], Writes, Acc) -> + {Alts1, WritesAlts} = lists:unzip([ ann_writes(Alt, Writes, []) || Alt <- Alts ]), + {Def1, WritesDef} = ann_writes(Def, Writes, []), + Writes1 = ordsets:union(Writes, ordsets:intersection([WritesDef | WritesAlts])), + ann_writes(Code, Writes1, [{switch, Type, Alts1, Def1} | Acc]); ann_writes([I | Code], Writes, Acc) -> Ws = var_writes(I), Writes1 = ordsets:union(Writes, Ws), @@ -264,11 +302,14 @@ ann_writes([], Writes, Acc) -> {Acc, Writes}. %% Takes reversed code and unreverses it. -ann_reads([{ifte, Then, Else} | Code], Reads, Acc) -> - {Then1, ReadsThen} = ann_reads(Then, Reads, []), - {Else1, ReadsElse} = ann_reads(Else, Reads, []), - Reads1 = ordsets:union(Reads, ordsets:union(ReadsThen, ReadsElse)), - ann_reads(Code, Reads1, [{ifte, Then1, Else1} | Acc]); +ann_reads(missing, Reads, []) -> {missing, Reads}; +ann_reads([switch_body | Code], Reads, Acc) -> + ann_reads(Code, Reads, [switch_body | Acc]); +ann_reads([{switch, Type, Alts, Def} | Code], Reads, Acc) -> + {Alts1, ReadsAlts} = lists:unzip([ ann_reads(Alt, Reads, []) || Alt <- Alts ]), + {Def1, ReadsDef} = ann_reads(Def, Reads, []), + Reads1 = ordsets:union([Reads, ReadsDef | ReadsAlts]), + ann_reads(Code, Reads1, [{switch, Type, Alts1, Def1} | Acc]); ann_reads([{Ann, I} | Code], Reads, Acc) -> #{ writes_in := WritesIn, writes_out := WritesOut } = Ann, #{ read := Rs, write := W, pure := Pure } = attributes(I), @@ -415,8 +456,10 @@ var_writes(I) -> _ -> [] end. -independent({ifte, _, _}, _) -> false; -independent(_, {ifte, _, _}) -> false; +independent({switch, _, _, _}, _) -> false; +independent(_, {switch, _, _, _}) -> false; +independent(switch_body, _) -> true; +independent(_, switch_body) -> true; independent(I, J) -> #{ write := WI, read := RI, pure := PureI } = attributes(I), #{ write := WJ, read := RJ, pure := PureJ } = attributes(J), @@ -454,11 +497,12 @@ live_out(R, #{ live_out := LiveOut }) -> ordsets:is_element(R, LiveOut). %% -- Optimizations -- simplify([], _) -> []; +simplify(missing, _) -> missing; simplify([I | Code], Options) -> simpl_top(simpl_s(I, Options), simplify(Code, Options), Options). -simpl_s({ifte, Then, Else}, Options) -> - {ifte, simplify(Then, Options), simplify(Else, Options)}; +simpl_s({switch, Type, Alts, Def}, Options) -> + {switch, Type, [simplify(A, Options) || A <- Alts], simplify(Def, Options)}; simpl_s(I, _) -> I. simpl_top(I, Code, Options) -> @@ -565,6 +609,8 @@ r_inline_store(I = {_, {'STORE', R = {var, _}, A = {arg, _}}}, Code) -> r_inline_store([I], R, A, Code); r_inline_store(_, _) -> false. +r_inline_store(Acc, R, A, [switch_body | Code]) -> + r_inline_store([switch_body | Acc], R, A, Code); r_inline_store(Acc, R, A, [{Ann, I} | Code]) -> #{ write := W, pure := Pure } = attributes(I), Inl = fun(X) when X == R -> A; (X) -> X end, @@ -637,15 +683,20 @@ r_write_single_branch(_, _) -> false. %% Desugar and specialize and remove annotations -unannotate({ifte, Then, Else}) -> [{ifte, unannotate(Then), unannotate(Else)}]; +unannotate(switch_body) -> [switch_body]; +unannotate({switch, Type, Alts, Def}) -> + [{switch, Type, [unannotate(A) || A <- Alts], unannotate(Def)}]; +unannotate(missing) -> missing; unannotate(Code) when is_list(Code) -> lists:flatmap(fun unannotate/1, Code); unannotate({_Ann, I}) -> [I]. -%% Desugar and specialize and remove annotations +%% Desugar and specialize desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_code:inc()]; desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_code:dec()]; -desugar({ifte, Then, Else}) -> [{ifte, desugar(Then), desugar(Else)}]; +desugar({switch, Type, Alts, Def}) -> + [{switch, Type, [desugar(A) || A <- Alts], desugar(Def)}]; +desugar(missing) -> missing; desugar(Code) when is_list(Code) -> lists:flatmap(fun desugar/1, Code); desugar(I) -> [I]. @@ -659,6 +710,7 @@ to_basic_blocks(Funs, Options) -> || {Name, {{Args, Res}, Code}} <- maps:to_list(Funs) ]). bb(_Name, Code, _Options) -> + io:format("Code = ~p\n", [Code]), Blocks0 = blocks(Code), Blocks = optimize_blocks(Blocks0), Labels = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]), @@ -667,27 +719,73 @@ bb(_Name, Code, _Options) -> %% -- Break up scode into basic blocks -- +-type bbref() :: reference(). + +%% Code to be turned into blocks. +-record(blk, { ref :: bbref(), %% block id + code :: scode(), + catchall = none :: bbref() | none %% closest catchall + }). + +-type bb() :: {bbref(), bcode()}. +-type bcode() :: [binstr()]. +-type binstr() :: {jump, bbref()} + | {jumpif, bbref()} + | tuple(). %% FATE instruction + +-spec blocks(scode()) -> [bb()]. blocks(Code) -> Top = make_ref(), - blocks([{Top, Code}], []). + blocks([#blk{ref = Top, code = Code}], []). +-spec blocks([#blk{}], [bb()]) -> [bb()]. blocks([], Acc) -> lists:reverse(Acc); -blocks([{Ref, Code} | Blocks], Acc) -> - block(Ref, Code, [], Blocks, Acc). +blocks([Blk | Blocks], Acc) -> + block(Blk, [], Blocks, Acc). -block(Ref, [], CodeAcc, Blocks, BlockAcc) -> +-spec block(#blk{}, bcode(), [#blk{}], [bb()]) -> bb(). +block(#blk{ref = Ref, code = []}, CodeAcc, Blocks, BlockAcc) -> blocks(Blocks, [{Ref, lists:reverse(CodeAcc)} | BlockAcc]); -block(Ref, [{ifte, Then, Else} | Code], Acc, Blocks, BlockAcc) -> - ThenLbl = make_ref(), - RestLbl = make_ref(), - block(Ref, Else ++ [{jump, RestLbl}], - [{jumpif, ThenLbl} | Acc], - [{ThenLbl, Then ++ [{jump, RestLbl}]}, - {RestLbl, Code} | Blocks], - BlockAcc); -block(Ref, [I | Code], Acc, Blocks, BlockAcc) -> - block(Ref, Code, [I | Acc], Blocks, BlockAcc). +block(Blk = #blk{code = [switch_body | Code]}, Acc, Blocks, BlockAcc) -> + %% Reached the body of a switch. Clear catchall ref. + block(Blk#blk{code = Code, catchall = none}, Acc, Blocks, BlockAcc); +block(Blk = #blk{code = [{switch, Type, Alts, Default} | Code], + catchall = Catchall}, Acc, Blocks, BlockAcc) -> + FreshBlk = fun(C, Ca) -> + R = make_ref(), + {R, [#blk{ref = R, code = C, catchall = Ca}]} + end, + {RestRef, RestBlk} = FreshBlk(Code, Catchall), + {DefRef, DefBlk} = + case Default of + missing -> {Catchall, []}; + _ -> FreshBlk(Default ++ [{jump, RestRef}], Catchall) + %% ^ fall-through to the outer catchall + end, + {Blk1, Code1, AltBlks} = + case Type of + boolean -> + [FalseCode, TrueCode] = Alts, + {ThenRef, ThenBlk} = + case TrueCode of + missing -> {DefRef, []}; + _ -> FreshBlk(TrueCode ++ [{jump, RestRef}], DefRef) + end, + ElseCode = + case FalseCode of + missing -> [{jump, DefRef}]; + _ -> FalseCode ++ [{jump, RestRef}] + end, + {Blk#blk{code = ElseCode}, [{jumpif, ThenRef}], ThenBlk}; + tuple -> + [TCode] = Alts, + {Blk#blk{code = TCode ++ [{jump, RestRef}]}, [], []} + end, + Blk2 = Blk1#blk{catchall = DefRef}, %% Update catchall ref + block(Blk2, Code1 ++ Acc, DefBlk ++ RestBlk ++ AltBlks ++ Blocks, BlockAcc); +block(Blk = #blk{code = [I | Code]}, Acc, Blocks, BlockAcc) -> + block(Blk#blk{code = Code}, [I | Acc], Blocks, BlockAcc). %% -- Reorder, inline, and remove dead blocks -- -- 2.30.2 From 961af8ba93f9ef033667f707b7f18bce59ec82bc Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 8 Apr 2019 13:28:41 +0200 Subject: [PATCH 23/87] Simplify variables bindings in environment --- src/aeso_fcode_to_fate.erl | 40 ++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 61de8b5..dfe65e1 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -43,7 +43,7 @@ Op =:= 'OR' orelse Op =:= 'ELEMENT')). --record(env, { args = [], stack = [], locals = [], tailpos = true }). +-record(env, { vars = [], locals = [], tailpos = true }). %% -- Debugging -------------------------------------------------------------- @@ -95,22 +95,25 @@ function_to_scode(Name, Args, Body, ResType, Options) -> %% -- Environment functions -- init_env(Args) -> - #env{ args = Args, stack = [], tailpos = true }. + #env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], + tailpos = true }. -push_env(Type, Env) -> - Env#env{ stack = [Type | Env#env.stack] }. +next_var(#env{ vars = Vars }) -> + 1 + lists:max([-1 | [J || {_, {var, J}} <- Vars]]). -bind_local(Name, Env = #env{ locals = Locals }) -> - I = length(Locals), - {I, Env#env{ locals = [{Name, I} | Locals] }}. +bind_var(Name, Var, Env = #env{ vars = Vars }) -> + Env#env{ vars = [{Name, Var} | Vars] }. + +bind_local(Name, Env) -> + I = next_var(Env), + {I, bind_var(Name, {var, I}, Env)}. notail(Env) -> Env#env{ tailpos = false }. -lookup_var(Env = #env{ args = Args, locals = Locals }, X) -> - case {lists:keyfind(X, 1, Locals), keyfind_index(X, 1, Args)} of - {false, false} -> error({unbound_variable, X, Env}); - {false, Arg} -> {arg, Arg}; - {{_, Local}, _} -> {var, Local} +lookup_var(Env = #env{ vars = Vars }, X) -> + case lists:keyfind(X, 1, Vars) of + false -> error({unbound_variable, X, Env}); + {_, Var} -> Var end. %% -- The compiler -- @@ -129,9 +132,9 @@ to_scode(Env, {tuple, As}) -> [[ to_scode(Env, A) || A <- As ], aeb_fate_code:tuple(N)]; -to_scode(Env, {binop, Type, Op, A, B}) -> +to_scode(Env, {binop, _Type, Op, A, B}) -> [ to_scode(notail(Env), B), - to_scode(push_env(Type, Env), A), + to_scode(Env, A), binop_to_scode(Op) ]; to_scode(Env, {'if', Dec, Then, Else}) -> @@ -181,10 +184,8 @@ split_to_scode(_, Split = {split, _, _, _}) -> catchall_to_scode(Env, X, Alts) -> catchall_to_scode(Env, X, Alts, []). catchall_to_scode(Env, X, [{'case', {var, Y}, Split} | _], Acc) -> - I = lookup_var(Env, X), - {J, Env1} = bind_local(Y, Env), - {[aeb_fate_code:store({var, J}, I), - split_to_scode(Env1, Split)], lists:reverse(Acc)}; + Env1 = bind_var(Y, lookup_var(Env, X), Env), + {split_to_scode(Env1, Split), lists:reverse(Acc)}; catchall_to_scode(Env, X, [Alt | Alts], Acc) -> catchall_to_scode(Env, X, Alts, [Alt | Acc]); catchall_to_scode(_, _, [], Acc) -> {missing, lists:reverse(Acc)}. @@ -658,6 +659,8 @@ r_write_to_dead_var({Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a -> false -> case Code of [] -> {[], []}; + [switch_body, {Ann1, I} | Code1] -> + {[], [switch_body, {merge_ann(Ann, Ann1), I} | Code1]}; [{Ann1, I} | Code1] -> {[], [{merge_ann(Ann, Ann1), I} | Code1]} end; @@ -710,7 +713,6 @@ to_basic_blocks(Funs, Options) -> || {Name, {{Args, Res}, Code}} <- maps:to_list(Funs) ]). bb(_Name, Code, _Options) -> - io:format("Code = ~p\n", [Code]), Blocks0 = blocks(Code), Blocks = optimize_blocks(Blocks0), Labels = maps:from_list([ {Ref, I} || {I, {Ref, _}} <- with_ixs(Blocks) ]), -- 2.30.2 From 42c7fde413a99f82d27d80f9dd697f0f823f8ada Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 8 Apr 2019 13:31:46 +0200 Subject: [PATCH 24/87] Shortcut let x = y in ... --- src/aeso_fcode_to_fate.erl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index dfe65e1..b6208d5 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -141,6 +141,9 @@ to_scode(Env, {'if', Dec, Then, Else}) -> [ to_scode(notail(Env), Dec), {switch, boolean, [to_scode(Env, Else), to_scode(Env, Then)], missing} ]; +to_scode(Env, {'let', X, {var, Y}, Body}) -> + Env1 = bind_var(X, lookup_var(Env, Y), Env), + to_scode(Env1, Body); to_scode(Env, {'let', X, Expr, Body}) -> {I, Env1} = bind_local(X, Env), [ to_scode(Env, Expr), -- 2.30.2 From e597a3780ab1d93167548cd61e2029f9def21056 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 8 Apr 2019 14:29:18 +0200 Subject: [PATCH 25/87] compile list literals --- src/aeso_ast_to_fcode.erl | 10 +++++++++- src/aeso_fcode_to_fate.erl | 16 ++++++++-------- 2 files changed, 17 insertions(+), 9 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index d2190ed..04431ab 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -24,10 +24,11 @@ -type var_name() :: string(). -type sophia_name() :: [string()]. --type binop() :: '+' | '-' | '=='. +-type binop() :: '+' | '-' | '==' | '::'. -type fexpr() :: {integer, integer()} | {bool, false | true} + | nil | {var, var_name()} | {tuple, [fexpr()]} | {binop, ftype(), binop(), fexpr(), fexpr()} @@ -196,6 +197,12 @@ expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; expr_to_fcode(Env, _Type, {tuple, _, Es}) -> {tuple, [expr_to_fcode(Env, E) || E <- Es]}; +%% Lists +expr_to_fcode(Env, Type, {list, _, Es}) -> + FType = type_to_fcode(Env, Type), + lists:foldr(fun(E, L) -> {binop, FType, '::', expr_to_fcode(Env, E), L} end, + nil, Es); + %% Conditionals expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> {'if', expr_to_fcode(Env, Cond), @@ -315,6 +322,7 @@ rename(Ren, Expr) -> case Expr of {integer, _} -> Expr; {bool, _} -> Expr; + nil -> nil; {var, X} -> {var, rename_var(Ren, X)}; {tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; {binop, T, Op, E1, E2} -> {binop, T, Op, rename(Ren, E1), rename(Ren, E2)}; diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index b6208d5..a61900b 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -41,7 +41,8 @@ Op =:= 'NEQ' orelse Op =:= 'AND' orelse Op =:= 'OR' orelse - Op =:= 'ELEMENT')). + Op =:= 'ELEMENT' orelse + Op =:= 'CONS')). -record(env, { vars = [], locals = [], tailpos = true }). @@ -124,6 +125,8 @@ to_scode(_Env, {integer, N}) -> to_scode(_Env, {bool, B}) -> [aeb_fate_code:push(?i(B))]; +to_scode(_Env, nil) -> aeb_fate_code:nil(?a); + to_scode(Env, {var, X}) -> [aeb_fate_code:push(lookup_var(Env, X))]; @@ -210,15 +213,12 @@ match_tuple(Env, _, []) -> %% -- Operators -- -binop_to_scode('+') -> add_a_a_a(); %% Optimization introduces other variants -binop_to_scode('-') -> sub_a_a_a(); -binop_to_scode('==') -> eq_a_a_a(). +binop_to_scode('+') -> aeb_fate_code:add(?a, ?a, ?a); +binop_to_scode('-') -> aeb_fate_code:sub(?a, ?a, ?a); +binop_to_scode('==') -> aeb_fate_code:eq(?a, ?a, ?a); +binop_to_scode('::') -> aeb_fate_code:cons(?a, ?a, ?a). % binop_to_scode(Op) -> ?TODO(Op). -add_a_a_a() -> aeb_fate_code:add(?a, ?a, ?a). -sub_a_a_a() -> aeb_fate_code:sub(?a, ?a, ?a). -eq_a_a_a() -> aeb_fate_code:eq(?a, ?a, ?a). - %% -- Phase II --------------------------------------------------------------- %% Optimize -- 2.30.2 From 771e4aa96740d542a1ea0337c2b42fe3153f67fd Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 8 Apr 2019 17:53:20 +0200 Subject: [PATCH 26/87] Fix various bugs in pattern match compilation --- src/aeso_ast_to_fcode.erl | 57 +++++++++++++++++++------------------- src/aeso_fcode_to_fate.erl | 5 +++- 2 files changed, 33 insertions(+), 29 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 04431ab..6482d4e 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -165,14 +165,14 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R Env#{ functions := NewFuns }. -spec type_to_fcode(env(), aeso_syntax:type()) -> ftype(). -type_to_fcode(Env, {app_t, T = {Id, _, _}, Types}) when Id == id; Id == qid -> +type_to_fcode(Env, {app_t, _, T = {Id, _, _}, Types}) when Id == id; Id == qid -> lookup_type(Env, T, [type_to_fcode(Env, Type) || Type <- Types]); type_to_fcode(Env, T = {Id, _, _}) when Id == id; Id == qid -> lookup_type(Env, T, []); type_to_fcode(Env, {tuple_t, _, Types}) -> {tuple, [type_to_fcode(Env, T) || T <- Types]}; type_to_fcode(_Env, Type) -> - {todo, Type}. + error({todo, Type}). -spec args_to_fcode(env(), [aeso_syntax:arg()]) -> [{var_name(), ftype()}]. args_to_fcode(Env, Args) -> @@ -199,8 +199,7 @@ expr_to_fcode(Env, _Type, {tuple, _, Es}) -> %% Lists expr_to_fcode(Env, Type, {list, _, Es}) -> - FType = type_to_fcode(Env, Type), - lists:foldr(fun(E, L) -> {binop, FType, '::', expr_to_fcode(Env, E), L} end, + lists:foldr(fun(E, L) -> {binop, Type, '::', expr_to_fcode(Env, E), L} end, nil, Es); %% Conditionals @@ -246,20 +245,17 @@ alts_to_fcode(Env, Type, X, Alts) -> split_tree(_Env, _Vars, []) -> error(non_exhaustive_patterns); %% TODO: nice error split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> - io:format("split_tree\n Vars = ~p\n Alts = ~120p\n", [Vars, Alts]), case next_split(Pats) of false -> Xs = [ X || {X, _} <- Vars ], Ys = [ Y || {var, Y} <- Pats ], Ren = [ {Y, X} || {Y, X} <- lists:zip(Ys, Xs), X /= Y, Y /= "_" ], %% TODO: Unreachable clauses error - io:format("Renaming: ~p in\n ~p\n", [Ren, Body]), {nosplit, rename(Ren, Body)}; I when is_integer(I) -> - io:format(" split_at ~p\n", [I]), + Xs = [X || {X, _} <- Vars], {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars), - SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]), - io:format(" SAlts = ~p\n", [SAlts]), + SAlts = merge_alts(I, X, [ split_alt(Xs, I, A) || A <- Alts ]), Cases = [ {'case', SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)} || {SPat, FAlts} <- SAlts ], {split, Type, X, Cases} @@ -267,8 +263,11 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> -spec merge_alts(integer(), var_name(), [{fsplit_pat(), falt()}]) -> [{fsplit_pat(), [falt()]}]. merge_alts(I, X, Alts) -> + merge_alts(I, X, Alts, []). + +merge_alts(I, X, Alts, Alts1) -> lists:foldr(fun(A, As) -> merge_alt(I, X, A, As) end, - [], Alts). + Alts1, Alts). -spec merge_alt(integer(), var_name(), {fsplit_pat(), falt()}, Alts) -> Alts when Alts :: [{fsplit_pat(), [falt()]}]. @@ -281,33 +280,33 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> (_, {var, _}) -> insert; (_, _) -> mismatch end, - case Match(P, Q) of match -> [{Q, [A | As]} | Rest]; mismatch -> [{Q, As} | merge_alt(I, X, {P, A}, Rest)]; - expand -> [{Q, [expand(I, X, Q, A) | As]} | Rest]; + expand -> merge_alts(I, X, expand(I, X, Q, A), [{Q, As} | Rest]); insert -> [{P, [A]}, {Q, As} | Rest] end. expand(I, X, Q, {'case', Ps, E}) -> {Ps0, [{var, Y} | Ps1]} = lists:split(I - 1, Ps), - Qs = case Q of - {tuple, Xs} -> [{var, "_"} || _ <- Xs]; - {bool, _} -> [] - end, - {'case', Ps0 ++ Qs ++ Ps1, rename([{Y, X}], E)}. + Splice = fun(Qs) -> Ps0 ++ Qs ++ Ps1 end, + E1 = rename([{Y, X}], E), + case Q of + {tuple, Xs} -> [{Q, {'case', Splice([{var, "_"} || _ <- Xs]), E1}}]; + {bool, _} -> [{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]] + end. --spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}. -split_alt(I, {'case', Pats, Body}) -> +-spec split_alt([var_name()], integer(), falt()) -> {fsplit_pat(), falt()}. +split_alt(Bound, I, {'case', Pats, Body}) -> {Pats0, [Pat | Pats1]} = lists:split(I - 1, Pats), - {SPat, InnerPats} = split_pat(Pat), + {SPat, InnerPats} = split_pat(Bound, Pat), {SPat, {'case', Pats0 ++ InnerPats ++ Pats1, Body}}. --spec split_pat(fpat()) -> {fsplit_pat(), [fpat()]}. -split_pat(P = {var, X}) -> {{var, fresh_if_blank(X)}, [P]}; -split_pat({bool, B}) -> {{bool, B}, []}; -split_pat({tuple, Pats}) -> - Var = fun({var, X}) -> fresh_if_blank(X); (_) -> fresh_name() end, +-spec split_pat(var_name(), fpat()) -> {fsplit_pat(), [fpat()]}. +split_pat(Bound, P = {var, X}) -> {{var, freshen(Bound, X)}, [P]}; +split_pat(_Bound, {bool, B}) -> {{bool, B}, []}; +split_pat(Bound, {tuple, Pats}) -> + Var = fun({var, X}) -> freshen(Bound, X); (_) -> fresh_name() end, Xs = [Var(P) || P <- Pats], {{tuple, Xs}, Pats}. @@ -484,9 +483,11 @@ fresh_name() -> put('%fresh', N + 1), lists:concat(["%", N]). --spec fresh_if_blank(var_name()) -> var_name(). -fresh_if_blank("_") -> fresh_name(); -fresh_if_blank(X) -> X. +freshen(Bound, X) -> + case lists:member(X, ["_" | Bound]) of + true -> fresh_name(); + false -> X + end. %% -- Attributes -- diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index a61900b..c3afd9d 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -484,7 +484,7 @@ merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> #{ live_in => LiveIn, live_out => LiveOut }. %% Swap two instructions. Precondition: the instructions are independent/2. -swap_instrs({#{ live_in := Live1, live_out := Live2 }, I}, {#{ live_in := Live2, live_out := Live3 }, J}) -> +swap_instrs({#{ live_in := Live1 }, I}, {#{ live_in := Live2, live_out := Live3 }, J}) -> %% Since I and J are independent the J can't read or write anything in %% that I writes. WritesI = ordsets:subtract(Live2, Live1), @@ -764,6 +764,8 @@ block(Blk = #blk{code = [{switch, Type, Alts, Default} | Code], {RestRef, RestBlk} = FreshBlk(Code, Catchall), {DefRef, DefBlk} = case Default of + missing when Catchall == none -> + FreshBlk([aeb_fate_code:abort(?i(<<"Incomplete patterns">>))], none); missing -> {Catchall, []}; _ -> FreshBlk(Default ++ [{jump, RestRef}], Catchall) %% ^ fall-through to the outer catchall @@ -816,6 +818,7 @@ reorder_blocks(Ref, Code, Blocks, Acc) -> case Code of ['RETURN'|_] -> reorder_blocks(Blocks, Acc1); [{'RETURNR', _}|_] -> reorder_blocks(Blocks, Acc1); + [{'ABORT', _}|_] -> reorder_blocks(Blocks, Acc1); [{jump, L}|_] -> NotL = fun({L1, _}) -> L1 /= L end, case lists:splitwith(NotL, Blocks) of -- 2.30.2 From f73a0934d4ed63c148de52089154cc0c10d4f1dd Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 09:15:37 +0200 Subject: [PATCH 27/87] Pretty printer for fcode --- src/aeso_ast_to_fcode.erl | 67 ++++++++++++++++++++++++++++++++++++++- 1 file changed, 66 insertions(+), 1 deletion(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 6482d4e..45fb20e 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -9,7 +9,7 @@ %%%------------------------------------------------------------------- -module(aeso_ast_to_fcode). --export([ast_to_fcode/2]). +-export([ast_to_fcode/2, format_fexpr/1]). -export_type([fcode/0, fexpr/0, fun_def/0]). %% -- Type definitions ------------------------------------------------------- @@ -499,3 +499,68 @@ get_attributes(Ann) -> indexed(Xs) -> lists:zip(lists:seq(1, length(Xs)), Xs). +%% -- Pretty printing -------------------------------------------------------- + +format_fexpr(E) -> + prettypr:format(pp_fexpr(E)). + +pp_text(S) -> prettypr:text(lists:concat([S])). + +pp_beside([]) -> prettypr:empty(); +pp_beside([X]) -> X; +pp_beside([X | Xs]) -> pp_beside(X, pp_beside(Xs)). + +pp_beside(A, B) -> prettypr:beside(A, B). + +pp_above([]) -> prettypr:empty(); +pp_above([X]) -> X; +pp_above([X | Xs]) -> pp_above(X, pp_above(Xs)). + +pp_above(A, B) -> prettypr:above(A, B). + +pp_parens(Doc) -> + pp_beside([pp_text("("), Doc, pp_text(")")]). + +pp_punctuate(_Sep, []) -> []; +pp_punctuate(_Sep, [X]) -> [X]; +pp_punctuate(Sep, [X | Xs]) -> [pp_beside(X, Sep) | pp_punctuate(Sep, Xs)]. + +pp_fexpr({integer, N}) -> + pp_text(N); +pp_fexpr({bool, B}) -> + pp_text(B); +pp_fexpr(nil) -> + pp_text("[]"); +pp_fexpr({var, X}) -> + pp_text(X); +pp_fexpr({tuple, Es}) -> + pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); +pp_fexpr({binop, _Type, Op, A, B}) -> + pp_parens(prettypr:par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); +pp_fexpr({'if', A, B, C}) -> + prettypr:par([pp_beside(pp_text("if "), pp_fexpr(A)), + prettypr:nest(2, pp_beside(pp_text("then "), pp_fexpr(B))), + prettypr:nest(2, pp_beside(pp_text("else "), pp_fexpr(C)))]); +pp_fexpr({'let', X, A, B}) -> + prettypr:par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), + pp_fexpr(B)]); +pp_fexpr({switch, Split}) -> pp_split(Split). + +pp_ftype(T) when is_atom(T) -> pp_text(T); +pp_ftype({tuple, Ts}) -> + pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); +pp_ftype({list, T}) -> + pp_beside([pp_text("list("), pp_ftype(T), pp_text(")")]). + +pp_split({nosplit, E}) -> pp_fexpr(E); +pp_split({split, Type, X, Alts}) -> + pp_above([pp_beside([pp_text("switch("), pp_text(X), pp_text(" : "), pp_ftype(Type), pp_text(")")])] ++ + [prettypr:nest(2, pp_case(Alt)) || Alt <- Alts]). + +pp_case({'case', Pat, Split}) -> + pp_above(pp_beside(pp_pat(Pat), pp_text(" =>")), + prettypr:nest(2, pp_split(Split))). + +pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); +pp_pat(Pat) -> pp_fexpr(Pat). + -- 2.30.2 From cca83a5dfaaa0f9b99b7959126f6b9362ee96d8a Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 09:32:51 +0200 Subject: [PATCH 28/87] Fix renaming bug --- src/aeso_ast_to_fcode.erl | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 45fb20e..34794a5 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -289,8 +289,10 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> expand(I, X, Q, {'case', Ps, E}) -> {Ps0, [{var, Y} | Ps1]} = lists:split(I - 1, Ps), - Splice = fun(Qs) -> Ps0 ++ Qs ++ Ps1 end, - E1 = rename([{Y, X}], E), + {Ps0r, Ren1} = rename_pats([{Y, X}], Ps0), + {Ps1r, Ren2} = rename_pats(Ren1, Ps1), + E1 = rename(Ren2, E), + Splice = fun(Qs) -> Ps0r ++ Qs ++ Ps1r end, case Q of {tuple, Xs} -> [{Q, {'case', Splice([{var, "_"} || _ <- Xs]), E1}}]; {bool, _} -> [{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]] @@ -348,6 +350,12 @@ rename_bindings(Ren, [X | Xs]) -> {Zs, Ren2} = rename_bindings(Ren1, Xs), {[Z | Zs], Ren2}. +rename_pats(Ren, []) -> {[], Ren}; +rename_pats(Ren, [P | Ps]) -> + {Q, Ren1} = rename_pat(Ren, P), + {Qs, Ren2} = rename_pats(Ren1, Ps), + {[Q | Qs], Ren2}. + rename_pat(Ren, P = {bool, _}) -> {P, Ren}; rename_pat(Ren, {var, X}) -> {Z, Ren1} = rename_binding(Ren, X), -- 2.30.2 From ee7bc126fc522ddf8094bc9c73b42e897d2e7805 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 10:04:34 +0200 Subject: [PATCH 29/87] Another renaming bug --- src/aeso_ast_to_fcode.erl | 27 ++++++++++----------------- 1 file changed, 10 insertions(+), 17 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 34794a5..2abccfc 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -45,12 +45,6 @@ | {tuple, [var_name()]} | {var, var_name()}. -%% Intermediate format before case trees (fcase() and fsplit()). --type falt() :: {'case', [fpat()], fexpr()}. --type fpat() :: {var, var_name()} - | {bool, false | true} - | {tuple, [fpat()]}. - -type ftype() :: aeb_fate_data:fate_type_type(). @@ -240,6 +234,12 @@ alts_to_fcode(Env, Type, X, Alts) -> FAlts = [alt_to_fcode(Env, Alt) || Alt <- Alts], split_tree(Env, [{X, Type}], FAlts). +%% Intermediate format before case trees (fcase() and fsplit()). +-type falt() :: {'case', [fpat()], fexpr()}. +-type fpat() :: {var, var_name()} + | {bool, false | true} + | {tuple, [fpat()]}. + %% %% Invariant: the number of variables matches the number of patterns in each falt. -spec split_tree(env(), [{var_name(), ftype()}], [falt()]) -> fsplit(). split_tree(_Env, _Vars, []) -> @@ -289,7 +289,7 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> expand(I, X, Q, {'case', Ps, E}) -> {Ps0, [{var, Y} | Ps1]} = lists:split(I - 1, Ps), - {Ps0r, Ren1} = rename_pats([{Y, X}], Ps0), + {Ps0r, Ren1} = rename_pats([{Y, X} || Y /= X], Ps0), {Ps1r, Ren2} = rename_pats(Ren1, Ps1), E1 = rename(Ren2, E), Splice = fun(Qs) -> Ps0r ++ Qs ++ Ps1r end, @@ -305,11 +305,10 @@ split_alt(Bound, I, {'case', Pats, Body}) -> {SPat, {'case', Pats0 ++ InnerPats ++ Pats1, Body}}. -spec split_pat(var_name(), fpat()) -> {fsplit_pat(), [fpat()]}. -split_pat(Bound, P = {var, X}) -> {{var, freshen(Bound, X)}, [P]}; +split_pat(_Bound, P = {var, _}) -> {{var, fresh_name()}, [P]}; split_pat(_Bound, {bool, B}) -> {{bool, B}, []}; -split_pat(Bound, {tuple, Pats}) -> - Var = fun({var, X}) -> freshen(Bound, X); (_) -> fresh_name() end, - Xs = [Var(P) || P <- Pats], +split_pat(_Bound, {tuple, Pats}) -> + Xs = [fresh_name() || _ <- Pats], {{tuple, Xs}, Pats}. -spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}]. @@ -491,12 +490,6 @@ fresh_name() -> put('%fresh', N + 1), lists:concat(["%", N]). -freshen(Bound, X) -> - case lists:member(X, ["_" | Bound]) of - true -> fresh_name(); - false -> X - end. - %% -- Attributes -- get_attributes(Ann) -> -- 2.30.2 From b3131504b0b8a111e6a5fed242c1a4f0b5e4d6ab Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 10:51:30 +0200 Subject: [PATCH 30/87] Handle switch_body in optimizations --- src/aeso_fcode_to_fate.erl | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index c3afd9d..f141dea 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -298,7 +298,7 @@ ann_writes([{switch, Type, Alts, Def} | Code], Writes, Acc) -> Writes1 = ordsets:union(Writes, ordsets:intersection([WritesDef | WritesAlts])), ann_writes(Code, Writes1, [{switch, Type, Alts1, Def1} | Acc]); ann_writes([I | Code], Writes, Acc) -> - Ws = var_writes(I), + Ws = var_writes({#{}, I}), Writes1 = ordsets:union(Writes, Ws), Ann = #{ writes_in => Writes, writes_out => Writes1 }, ann_writes(Code, Writes1, [{Ann, I} | Acc]); @@ -453,7 +453,7 @@ attributes(I) -> 'NOP' -> Pure(none, []) end. -var_writes(I) -> +var_writes({_, I}) -> #{ write := W } = attributes(I), case W of {var, _} -> [W]; @@ -464,7 +464,7 @@ independent({switch, _, _, _}, _) -> false; independent(_, {switch, _, _, _}) -> false; independent(switch_body, _) -> true; independent(_, switch_body) -> true; -independent(I, J) -> +independent({_, I}, {_, J}) -> #{ write := WI, read := RI, pure := PureI } = attributes(I), #{ write := WJ, read := RJ, pure := PureJ } = attributes(J), @@ -484,6 +484,8 @@ merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> #{ live_in => LiveIn, live_out => LiveOut }. %% Swap two instructions. Precondition: the instructions are independent/2. +swap_instrs(I, switch_body) -> {switch_body, I}; +swap_instrs(switch_body, I) -> {I, switch_body}; swap_instrs({#{ live_in := Live1 }, I}, {#{ live_in := Live2, live_out := Live3 }, J}) -> %% Since I and J are independent the J can't read or write anything in %% that I writes. @@ -573,34 +575,36 @@ r_dup_to_push({Ann1, Push={'PUSH', _}}, [{Ann2, 'DUPA'} | Code]) -> r_dup_to_push(_, _) -> false. %% Move PUSH A past non-stack instructions. -r_swap_push(PushA = {_, Push = {'PUSH', _}}, [IA = {_, I} | Code]) -> +r_swap_push(Push = {_, {'PUSH', _}}, [I | Code]) -> case independent(Push, I) of true -> - {I1, Push1} = swap_instrs(PushA, IA), + {I1, Push1} = swap_instrs(Push, I), {[I1, Push1], Code}; false -> false end; r_swap_push(_, _) -> false. %% Match up writes to variables with instructions further down. -r_swap_write(IA = {_, I}, [JA = {_, J} | Code]) -> +r_swap_write(I = {_, _}, [J | Code]) -> case {var_writes(I), independent(I, J)} of {[_], true} -> - {J1, I1} = swap_instrs(IA, JA), + {J1, I1} = swap_instrs(I, J), r_swap_write([J1], I1, Code); _ -> false end; r_swap_write(_, _) -> false. -r_swap_write(Pre, IA = {_, I}, Code0 = [JA | Code]) -> - case {apply_rules_once(merge_rules(), IA, Code0), JA} of - {{_Rule, New, Rest}, _} -> +r_swap_write(Pre, I, [switch_body | Code]) -> + r_swap_write([switch_body | Pre], I, Code); +r_swap_write(Pre, I, Code0 = [J | Code]) -> + case apply_rules_once(merge_rules(), I, Code0) of + {_Rule, New, Rest} -> {lists:reverse(Pre) ++ New, Rest}; - {false, {_, J}} -> + false -> case independent(I, J) of false -> false; true -> - {J1, I1} = swap_instrs(IA, JA), + {J1, I1} = swap_instrs(I, J), r_swap_write([J1 | Pre], I1, Code) end; _ -> false -- 2.30.2 From 758f836bf6c742f7048234a0102945db52874125 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 10:52:39 +0200 Subject: [PATCH 31/87] Remove optimization for if-then-else --- src/aeso_fcode_to_fate.erl | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index f141dea..915c646 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -536,8 +536,7 @@ apply_rules_once([{RName, Rule} | Rules], I, Code) -> merge_rules() -> [?RULE(r_push_consume), ?RULE(r_one_shot_var), - ?RULE(r_write_to_dead_var), - ?RULE(r_write_single_branch) + ?RULE(r_write_to_dead_var) ]. rules() -> @@ -675,22 +674,6 @@ r_write_to_dead_var({Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a -> end; r_write_to_dead_var(_, _) -> false. -%% Push variable writes that are only needed in a single branch inside the branch. -r_write_single_branch(IA = {_Ann, I}, [{ifte, Then = [{AnnThen, _} | _], Else = [{AnnElse, _} | _]} | Code]) -> - #{ write := R } = attributes(I), - case R of - {var, _} -> - case {live_in(R, AnnThen), live_in(R, AnnElse)} of - {true, false} -> - {[], [{ifte, [IA | Then], Else} | Code]}; - {false, true} -> - {[], [{ifte, Then, [IA | Else]} | Code]}; - _ -> false - end; - _ -> false - end; -r_write_single_branch(_, _) -> false. - %% Desugar and specialize and remove annotations unannotate(switch_body) -> [switch_body]; -- 2.30.2 From 46c538b7bf7983b76d7c54af7f28878a0995dc19 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 11:08:54 +0200 Subject: [PATCH 32/87] Tag instructions in annotated scode --- src/aeso_fcode_to_fate.erl | 88 ++++++++++++++++++++++---------------- 1 file changed, 50 insertions(+), 38 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 915c646..ce3fe21 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -18,8 +18,18 @@ | switch_body | tuple(). %% FATE instruction --type stype() :: tuple | boolean. --type maybe_scode() :: missing | scode(). +%% Annotated scode +-type scode_a() :: {switch, stype(), [maybe_scode_a()], maybe_scode_a()} %% last arg is catch-all + | switch_body + | {i, ann(), tuple()}. %% FATE instruction + +-type ann() :: #{ live_in := vars(), live_out := vars() }. +-type var() :: {var, integer()}. +-type vars() :: ordsets:set(var()). + +-type stype() :: tuple | boolean. +-type maybe_scode() :: missing | scode(). +-type maybe_scode_a() :: missing | scode_a(). -define(TODO(What), error({todo, ?FILE, ?LINE, ?FUNCTION_NAME, What})). @@ -271,7 +281,7 @@ pp_ann(Ind, [{switch, Type, Alts, Def} | Code]) -> pp_ann(Ind, Code)]; pp_ann(Ind, [switch_body | Code]) -> [Ind, "SWITCH-BODY\n", pp_ann(Ind, Code)]; -pp_ann(Ind, [{#{ live_in := In, live_out := Out }, I} | Code]) -> +pp_ann(Ind, [{i, #{ live_in := In, live_out := Out }, I} | Code]) -> Fmt = fun([]) -> "()"; (Xs) -> string:join([lists:concat(["var", N]) || {var, N} <- Xs], " ") end, @@ -298,10 +308,10 @@ ann_writes([{switch, Type, Alts, Def} | Code], Writes, Acc) -> Writes1 = ordsets:union(Writes, ordsets:intersection([WritesDef | WritesAlts])), ann_writes(Code, Writes1, [{switch, Type, Alts1, Def1} | Acc]); ann_writes([I | Code], Writes, Acc) -> - Ws = var_writes({#{}, I}), + Ws = var_writes(I), Writes1 = ordsets:union(Writes, Ws), Ann = #{ writes_in => Writes, writes_out => Writes1 }, - ann_writes(Code, Writes1, [{Ann, I} | Acc]); + ann_writes(Code, Writes1, [{i, Ann, I} | Acc]); ann_writes([], Writes, Acc) -> {Acc, Writes}. @@ -314,7 +324,7 @@ ann_reads([{switch, Type, Alts, Def} | Code], Reads, Acc) -> {Def1, ReadsDef} = ann_reads(Def, Reads, []), Reads1 = ordsets:union([Reads, ReadsDef | ReadsAlts]), ann_reads(Code, Reads1, [{switch, Type, Alts1, Def1} | Acc]); -ann_reads([{Ann, I} | Code], Reads, Acc) -> +ann_reads([{i, Ann, I} | Code], Reads, Acc) -> #{ writes_in := WritesIn, writes_out := WritesOut } = Ann, #{ read := Rs, write := W, pure := Pure } = attributes(I), Reads1 = @@ -328,7 +338,7 @@ ann_reads([{Ann, I} | Code], Reads, Acc) -> LiveIn = ordsets:intersection(Reads1, WritesIn), LiveOut = ordsets:intersection(Reads, WritesOut), Ann1 = #{ live_in => LiveIn, live_out => LiveOut }, - ann_reads(Code, Reads1, [{Ann1, I} | Acc]); + ann_reads(Code, Reads1, [{i, Ann1, I} | Acc]); ann_reads([], Reads, Acc) -> {Acc, Reads}. %% Instruction attributes: reads, writes and purity (pure means no side-effects @@ -453,7 +463,8 @@ attributes(I) -> 'NOP' -> Pure(none, []) end. -var_writes({_, I}) -> +var_writes({i, _, I}) -> var_writes(I); +var_writes(I) -> #{ write := W } = attributes(I), case W of {var, _} -> [W]; @@ -464,7 +475,7 @@ independent({switch, _, _, _}, _) -> false; independent(_, {switch, _, _, _}) -> false; independent(switch_body, _) -> true; independent(_, switch_body) -> true; -independent({_, I}, {_, J}) -> +independent({i, _, I}, {i, _, J}) -> #{ write := WI, read := RI, pure := PureI } = attributes(I), #{ write := WJ, read := RJ, pure := PureJ } = attributes(J), @@ -486,7 +497,7 @@ merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> %% Swap two instructions. Precondition: the instructions are independent/2. swap_instrs(I, switch_body) -> {switch_body, I}; swap_instrs(switch_body, I) -> {I, switch_body}; -swap_instrs({#{ live_in := Live1 }, I}, {#{ live_in := Live2, live_out := Live3 }, J}) -> +swap_instrs({i, #{ live_in := Live1 }, I}, {i, #{ live_in := Live2, live_out := Live3 }, J}) -> %% Since I and J are independent the J can't read or write anything in %% that I writes. WritesI = ordsets:subtract(Live2, Live1), @@ -494,8 +505,8 @@ swap_instrs({#{ live_in := Live1 }, I}, {#{ live_in := Live2, live_out := Live3 #{ read := ReadsI } = attributes(I), ReadsJ = ordsets:subtract(Live2, ordsets:union(Live3, ReadsI)), Live2_ = ordsets:subtract(ordsets:union([Live1, Live2, Live3]), ordsets:union(WritesI, ReadsJ)), - {{#{ live_in => Live1, live_out => Live2_ }, J}, - {#{ live_in => Live2_, live_out => Live3 }, I}}. + {{i, #{ live_in => Live1, live_out => Live2_ }, J}, + {i, #{ live_in => Live2_, live_out => Live3 }, I}}. live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn). live_out(R, #{ live_out := LiveOut }) -> ordsets:is_element(R, LiveOut). @@ -548,33 +559,33 @@ rules() -> ]. %% Removing pushes that are immediately consumed. -r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> - {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; -r_push_consume({Ann1, {'PUSH', B}}, [{Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> - {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; -r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {'STORE', R, ?a}} | Code]) -> - {[{merge_ann(Ann1, Ann2), {'STORE', R, A}}], Code}; -r_push_consume({Ann1, {'PUSH', A}}, [{Ann2, {'POP', B}} | Code]) -> +r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> + {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; +r_push_consume({i, Ann1, {'PUSH', B}}, [{i, Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> + {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; +r_push_consume({i, Ann1, {'PUSH', A}}, [{Ann2, {'STORE', R, ?a}} | Code]) -> + {[{i, merge_ann(Ann1, Ann2), {'STORE', R, A}}], Code}; +r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {'POP', B}} | Code]) -> case live_out(B, Ann2) of - true -> {[{merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; + true -> {[{i, merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; false -> {[], Code} end; %% Writing directly to memory instead of going through the accumulator. -r_push_consume({Ann1, {Op, ?a, A, B}}, [{Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> - {[{merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; +r_push_consume({i, Ann1, {Op, ?a, A, B}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> + {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; r_push_consume(_, _) -> false. %% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations -r_dup_to_push({Ann1, Push={'PUSH', _}}, [{Ann2, 'DUPA'} | Code]) -> +r_dup_to_push({i, Ann1, Push={'PUSH', _}}, [{i, Ann2, 'DUPA'} | Code]) -> #{ live_in := LiveIn } = Ann1, Ann1_ = Ann1#{ live_out => LiveIn }, Ann2_ = Ann2#{ live_in => LiveIn }, - {[{Ann1_, Push}, {Ann2_, Push}], Code}; + {[{i, Ann1_, Push}, {i, Ann2_, Push}], Code}; r_dup_to_push(_, _) -> false. %% Move PUSH A past non-stack instructions. -r_swap_push(Push = {_, {'PUSH', _}}, [I | Code]) -> +r_swap_push(Push = {i, _, {'PUSH', _}}, [I | Code]) -> case independent(Push, I) of true -> {I1, Push1} = swap_instrs(Push, I), @@ -584,7 +595,7 @@ r_swap_push(Push = {_, {'PUSH', _}}, [I | Code]) -> r_swap_push(_, _) -> false. %% Match up writes to variables with instructions further down. -r_swap_write(I = {_, _}, [J | Code]) -> +r_swap_write(I = {i, _, _}, [J | Code]) -> case {var_writes(I), independent(I, J)} of {[_], true} -> {J1, I1} = swap_instrs(I, J), @@ -611,14 +622,14 @@ r_swap_write(Pre, I, Code0 = [J | Code]) -> r_swap_write(_, _, _) -> false. %% Inline stores -r_inline_store(I = {_, {'STORE', R = {var, _}, A = {arg, _}}}, Code) -> +r_inline_store(I = {i, _, {'STORE', R = {var, _}, A = {arg, _}}}, Code) -> %% Not when A is var unless updating the annotations properly. r_inline_store([I], R, A, Code); r_inline_store(_, _) -> false. r_inline_store(Acc, R, A, [switch_body | Code]) -> r_inline_store([switch_body | Acc], R, A, Code); -r_inline_store(Acc, R, A, [{Ann, I} | Code]) -> +r_inline_store(Acc, R, A, [{i, Ann, I} | Code]) -> #{ write := W, pure := Pure } = attributes(I), Inl = fun(X) when X == R -> A; (X) -> X end, case not live_in(R, Ann) orelse not Pure orelse lists:member(W, [R, A]) of @@ -626,18 +637,18 @@ r_inline_store(Acc, R, A, [{Ann, I} | Code]) -> false -> case I of {Op, S, B, C} when ?IsBinOp(Op), B == R orelse C == R -> - Acc1 = [{Ann, {Op, S, Inl(B), Inl(C)}} | Acc], + Acc1 = [{i, Ann, {Op, S, Inl(B), Inl(C)}} | Acc], case r_inline_store(Acc1, R, A, Code) of false -> {lists:reverse(Acc1), Code}; {New, Rest} -> {New, Rest} end; - _ -> r_inline_store([{Ann, I} | Acc], R, A, Code) + _ -> r_inline_store([{i, Ann, I} | Acc], R, A, Code) end end; r_inline_store(_Acc, _, _, _) -> false. %% Shortcut write followed by final read -r_one_shot_var({Ann1, {Op, R = {var, _}, A, B}}, [{Ann2, J} | Code]) when ?IsBinOp(Op) -> +r_one_shot_var({i, Ann1, {Op, R = {var, _}, A, B}}, [{i, Ann2, J} | Code]) when ?IsBinOp(Op) -> Copy = case J of {'PUSH', R} -> {write_to, ?a}; {'STORE', S, R} -> {write_to, S}; @@ -645,29 +656,29 @@ r_one_shot_var({Ann1, {Op, R = {var, _}, A, B}}, [{Ann2, J} | Code]) when ?IsBin end, case {live_out(R, Ann2), Copy} of {false, {write_to, X}} -> - {[{merge_ann(Ann1, Ann2), {Op, X, A, B}}], Code}; + {[{i, merge_ann(Ann1, Ann2), {Op, X, A, B}}], Code}; _ -> false end; r_one_shot_var(_, _) -> false. %% Remove writes to dead variables -r_write_to_dead_var({Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> +r_write_to_dead_var({i, Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> case live_out(R, Ann) of false -> %% Subtle: we still have to pop the stack if any of the arguments %% came from there. In this case we pop to R, which we know is %% unused. - {[{Ann, {'POP', R}} || X <- [A, B], X == ?a], Code}; + {[{i, Ann, {'POP', R}} || X <- [A, B], X == ?a], Code}; true -> false end; -r_write_to_dead_var({Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a -> +r_write_to_dead_var({i, Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a -> case live_out(R, Ann) of false -> case Code of [] -> {[], []}; [switch_body, {Ann1, I} | Code1] -> - {[], [switch_body, {merge_ann(Ann, Ann1), I} | Code1]}; - [{Ann1, I} | Code1] -> + {[], [switch_body, {i, merge_ann(Ann, Ann1), I} | Code1]}; + [{i, Ann1, I} | Code1] -> {[], [{merge_ann(Ann, Ann1), I} | Code1]} end; true -> false @@ -676,13 +687,14 @@ r_write_to_dead_var(_, _) -> false. %% Desugar and specialize and remove annotations +-spec unannotate(scode_a()) -> scode(). unannotate(switch_body) -> [switch_body]; unannotate({switch, Type, Alts, Def}) -> [{switch, Type, [unannotate(A) || A <- Alts], unannotate(Def)}]; unannotate(missing) -> missing; unannotate(Code) when is_list(Code) -> lists:flatmap(fun unannotate/1, Code); -unannotate({_Ann, I}) -> [I]. +unannotate({i, _Ann, I}) -> [I]. %% Desugar and specialize desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_code:inc()]; -- 2.30.2 From ff58ec0cba7ef7ce1cc4a38bb1de780a74756c8a Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 11:23:02 +0200 Subject: [PATCH 33/87] Remove 'if' from fcode --- src/aeso_ast_to_fcode.erl | 21 ++++++++++++--------- src/aeso_fcode_to_fate.erl | 4 ---- 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 2abccfc..b3b9854 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -32,7 +32,6 @@ | {var, var_name()} | {tuple, [fexpr()]} | {binop, ftype(), binop(), fexpr(), fexpr()} - | {'if', fexpr(), fexpr(), fexpr()} | {'let', var_name(), fexpr(), fexpr()} | {switch, fsplit()}. @@ -151,6 +150,7 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R FName = lookup_fun(Env, qname(Env, Name)), FArgs = args_to_fcode(Env, Args), FBody = expr_to_fcode(Env, Body), + %% io:format("Body of ~s\n~s\n", [Name, format_fexpr(FBody)]), Def = #{ attrs => Attrs, args => FArgs, return => type_to_fcode(Env, Ret), @@ -198,9 +198,17 @@ expr_to_fcode(Env, Type, {list, _, Es}) -> %% Conditionals expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> - {'if', expr_to_fcode(Env, Cond), - expr_to_fcode(Env, Then), - expr_to_fcode(Env, Else)}; + Switch = fun(X) -> + {switch, {split, boolean, X, + [{'case', {bool, false}, {nosplit, expr_to_fcode(Env, Else)}}, + {'case', {bool, true}, {nosplit, expr_to_fcode(Env, Then)}}]}} + end, + case Cond of + {var, X} -> Switch(X); + _ -> + X = fresh_name(), + {'let', X, expr_to_fcode(Env, Cond), Switch(X)} + end; %% Switch expr_to_fcode(Env, _, {switch, _, Expr = {typed, _, E, Type}, Alts}) -> @@ -326,7 +334,6 @@ rename(Ren, Expr) -> {var, X} -> {var, rename_var(Ren, X)}; {tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; {binop, T, Op, E1, E2} -> {binop, T, Op, rename(Ren, E1), rename(Ren, E2)}; - {'if', A, B, C} -> {'if', rename(Ren, A), rename(Ren, B), rename(Ren, C)}; {'let', X, E, Body} -> {Z, Ren1} = rename_binding(Ren, X), {'let', Z, rename(Ren, E), rename(Ren1, Body)}; @@ -538,10 +545,6 @@ pp_fexpr({tuple, Es}) -> pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); pp_fexpr({binop, _Type, Op, A, B}) -> pp_parens(prettypr:par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); -pp_fexpr({'if', A, B, C}) -> - prettypr:par([pp_beside(pp_text("if "), pp_fexpr(A)), - prettypr:nest(2, pp_beside(pp_text("then "), pp_fexpr(B))), - prettypr:nest(2, pp_beside(pp_text("else "), pp_fexpr(C)))]); pp_fexpr({'let', X, A, B}) -> prettypr:par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), pp_fexpr(B)]); diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index ce3fe21..e0e88fc 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -150,10 +150,6 @@ to_scode(Env, {binop, _Type, Op, A, B}) -> to_scode(Env, A), binop_to_scode(Op) ]; -to_scode(Env, {'if', Dec, Then, Else}) -> - [ to_scode(notail(Env), Dec), - {switch, boolean, [to_scode(Env, Else), to_scode(Env, Then)], missing} ]; - to_scode(Env, {'let', X, {var, Y}, Body}) -> Env1 = bind_var(X, lookup_var(Env, Y), Env), to_scode(Env1, Body); -- 2.30.2 From 96bff0c32f3e867a0882db065fa58e3799898e81 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 12:06:08 +0200 Subject: [PATCH 34/87] Fix dialyzer things --- src/aeso_ast_to_fcode.erl | 29 +++++++++++++++++++++-------- src/aeso_fcode_to_fate.erl | 25 ++++++++++++++----------- 2 files changed, 35 insertions(+), 19 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index b3b9854..b7c9aaa 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -14,7 +14,7 @@ %% -- Type definitions ------------------------------------------------------- --type option() :: none(). +-type option() :: term(). -type attribute() :: stateful | pure. @@ -44,8 +44,21 @@ | {tuple, [var_name()]} | {var, var_name()}. --type ftype() :: aeb_fate_data:fate_type_type(). - +-type ftype() :: integer + | boolean + | {list, ftype()} + | {map, ftype(), ftype()} + | {tuple, [ftype()]} + | address + | hash + | signature + | contract + | oracle + | oracle_query + | name + | channel + | bits + | {variant, [[ftype()]]}. -type fun_def() :: #{ attrs := [attribute()], args := [{var_name(), ftype()}], @@ -66,7 +79,7 @@ -type env() :: #{ type_env := type_env(), fun_env := fun_env(), - options := [], + options := [option()], context => context(), functions := #{ fun_name() => fun_def() } }. @@ -390,13 +403,13 @@ next_split(Pats) -> alt_to_fcode(Env, {'case', _, Pat, Expr}) -> {'case', [pat_to_fcode(Env, Pat)], expr_to_fcode(Env, Expr)}. --spec pat_to_fcode(env(), aeso_syntax:pattern()) -> fpat(). +-spec pat_to_fcode(env(), aeso_syntax:pat()) -> fpat(). pat_to_fcode(Env, {typed, _, Pat, Type}) -> pat_to_fcode(Env, type_to_fcode(Env, Type), Pat); pat_to_fcode(Env, Pat) -> pat_to_fcode(Env, no_type, Pat). --spec pat_to_fcode(env(), ftype() | no_type, aeso_syntax:pattern()) -> fpat(). +-spec pat_to_fcode(env(), ftype() | no_type, aeso_syntax:pat()) -> fpat(). pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; @@ -435,7 +448,7 @@ lookup_type(Env, Name, Args) -> Type -> Type end. --spec lookup_type(env(), sophia_name(), [ftype()], ftype()) -> ftype(). +-spec lookup_type(env(), sophia_name(), [ftype()], ftype() | A) -> ftype() | A. lookup_type(#{ type_env := TypeEnv }, Name, Args, Default) -> case maps:get(Name, TypeEnv, false) of false -> Default; @@ -444,7 +457,7 @@ lookup_type(#{ type_env := TypeEnv }, Name, Args, Default) -> %% -- Names -- --spec add_fun_env(env(), [aeso_syntax:decl()]) -> fun_env(). +-spec add_fun_env(env(), [aeso_syntax:decl()]) -> env(). add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{}; %% no functions from abstract contracts add_fun_env(Env = #{ fun_env := FunEnv }, Decls) -> Entry = fun({letfun, Ann, {id, _, Name}, _, _, _}) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index e0e88fc..46e2383 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -14,18 +14,20 @@ %% -- Preamble --------------------------------------------------------------- --type scode() :: {switch, stype(), [maybe_scode()], maybe_scode()} %% last arg is catch-all - | switch_body - | tuple(). %% FATE instruction +-type scode() :: [sinstr()]. +-type sinstr() :: {switch, stype(), [maybe_scode()], maybe_scode()} %% last arg is catch-all + | switch_body + | tuple(). %% FATE instruction %% Annotated scode --type scode_a() :: {switch, stype(), [maybe_scode_a()], maybe_scode_a()} %% last arg is catch-all - | switch_body - | {i, ann(), tuple()}. %% FATE instruction +-type scode_a() :: [sinstr_a()]. +-type sinstr_a() :: {switch, stype(), [maybe_scode_a()], maybe_scode_a()} %% last arg is catch-all + | switch_body + | {i, ann(), tuple()}. %% FATE instruction -type ann() :: #{ live_in := vars(), live_out := vars() }. -type var() :: {var, integer()}. --type vars() :: ordsets:set(var()). +-type vars() :: ordsets:ordset(var()). -type stype() :: tuple | boolean. -type maybe_scode() :: missing | scode(). @@ -612,8 +614,7 @@ r_swap_write(Pre, I, Code0 = [J | Code]) -> true -> {J1, I1} = swap_instrs(I, J), r_swap_write([J1 | Pre], I1, Code) - end; - _ -> false + end end; r_swap_write(_, _, _) -> false. @@ -683,7 +684,9 @@ r_write_to_dead_var(_, _) -> false. %% Desugar and specialize and remove annotations --spec unannotate(scode_a()) -> scode(). +-spec unannotate(scode_a()) -> scode(); + (sinstr_a()) -> sinstr(); + (missing) -> missing. unannotate(switch_body) -> [switch_body]; unannotate({switch, Type, Alts, Def}) -> [{switch, Type, [unannotate(A) || A <- Alts], unannotate(Def)}]; @@ -744,7 +747,7 @@ blocks([], Acc) -> blocks([Blk | Blocks], Acc) -> block(Blk, [], Blocks, Acc). --spec block(#blk{}, bcode(), [#blk{}], [bb()]) -> bb(). +-spec block(#blk{}, bcode(), [#blk{}], [bb()]) -> [bb()]. block(#blk{ref = Ref, code = []}, CodeAcc, Blocks, BlockAcc) -> blocks(Blocks, [{Ref, lists:reverse(CodeAcc)} | BlockAcc]); block(Blk = #blk{code = [switch_body | Code]}, Acc, Blocks, BlockAcc) -> -- 2.30.2 From 25f80da8276c57e403c2378e61be5a790d572c87 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 13:01:50 +0200 Subject: [PATCH 35/87] Remove unused argument --- src/aeso_ast_to_fcode.erl | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index b7c9aaa..6c8f27a 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -274,9 +274,8 @@ split_tree(Env, Vars, Alts = [{'case', Pats, Body} | _]) -> %% TODO: Unreachable clauses error {nosplit, rename(Ren, Body)}; I when is_integer(I) -> - Xs = [X || {X, _} <- Vars], {Vars0, [{X, Type} | Vars1]} = lists:split(I - 1, Vars), - SAlts = merge_alts(I, X, [ split_alt(Xs, I, A) || A <- Alts ]), + SAlts = merge_alts(I, X, [ split_alt(I, A) || A <- Alts ]), Cases = [ {'case', SPat, split_tree(Env, Vars0 ++ split_vars(SPat, Type) ++ Vars1, FAlts)} || {SPat, FAlts} <- SAlts ], {split, Type, X, Cases} @@ -319,16 +318,16 @@ expand(I, X, Q, {'case', Ps, E}) -> {bool, _} -> [{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]] end. --spec split_alt([var_name()], integer(), falt()) -> {fsplit_pat(), falt()}. -split_alt(Bound, I, {'case', Pats, Body}) -> +-spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}. +split_alt(I, {'case', Pats, Body}) -> {Pats0, [Pat | Pats1]} = lists:split(I - 1, Pats), - {SPat, InnerPats} = split_pat(Bound, Pat), + {SPat, InnerPats} = split_pat(Pat), {SPat, {'case', Pats0 ++ InnerPats ++ Pats1, Body}}. --spec split_pat(var_name(), fpat()) -> {fsplit_pat(), [fpat()]}. -split_pat(_Bound, P = {var, _}) -> {{var, fresh_name()}, [P]}; -split_pat(_Bound, {bool, B}) -> {{bool, B}, []}; -split_pat(_Bound, {tuple, Pats}) -> +-spec split_pat(fpat()) -> {fsplit_pat(), [fpat()]}. +split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]}; +split_pat({bool, B}) -> {{bool, B}, []}; +split_pat({tuple, Pats}) -> Xs = [fresh_name() || _ <- Pats], {{tuple, Xs}, Pats}. -- 2.30.2 From 6042294f967d353082d576aa3f8a78bbcb36d5d9 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 13:57:10 +0200 Subject: [PATCH 36/87] Compile pattern matching on integer literals --- src/aeso_ast_to_fcode.erl | 33 ++++++++++++++++++++++----------- src/aeso_fcode_to_fate.erl | 17 ++++++++++++++++- 2 files changed, 38 insertions(+), 12 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 6c8f27a..a0dda40 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -26,7 +26,7 @@ -type binop() :: '+' | '-' | '==' | '::'. --type fexpr() :: {integer, integer()} +-type fexpr() :: {int, integer()} | {bool, false | true} | nil | {var, var_name()} @@ -41,6 +41,7 @@ -type fcase() :: {'case', fsplit_pat(), fsplit()}. -type fsplit_pat() :: {bool, false | true} + | {int, integer()} | {tuple, [var_name()]} | {var, var_name()}. @@ -163,7 +164,7 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R FName = lookup_fun(Env, qname(Env, Name)), FArgs = args_to_fcode(Env, Args), FBody = expr_to_fcode(Env, Body), - %% io:format("Body of ~s\n~s\n", [Name, format_fexpr(FBody)]), + %% io:format("Body of ~s:\n~s\n", [Name, format_fexpr(FBody)]), Def = #{ attrs => Attrs, args => FArgs, return => type_to_fcode(Env, Ret), @@ -194,7 +195,7 @@ expr_to_fcode(Env, Expr) -> -spec expr_to_fcode(env(), ftype() | no_type, aeso_syntax:expr()) -> fexpr(). %% Literals -expr_to_fcode(_Env, _Type, {int, _, N}) -> {integer, N}; +expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; %% Variables @@ -259,6 +260,7 @@ alts_to_fcode(Env, Type, X, Alts) -> -type falt() :: {'case', [fpat()], fexpr()}. -type fpat() :: {var, var_name()} | {bool, false | true} + | {int, integer()} | {tuple, [fpat()]}. %% %% Invariant: the number of variables matches the number of patterns in each falt. @@ -296,6 +298,7 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> Match = fun({var, _}, {var, _}) -> match; ({tuple, _}, {tuple, _}) -> match; ({bool, B}, {bool, B}) -> match; + ({int, N}, {int, N}) -> match; ({var, _}, _) -> expand; (_, {var, _}) -> insert; (_, _) -> mismatch @@ -303,19 +306,22 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> case Match(P, Q) of match -> [{Q, [A | As]} | Rest]; mismatch -> [{Q, As} | merge_alt(I, X, {P, A}, Rest)]; - expand -> merge_alts(I, X, expand(I, X, Q, A), [{Q, As} | Rest]); + expand -> + {Before, After} = expand(I, X, P, Q, A), + merge_alts(I, X, Before, [{Q, As} | merge_alts(I, X, After, Rest)]); insert -> [{P, [A]}, {Q, As} | Rest] end. -expand(I, X, Q, {'case', Ps, E}) -> +expand(I, X, P, Q, Case = {'case', Ps, E}) -> {Ps0, [{var, Y} | Ps1]} = lists:split(I - 1, Ps), {Ps0r, Ren1} = rename_pats([{Y, X} || Y /= X], Ps0), {Ps1r, Ren2} = rename_pats(Ren1, Ps1), E1 = rename(Ren2, E), Splice = fun(Qs) -> Ps0r ++ Qs ++ Ps1r end, case Q of - {tuple, Xs} -> [{Q, {'case', Splice([{var, "_"} || _ <- Xs]), E1}}]; - {bool, _} -> [{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]] + {tuple, Xs} -> {[{Q, {'case', Splice([{var, "_"} || _ <- Xs]), E1}}], []}; + {bool, _} -> {[{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]], []}; + {int, _} -> {[{Q, {'case', Splice([]), E1}}], [{P, Case}]} end. -spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}. @@ -325,14 +331,16 @@ split_alt(I, {'case', Pats, Body}) -> {SPat, {'case', Pats0 ++ InnerPats ++ Pats1, Body}}. -spec split_pat(fpat()) -> {fsplit_pat(), [fpat()]}. -split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]}; -split_pat({bool, B}) -> {{bool, B}, []}; +split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]}; +split_pat({bool, B}) -> {{bool, B}, []}; +split_pat({int, N}) -> {{int, N}, []}; split_pat({tuple, Pats}) -> Xs = [fresh_name() || _ <- Pats], {{tuple, Xs}, Pats}. -spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}]. split_vars({bool, _}, boolean) -> []; +split_vars({int, _}, integer) -> []; split_vars({tuple, Xs}, {tuple, Ts}) -> lists:zip(Xs, Ts); split_vars({var, X}, T) -> [{X, T}]. @@ -340,7 +348,7 @@ split_vars({var, X}, T) -> [{X, T}]. -spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). rename(Ren, Expr) -> case Expr of - {integer, _} -> Expr; + {int, _} -> Expr; {bool, _} -> Expr; nil -> nil; {var, X} -> {var, rename_var(Ren, X)}; @@ -375,6 +383,7 @@ rename_pats(Ren, [P | Ps]) -> {[Q | Qs], Ren2}. rename_pat(Ren, P = {bool, _}) -> {P, Ren}; +rename_pat(Ren, P = {int, _}) -> {P, Ren}; rename_pat(Ren, {var, X}) -> {Z, Ren1} = rename_binding(Ren, X), {{var, Z}, Ren1}; @@ -414,6 +423,8 @@ pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; pat_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; +pat_to_fcode(_Env, _Type, {int, _, N}) -> + {int, N}; pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). @@ -545,7 +556,7 @@ pp_punctuate(_Sep, []) -> []; pp_punctuate(_Sep, [X]) -> [X]; pp_punctuate(Sep, [X | Xs]) -> [pp_beside(X, Sep) | pp_punctuate(Sep, Xs)]. -pp_fexpr({integer, N}) -> +pp_fexpr({int, N}) -> pp_text(N); pp_fexpr({bool, B}) -> pp_text(B); diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 46e2383..2192f70 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -131,7 +131,7 @@ lookup_var(Env = #env{ vars = Vars }, X) -> %% -- The compiler -- -to_scode(_Env, {integer, N}) -> +to_scode(_Env, {int, N}) -> [aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring to_scode(_Env, {bool, B}) -> @@ -192,9 +192,24 @@ split_to_scode(Env, {split, boolean, X, Alts}) -> SAlts = [GetAlt(false), GetAlt(true)], [aeb_fate_code:push(lookup_var(Env, X)), {switch, boolean, SAlts, Def}]; +split_to_scode(Env, {split, integer, X, Alts}) -> + {Def, Alts1} = catchall_to_scode(Env, X, Alts), + literal_split_to_scode(Env, integer, X, Alts1, Def); split_to_scode(_, Split = {split, _, _, _}) -> ?TODO({'case', Split}). +literal_split_to_scode(_Env, _Type, _X, [], Def) -> + {switch, boolean, [missing, missing], Def}; +literal_split_to_scode(Env, integer, X, [{'case', {int, N}, Body} | Alts], Def) -> + True = split_to_scode(Env, Body), + False = + case Alts of + [] -> missing; + _ -> literal_split_to_scode(Env, integer, X, Alts, missing) + end, + [aeb_fate_code:eq(?a, lookup_var(Env, X), ?i(N)), + {switch, boolean, [False, True], Def}]. + catchall_to_scode(Env, X, Alts) -> catchall_to_scode(Env, X, Alts, []). catchall_to_scode(Env, X, [{'case', {var, Y}, Split} | _], Acc) -> -- 2.30.2 From d333b5f11fe20173d65630df746c6e5774857285 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 9 Apr 2019 18:06:21 +0200 Subject: [PATCH 37/87] Compile list patterns --- src/aeso_ast_to_fcode.erl | 66 ++++++++++++++++++-------- src/aeso_fcode_to_fate.erl | 96 +++++++++++++++++++++++++++----------- 2 files changed, 115 insertions(+), 47 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index a0dda40..0ea96fa 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -40,10 +40,12 @@ -type fcase() :: {'case', fsplit_pat(), fsplit()}. --type fsplit_pat() :: {bool, false | true} +-type fsplit_pat() :: {var, var_name()} + | {bool, false | true} | {int, integer()} - | {tuple, [var_name()]} - | {var, var_name()}. + | nil + | {'::', var_name(), var_name()} + | {tuple, [var_name()]}. -type ftype() :: integer | boolean @@ -261,6 +263,7 @@ alts_to_fcode(Env, Type, X, Alts) -> -type fpat() :: {var, var_name()} | {bool, false | true} | {int, integer()} + | nil | {'::', fpat(), fpat()} | {tuple, [fpat()]}. %% %% Invariant: the number of variables matches the number of patterns in each falt. @@ -295,13 +298,15 @@ merge_alts(I, X, Alts, Alts1) -> when Alts :: [{fsplit_pat(), [falt()]}]. merge_alt(_, _, {P, A}, []) -> [{P, [A]}]; merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> - Match = fun({var, _}, {var, _}) -> match; - ({tuple, _}, {tuple, _}) -> match; - ({bool, B}, {bool, B}) -> match; - ({int, N}, {int, N}) -> match; - ({var, _}, _) -> expand; - (_, {var, _}) -> insert; - (_, _) -> mismatch + Match = fun({var, _}, {var, _}) -> match; + ({tuple, _}, {tuple, _}) -> match; + ({bool, B}, {bool, B}) -> match; + ({int, N}, {int, N}) -> match; + (nil, nil) -> match; + ({'::', _, _}, {'::', _, _}) -> match; + ({var, _}, _) -> expand; + (_, {var, _}) -> insert; + (_, _) -> mismatch end, case Match(P, Q) of match -> [{Q, [A | As]} | Rest]; @@ -317,11 +322,18 @@ expand(I, X, P, Q, Case = {'case', Ps, E}) -> {Ps0r, Ren1} = rename_pats([{Y, X} || Y /= X], Ps0), {Ps1r, Ren2} = rename_pats(Ren1, Ps1), E1 = rename(Ren2, E), - Splice = fun(Qs) -> Ps0r ++ Qs ++ Ps1r end, - case Q of - {tuple, Xs} -> {[{Q, {'case', Splice([{var, "_"} || _ <- Xs]), E1}}], []}; - {bool, _} -> {[{{bool, B}, {'case', Splice([]), E1}} || B <- [false, true]], []}; - {int, _} -> {[{Q, {'case', Splice([]), E1}}], [{P, Case}]} + Splice = fun(N) -> Ps0r ++ lists:duplicate(N, {var, "_"}) ++ Ps1r end, + Type = fun({tuple, Xs}) -> {tuple, length(Xs)}; + ({bool, _}) -> bool; + ({int, _}) -> int; + (nil) -> list; + ({'::', _, _}) -> list end, + MkCase = fun(Pat, Vars) -> {Pat, {'case', Splice(Vars), E1}} end, + case Type(Q) of + {tuple, N} -> {[MkCase(Q, N)], []}; + bool -> {[MkCase({bool, B}, 0) || B <- [false, true]], []}; + int -> {[MkCase(Q, 0)], [{P, Case}]}; + list -> {[MkCase(nil, 0), MkCase({'::', fresh_name(), fresh_name()}, 2)], []} end. -spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}. @@ -334,13 +346,17 @@ split_alt(I, {'case', Pats, Body}) -> split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]}; split_pat({bool, B}) -> {{bool, B}, []}; split_pat({int, N}) -> {{int, N}, []}; +split_pat(nil) -> {nil, []}; +split_pat({'::', P, Q}) -> {{'::', fresh_name(), fresh_name()}, [P, Q]}; split_pat({tuple, Pats}) -> Xs = [fresh_name() || _ <- Pats], {{tuple, Xs}, Pats}. -spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}]. -split_vars({bool, _}, boolean) -> []; -split_vars({int, _}, integer) -> []; +split_vars({bool, _}, boolean) -> []; +split_vars({int, _}, integer) -> []; +split_vars(nil, {list, _}) -> []; +split_vars({'::', X, Xs}, {list, T}) -> [{X, T}, {Xs, {list, T}}]; split_vars({tuple, Xs}, {tuple, Ts}) -> lists:zip(Xs, Ts); split_vars({var, X}, T) -> [{X, T}]. @@ -384,6 +400,11 @@ rename_pats(Ren, [P | Ps]) -> rename_pat(Ren, P = {bool, _}) -> {P, Ren}; rename_pat(Ren, P = {int, _}) -> {P, Ren}; +rename_pat(Ren, P = nil) -> {P, Ren}; +rename_pat(Ren, {'::', P, Q}) -> + {P1, Ren1} = rename_pat(Ren, P), + {Q1, Ren2} = rename_pat(Ren1, Q), + {{'::', P1, Q1}, Ren2}; rename_pat(Ren, {var, X}) -> {Z, Ren1} = rename_binding(Ren, X), {{var, Z}, Ren1}; @@ -425,6 +446,12 @@ pat_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; pat_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; +pat_to_fcode(Env, _Type, {list, _, Ps}) -> + lists:foldr(fun(P, Qs) -> + {'::', pat_to_fcode(Env, P), Qs} + end, nil, Ps); +pat_to_fcode(Env, _Type, {app, _, {'::', _}, [P, Q]}) -> + {'::', pat_to_fcode(Env, P), pat_to_fcode(Env, Q)}; pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). @@ -588,6 +615,7 @@ pp_case({'case', Pat, Split}) -> pp_above(pp_beside(pp_pat(Pat), pp_text(" =>")), prettypr:nest(2, pp_split(Split))). -pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); -pp_pat(Pat) -> pp_fexpr(Pat). +pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); +pp_pat({'::', X, Xs}) -> pp_fexpr({binop, list, '::', {var, X}, {var, Xs}}); +pp_pat(Pat) -> pp_fexpr(Pat). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 2192f70..2509827 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -56,6 +56,10 @@ Op =:= 'ELEMENT' orelse Op =:= 'CONS')). +-define(IsUnOp(Op), + (Op =:= 'HD' orelse + Op =:= 'TL')). + -record(env, { vars = [], locals = [], tailpos = true }). %% -- Debugging -------------------------------------------------------------- @@ -192,6 +196,24 @@ split_to_scode(Env, {split, boolean, X, Alts}) -> SAlts = [GetAlt(false), GetAlt(true)], [aeb_fate_code:push(lookup_var(Env, X)), {switch, boolean, SAlts, Def}]; +split_to_scode(Env, {split, {list, _}, X, Alts}) -> + {Def, Alts1} = catchall_to_scode(Env, X, Alts), + Arg = lookup_var(Env, X), + GetAlt = fun(P) -> + case [C || C = {'case', Pat, _} <- Alts1, Pat == P orelse is_tuple(Pat) andalso element(1, Pat) == P] of + [] -> missing; + [{'case', nil, S} | _] -> split_to_scode(Env, S); + [{'case', {'::', Y, Z}, S} | _] -> + {I, Env1} = bind_local(Y, Env), + {J, Env2} = bind_local(Z, Env1), + [aeb_fate_code:hd({var, I}, Arg), + aeb_fate_code:tl({var, J}, Arg), + split_to_scode(Env2, S)] + end + end, + SAlts = [GetAlt('::'), GetAlt(nil)], + [aeb_fate_code:is_nil(?a, Arg), + {switch, boolean, SAlts, Def}]; split_to_scode(Env, {split, integer, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), literal_split_to_scode(Env, integer, X, Alts1, Def); @@ -572,6 +594,8 @@ rules() -> ]. %% Removing pushes that are immediately consumed. +r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a}} | Code]) when ?IsUnOp(Op) -> + {[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code}; r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; r_push_consume({i, Ann1, {'PUSH', B}}, [{i, Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> @@ -584,6 +608,8 @@ r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {'POP', B}} | Code]) -> false -> {[], Code} end; %% Writing directly to memory instead of going through the accumulator. +r_push_consume({i, Ann1, {Op, ?a, A}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsUnOp(Op) -> + {[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code}; r_push_consume({i, Ann1, {Op, ?a, A, B}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; @@ -654,49 +680,63 @@ r_inline_store(Acc, R, A, [{i, Ann, I} | Code]) -> false -> {lists:reverse(Acc1), Code}; {New, Rest} -> {New, Rest} end; + {Op, S, B} when ?IsUnOp(Op), B == R -> + Acc1 = [{i, Ann, {Op, S, Inl(B)}} | Acc], + case r_inline_store(Acc1, R, A, Code) of + false -> {lists:reverse(Acc1), Code}; + {New, Rest} -> {New, Rest} + end; _ -> r_inline_store([{i, Ann, I} | Acc], R, A, Code) end end; r_inline_store(_Acc, _, _, _) -> false. %% Shortcut write followed by final read -r_one_shot_var({i, Ann1, {Op, R = {var, _}, A, B}}, [{i, Ann2, J} | Code]) when ?IsBinOp(Op) -> - Copy = case J of - {'PUSH', R} -> {write_to, ?a}; - {'STORE', S, R} -> {write_to, S}; - _ -> false - end, - case {live_out(R, Ann2), Copy} of - {false, {write_to, X}} -> - {[{i, merge_ann(Ann1, Ann2), {Op, X, A, B}}], Code}; +r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) -> + case op_view(I) of + {Op, R, As} -> + Copy = case J of + {'PUSH', R} -> {write_to, ?a}; + {'STORE', S, R} -> {write_to, S}; + _ -> false + end, + case {live_out(R, Ann2), Copy} of + {false, {write_to, X}} -> + {[{i, merge_ann(Ann1, Ann2), from_op_view({Op, X, As})}], Code}; + _ -> false + end; _ -> false end; r_one_shot_var(_, _) -> false. %% Remove writes to dead variables -r_write_to_dead_var({i, Ann, {Op, R = {var, _}, A, B}}, Code) when ?IsBinOp(Op) -> - case live_out(R, Ann) of - false -> - %% Subtle: we still have to pop the stack if any of the arguments - %% came from there. In this case we pop to R, which we know is - %% unused. - {[{i, Ann, {'POP', R}} || X <- [A, B], X == ?a], Code}; - true -> false - end; -r_write_to_dead_var({i, Ann, {'STORE', R = {var, _}, A}}, Code) when A /= ?a -> - case live_out(R, Ann) of - false -> - case Code of - [] -> {[], []}; - [switch_body, {Ann1, I} | Code1] -> - {[], [switch_body, {i, merge_ann(Ann, Ann1), I} | Code1]}; - [{i, Ann1, I} | Code1] -> - {[], [{merge_ann(Ann, Ann1), I} | Code1]} +r_write_to_dead_var({i, Ann, I}, Code) -> + case op_view(I) of + {_Op, R = {var, _}, As} -> + case live_out(R, Ann) of + false -> + %% Subtle: we still have to pop the stack if any of the arguments + %% came from there. In this case we pop to R, which we know is + %% unused. + {[{i, Ann, {'POP', R}} || X <- As, X == ?a], Code}; + true -> false end; - true -> false + _ -> false end; r_write_to_dead_var(_, _) -> false. +op_view({Op, R, A, B}) when ?IsBinOp(Op) -> + {Op, R, [A, B]}; +op_view({Op, R, A}) when ?IsUnOp(Op) -> + {Op, R, [A]}; +op_view({'STORE', R, A}) -> + {'STORE', R, [A]}; +op_view({'NIL', R}) -> + {'NIL', R, []}; +op_view(_) -> + false. + +from_op_view({Op, R, As}) -> list_to_tuple([Op, R | As]). %% Desugar and specialize and remove annotations -spec unannotate(scode_a()) -> scode(); -- 2.30.2 From bdc5e17ab7f97df0854e9500a24d751108105b42 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 11 Apr 2019 08:58:30 +0200 Subject: [PATCH 38/87] Use op_view in more places --- src/aeso_fcode_to_fate.erl | 67 ++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 39 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 2509827..1e83b73 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -10,7 +10,6 @@ -module(aeso_fcode_to_fate). -export([compile/2]). --compile([export_all, no_warn_export_all]). %% -- Preamble --------------------------------------------------------------- @@ -594,24 +593,27 @@ rules() -> ]. %% Removing pushes that are immediately consumed. -r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a}} | Code]) when ?IsUnOp(Op) -> - {[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code}; -r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {Op, R, ?a, B}} | Code]) when ?IsBinOp(Op) -> - {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; -r_push_consume({i, Ann1, {'PUSH', B}}, [{i, Ann2, {Op, R, A, ?a}} | Code]) when A /= ?a, ?IsBinOp(Op) -> - {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; -r_push_consume({i, Ann1, {'PUSH', A}}, [{Ann2, {'STORE', R, ?a}} | Code]) -> - {[{i, merge_ann(Ann1, Ann2), {'STORE', R, A}}], Code}; r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {'POP', B}} | Code]) -> case live_out(B, Ann2) of true -> {[{i, merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; false -> {[], Code} end; +r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, I} | Code]) -> + case op_view(I) of + {Op, R, As} -> + case lists:splitwith(fun(X) -> X /= ?a end, As) of + {_, []} -> false; + {As1, [?a | As2]} -> + {[{i, merge_ann(Ann1, Ann2), from_op_view(Op, R, As1 ++ [A] ++ As2)}], Code} + end; + _ -> false + end; %% Writing directly to memory instead of going through the accumulator. -r_push_consume({i, Ann1, {Op, ?a, A}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsUnOp(Op) -> - {[{i, merge_ann(Ann1, Ann2), {Op, R, A}}], Code}; -r_push_consume({i, Ann1, {Op, ?a, A, B}}, [{i, Ann2, {'STORE', R, ?a}} | Code]) when ?IsBinOp(Op) -> - {[{i, merge_ann(Ann1, Ann2), {Op, R, A, B}}], Code}; +r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) -> + case op_view(I) of + {Op, ?a, As} -> {[{i, merge_ann(Ann1, Ann2), from_op_view(Op, R, As)}], Code}; + _ -> false + end; r_push_consume(_, _) -> false. @@ -673,18 +675,17 @@ r_inline_store(Acc, R, A, [{i, Ann, I} | Code]) -> case not live_in(R, Ann) orelse not Pure orelse lists:member(W, [R, A]) of true -> false; false -> - case I of - {Op, S, B, C} when ?IsBinOp(Op), B == R orelse C == R -> - Acc1 = [{i, Ann, {Op, S, Inl(B), Inl(C)}} | Acc], - case r_inline_store(Acc1, R, A, Code) of - false -> {lists:reverse(Acc1), Code}; - {New, Rest} -> {New, Rest} - end; - {Op, S, B} when ?IsUnOp(Op), B == R -> - Acc1 = [{i, Ann, {Op, S, Inl(B)}} | Acc], - case r_inline_store(Acc1, R, A, Code) of - false -> {lists:reverse(Acc1), Code}; - {New, Rest} -> {New, Rest} + case op_view(I) of + {Op, S, As} -> + case lists:member(R, As) of + true -> + Acc1 = [{i, Ann, from_op_view(Op, S, lists:map(Inl, As))} | Acc], + case r_inline_store(Acc1, R, A, Code) of + false -> {lists:reverse(Acc1), Code}; + {_, _} = Res -> Res + end; + false -> + r_inline_store([{i, Ann, I} | Acc], R, A, Code) end; _ -> r_inline_store([{i, Ann, I} | Acc], R, A, Code) end @@ -702,7 +703,7 @@ r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) -> end, case {live_out(R, Ann2), Copy} of {false, {write_to, X}} -> - {[{i, merge_ann(Ann1, Ann2), from_op_view({Op, X, As})}], Code}; + {[{i, merge_ann(Ann1, Ann2), from_op_view(Op, X, As)}], Code}; _ -> false end; _ -> false @@ -736,7 +737,7 @@ op_view({'NIL', R}) -> op_view(_) -> false. -from_op_view({Op, R, As}) -> list_to_tuple([Op, R | As]). +from_op_view(Op, R, As) -> list_to_tuple([Op, R | As]). %% Desugar and specialize and remove annotations -spec unannotate(scode_a()) -> scode(); @@ -924,15 +925,3 @@ set_labels(_, I) -> I. with_ixs(Xs) -> lists:zip(lists:seq(0, length(Xs) - 1), Xs). -keyfind_index(X, J, Xs) -> - case [ I || {I, E} <- with_ixs(Xs), X == element(J, E) ] of - [I | _] -> I; - [] -> false - end. - -find_index(X, Xs) -> - case lists:keyfind(X, 2, with_ixs(Xs)) of - {I, _} -> I; - false -> false - end. - -- 2.30.2 From 53f88c4c06566f696728cec8d400f628ee76920f Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 11 Apr 2019 12:01:37 +0200 Subject: [PATCH 39/87] allow leaving out fields from record patterns --- src/aeso_ast_infer_types.erl | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index ed9083b..4fba745 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -98,11 +98,12 @@ -type scope() :: #scope{}. -record(env, - { scopes = #{ [] => #scope{}} :: #{ qname() => scope() } - , vars = [] :: [{name(), var_info()}] - , typevars = unrestricted :: unrestricted | [name()] - , fields = #{} :: #{ name() => [field_info()] } %% fields are global - , namespace = [] :: qname() + { scopes = #{ [] => #scope{}} :: #{ qname() => scope() } + , vars = [] :: [{name(), var_info()}] + , typevars = unrestricted :: unrestricted | [name()] + , fields = #{} :: #{ name() => [field_info()] } %% fields are global + , namespace = [] :: qname() + , in_pattern = false :: boolean() }). -type env() :: #env{}. @@ -990,7 +991,7 @@ infer_expr(Env, {record, Attrs, Fields}) -> constrain([ #record_create_constraint{ record_t = RecordType1, fields = [ FieldName || {field, _, [{proj, _, FieldName}], _} <- Fields ], - context = Attrs } ] ++ + context = Attrs } || not Env#env.in_pattern ] ++ [begin [{proj, _, FieldName}] = LV, #field_constraint{ @@ -1119,7 +1120,7 @@ infer_case(Env, Attrs, Pattern, ExprType, Branch, SwitchType) -> [] -> ok; Nonlinear -> type_error({non_linear_pattern, Pattern, lists:usort(Nonlinear)}) end, - NewEnv = bind_vars([{Var, fresh_uvar(Ann)} || Var = {id, Ann, _} <- Vars], Env), + NewEnv = bind_vars([{Var, fresh_uvar(Ann)} || Var = {id, Ann, _} <- Vars], Env#env{ in_pattern = true }), NewPattern = {typed, _, _, PatType} = infer_expr(NewEnv, Pattern), NewBranch = check_expr(NewEnv, Branch, SwitchType), unify(Env, PatType, ExprType, {case_pat, Pattern, PatType, ExprType}), -- 2.30.2 From 5c772373166afb672366c32d65d12df9a92a984e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 11 Apr 2019 12:02:01 +0200 Subject: [PATCH 40/87] compile records (patterns and construction) --- src/aeso_ast_to_fcode.erl | 108 ++++++++++++++++++++++++++++--------- src/aeso_fcode_to_fate.erl | 6 ++- 2 files changed, 87 insertions(+), 27 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 0ea96fa..6d28fa9 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -31,7 +31,8 @@ | nil | {var, var_name()} | {tuple, [fexpr()]} - | {binop, ftype(), binop(), fexpr(), fexpr()} + | {proj, fexpr(), integer()} + | {binop, binop(), fexpr(), fexpr()} | {'let', var_name(), fexpr(), fexpr()} | {switch, fsplit()}. @@ -73,7 +74,9 @@ event_type := ftype() | none, functions := #{ fun_name() => fun_def() } }. --type type_env() :: #{ sophia_name() => fun(([ftype()]) -> ftype()) }. +-type type_def() :: fun(([ftype()]) -> ftype()). + +-type type_env() :: #{ sophia_name() => type_def() }. -type fun_env() :: #{ sophia_name() => fun_name() }. -type context() :: {main_contract, string()} @@ -158,9 +161,8 @@ decls_to_fcode(Env, Decls) -> -spec decl_to_fcode(env(), aeso_syntax:decl()) -> env(). decl_to_fcode(Env, {type_decl, _, _, _}) -> Env; decl_to_fcode(Env, {fun_decl, _, _, _}) -> Env; -decl_to_fcode(Env, Decl = {type_def, _Ann, {id, _, _Name}, _Args, _Def}) -> - error({todo, Decl}), - Env; +decl_to_fcode(Env, {type_def, _Ann, Name, Args, Def}) -> + typedef_to_fcode(Env, Name, Args, Def); decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, Ret, Body}) -> Attrs = get_attributes(Ann), FName = lookup_fun(Env, qname(Env, Name)), @@ -174,6 +176,17 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R NewFuns = Funs#{ FName => Def }, Env#{ functions := NewFuns }. +-spec typedef_to_fcode(env(), aeso_syntax:id(), [aeso_syntax:tvar()], aeso_syntax:type_def()) -> env(). +typedef_to_fcode(Env, {id, _, Name}, Xs, Def) -> + Q = qname(Env, Name), + FDef = fun(Args) -> + case Def of + {record_t, Fields} -> {todo, Xs, Args, record_t, Fields}; + {variant_t, Cons} -> {todo, Xs, Args, variant_t, Cons}; + {alias_t, Type} -> {todo, Xs, Args, alias_t, Type} + end end, + bind_type(Env, Q, FDef). + -spec type_to_fcode(env(), aeso_syntax:type()) -> ftype(). type_to_fcode(Env, {app_t, _, T = {Id, _, _}, Types}) when Id == id; Id == qid -> lookup_type(Env, T, [type_to_fcode(Env, Type) || Type <- Types]); @@ -181,6 +194,9 @@ type_to_fcode(Env, T = {Id, _, _}) when Id == id; Id == qid -> lookup_type(Env, T, []); type_to_fcode(Env, {tuple_t, _, Types}) -> {tuple, [type_to_fcode(Env, T) || T <- Types]}; +type_to_fcode(Env, {record_t, Fields}) -> + FieldType = fun({field_t, _, _, Ty}) -> Ty end, + type_to_fcode(Env, {tuple_t, [], lists:map(FieldType, Fields)}); type_to_fcode(_Env, Type) -> error({todo, Type}). @@ -190,11 +206,11 @@ args_to_fcode(Env, Args) -> -spec expr_to_fcode(env(), aeso_syntax:expr()) -> fexpr(). expr_to_fcode(Env, {typed, _, Expr, Type}) -> - expr_to_fcode(Env, type_to_fcode(Env, Type), Expr); + expr_to_fcode(Env, Type, Expr); expr_to_fcode(Env, Expr) -> expr_to_fcode(Env, no_type, Expr). --spec expr_to_fcode(env(), ftype() | no_type, aeso_syntax:expr()) -> fexpr(). +-spec expr_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:expr()) -> fexpr(). %% Literals expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; @@ -207,9 +223,16 @@ expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; expr_to_fcode(Env, _Type, {tuple, _, Es}) -> {tuple, [expr_to_fcode(Env, E) || E <- Es]}; +%% Records +expr_to_fcode(Env, _Type, {proj, _Ann, Rec, X}) -> + {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)}; + +expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> + {tuple, [expr_to_fcode(Env, field_value(F, Fields)) || F <- FieldTypes]}; + %% Lists -expr_to_fcode(Env, Type, {list, _, Es}) -> - lists:foldr(fun(E, L) -> {binop, Type, '::', expr_to_fcode(Env, E), L} end, +expr_to_fcode(Env, _Type, {list, _, Es}) -> + lists:foldr(fun(E, L) -> {binop, '::', expr_to_fcode(Env, E), L} end, nil, Es); %% Conditionals @@ -244,12 +267,12 @@ expr_to_fcode(Env, _Type, {block, _, Stmts}) -> stmts_to_fcode(Env, Stmts); %% Binary operator -expr_to_fcode(Env, Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> +expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> FOp = binop_to_fcode(Op), - {binop, Type, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; + {binop, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; expr_to_fcode(_Env, Type, Expr) -> - {todo, {Expr, ':', Type}}. + error({todo, {Expr, ':', Type}}). binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. @@ -364,13 +387,14 @@ split_vars({var, X}, T) -> [{X, T}]. -spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). rename(Ren, Expr) -> case Expr of - {int, _} -> Expr; - {bool, _} -> Expr; - nil -> nil; - {var, X} -> {var, rename_var(Ren, X)}; - {tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; - {binop, T, Op, E1, E2} -> {binop, T, Op, rename(Ren, E1), rename(Ren, E2)}; - {'let', X, E, Body} -> + {int, _} -> Expr; + {bool, _} -> Expr; + nil -> nil; + {var, X} -> {var, rename_var(Ren, X)}; + {tuple, Es} -> {tuple, [rename(Ren, E) || E <- Es]}; + {proj, E, I} -> {proj, rename(Ren, E), I}; + {binop, Op, E1, E2} -> {binop, Op, rename(Ren, E1), rename(Ren, E2)}; + {'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)} @@ -434,11 +458,11 @@ alt_to_fcode(Env, {'case', _, Pat, Expr}) -> -spec pat_to_fcode(env(), aeso_syntax:pat()) -> fpat(). pat_to_fcode(Env, {typed, _, Pat, Type}) -> - pat_to_fcode(Env, type_to_fcode(Env, Type), Pat); + pat_to_fcode(Env, Type, Pat); pat_to_fcode(Env, Pat) -> pat_to_fcode(Env, no_type, Pat). --spec pat_to_fcode(env(), ftype() | no_type, aeso_syntax:pat()) -> fpat(). +-spec pat_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:pat()) -> fpat(). pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; @@ -452,7 +476,17 @@ pat_to_fcode(Env, _Type, {list, _, Ps}) -> end, nil, Ps); pat_to_fcode(Env, _Type, {app, _, {'::', _}, [P, Q]}) -> {'::', pat_to_fcode(Env, P), pat_to_fcode(Env, Q)}; -pat_to_fcode(_Env, Type, Pat) -> {todo, Pat, ':', Type}. +pat_to_fcode(Env, {record_t, Fields}, {record, _, FieldPats}) -> + FieldPat = fun(F) -> + case field_value(F, FieldPats) of + false -> {id, [], "_"}; + Pat -> Pat + end end, + {tuple, [pat_to_fcode(Env, FieldPat(Field)) + || Field <- Fields]}; + +pat_to_fcode(_Env, Type, Pat) -> + error({todo, Pat, ':', Type}). -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> @@ -492,6 +526,10 @@ lookup_type(#{ type_env := TypeEnv }, Name, Args, Default) -> Fun -> Fun(Args) end. +-spec bind_type(env(), sophia_name(), type_def()) -> env(). +bind_type(Env = #{type_env := TEnv}, Q, FDef) -> + Env#{ type_env := TEnv#{ Q => FDef } }. + %% -- Names -- -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env(). @@ -547,6 +585,22 @@ fresh_name() -> put('%fresh', N + 1), lists:concat(["%", N]). +%% -- Records -- + +field_index({typed, _, _, RecTy}, X) -> + field_index(RecTy, X); +field_index({record_t, Fields}, {id, _, X}) -> + IsX = fun({field_t, _, {id, _, Y}, _}) -> X == Y end, + [I] = [ I || {I, Field} <- indexed(Fields), IsX(Field) ], + I - 1. %% Tuples are 0-indexed + +field_value({field_t, _, {id, _, X}, _}, Fields) -> + IsX = fun({field, _, [{proj, _, {id, _, Y}}], _}) -> X == Y end, + case [E || {field, _, _, E} = F <- Fields, IsX(F)] of + [E] -> E; + [] -> false + end. + %% -- Attributes -- get_attributes(Ann) -> @@ -593,7 +647,9 @@ pp_fexpr({var, X}) -> pp_text(X); pp_fexpr({tuple, Es}) -> pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); -pp_fexpr({binop, _Type, Op, A, B}) -> +pp_fexpr({proj, E, I}) -> + pp_beside([pp_fexpr(E), pp_text("."), pp_text(I)]); +pp_fexpr({binop, Op, A, B}) -> pp_parens(prettypr:par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); pp_fexpr({'let', X, A, B}) -> prettypr:par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), @@ -612,10 +668,10 @@ pp_split({split, Type, X, Alts}) -> [prettypr:nest(2, pp_case(Alt)) || Alt <- Alts]). pp_case({'case', Pat, Split}) -> - pp_above(pp_beside(pp_pat(Pat), pp_text(" =>")), - prettypr:nest(2, pp_split(Split))). + prettypr:sep([pp_beside(pp_pat(Pat), pp_text(" =>")), + prettypr:nest(2, pp_split(Split))]). pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); -pp_pat({'::', X, Xs}) -> pp_fexpr({binop, list, '::', {var, X}, {var, Xs}}); +pp_pat({'::', X, Xs}) -> pp_fexpr({binop, '::', {var, X}, {var, Xs}}); pp_pat(Pat) -> pp_fexpr(Pat). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 1e83b73..b456aed 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -150,7 +150,11 @@ to_scode(Env, {tuple, As}) -> [[ to_scode(Env, A) || A <- As ], aeb_fate_code:tuple(N)]; -to_scode(Env, {binop, _Type, Op, A, B}) -> +to_scode(Env, {proj, E, I}) -> + [to_scode(Env, E), + aeb_fate_code:element_op(?a, ?i(I), ?a)]; + +to_scode(Env, {binop, Op, A, B}) -> [ to_scode(notail(Env), B), to_scode(Env, A), binop_to_scode(Op) ]; -- 2.30.2 From f896b84221ea5054e33a50fee06b87e7e1f66be2 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 12 Apr 2019 10:34:56 +0200 Subject: [PATCH 41/87] Compile record update --- src/aeso_ast_to_fcode.erl | 35 ++++++++++++++++++++++++++++------- 1 file changed, 28 insertions(+), 7 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 6d28fa9..c7f355d 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -228,7 +228,25 @@ expr_to_fcode(Env, _Type, {proj, _Ann, Rec, X}) -> {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)}; expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> - {tuple, [expr_to_fcode(Env, field_value(F, Fields)) || F <- FieldTypes]}; + FVal = fun(F) -> + %% All fields are present and no updates + {set, E} = field_value(F, Fields), + expr_to_fcode(Env, E) + end, + {tuple, lists:map(FVal, FieldTypes)}; + +expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> + %% TODO: update once we have a SETELEMENT instruction + X = fresh_name(), + Proj = fun(I) -> {proj, {var, X}, I - 1} end, + Comp = fun(I, FT) -> + case field_value(FT, Fields) of + false -> Proj(I); + {set, E} -> expr_to_fcode(Env, E); + {upd, Z, E} -> {'let', Z, Proj(I), expr_to_fcode(Env, E)} + end end, + {'let', X, expr_to_fcode(Env, Rec), + {tuple, [Comp(I, FT) || {I, FT} <- indexed(FieldTypes)]}}; %% Lists expr_to_fcode(Env, _Type, {list, _, Es}) -> @@ -479,8 +497,9 @@ pat_to_fcode(Env, _Type, {app, _, {'::', _}, [P, Q]}) -> pat_to_fcode(Env, {record_t, Fields}, {record, _, FieldPats}) -> FieldPat = fun(F) -> case field_value(F, FieldPats) of - false -> {id, [], "_"}; - Pat -> Pat + false -> {id, [], "_"}; + {set, Pat} -> Pat + %% {upd, _, _} is impossible in patterns end end, {tuple, [pat_to_fcode(Env, FieldPat(Field)) || Field <- Fields]}; @@ -595,10 +614,12 @@ field_index({record_t, Fields}, {id, _, X}) -> I - 1. %% Tuples are 0-indexed field_value({field_t, _, {id, _, X}, _}, Fields) -> - IsX = fun({field, _, [{proj, _, {id, _, Y}}], _}) -> X == Y end, - case [E || {field, _, _, E} = F <- Fields, IsX(F)] of - [E] -> E; - [] -> false + View = fun({field, _, [{proj, _, {id, _, Y}}], E}) -> {Y, {set, E}}; + ({field_upd, _, [{proj, _, {id, _, Y}}], + {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], E}, _}}) -> {Y, {upd, Z, E}} end, + case [Upd || {Y, Upd} <- lists:map(View, Fields), X == Y] of + [Upd] -> Upd; + [] -> false end. %% -- Attributes -- -- 2.30.2 From ed60cd8ddc6a3cb4b2f812c551b1a877030843e8 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 23 Apr 2019 12:36:14 +0200 Subject: [PATCH 42/87] Use SETELEMENT instruction --- src/aeso_ast_to_fcode.erl | 26 +++++++++++++++++--------- src/aeso_fcode_to_fate.erl | 16 +++++++++++----- 2 files changed, 28 insertions(+), 14 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index c7f355d..708406f 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -32,6 +32,7 @@ | {var, var_name()} | {tuple, [fexpr()]} | {proj, fexpr(), integer()} + | {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value | {binop, binop(), fexpr(), fexpr()} | {'let', var_name(), fexpr(), fexpr()} | {switch, fsplit()}. @@ -236,17 +237,23 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> {tuple, lists:map(FVal, FieldTypes)}; expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> - %% TODO: update once we have a SETELEMENT instruction X = fresh_name(), Proj = fun(I) -> {proj, {var, X}, I - 1} end, - Comp = fun(I, FT) -> - case field_value(FT, Fields) of - false -> Proj(I); - {set, E} -> expr_to_fcode(Env, E); - {upd, Z, E} -> {'let', Z, Proj(I), expr_to_fcode(Env, E)} - end end, - {'let', X, expr_to_fcode(Env, Rec), - {tuple, [Comp(I, FT) || {I, FT} <- indexed(FieldTypes)]}}; + Comp = fun({I, false}) -> Proj(I); + ({_, {set, E}}) -> expr_to_fcode(Env, E); + ({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(Env, E)} + end, + Set = fun({_, false}, R) -> R; + ({I, {set, E}}, R) -> {set_proj, R, I - 1, expr_to_fcode(Env, E)}; + ({I, {upd, Z, E}}, R) -> {set_proj, R, I - 1, {'let', Z, Proj(I), expr_to_fcode(Env, E)}} + end, + Expand = length(Fields) == length(FieldTypes), + Updates = [ {I, field_value(FT, Fields)} || {I, FT} <- indexed(FieldTypes) ], + Body = case Expand of + true -> {tuple, lists:map(Comp, Updates)}; + false -> lists:foldr(Set, {var, X}, Updates) + end, + {'let', X, expr_to_fcode(Env, Rec), Body}; %% Lists expr_to_fcode(Env, _Type, {list, _, Es}) -> @@ -411,6 +418,7 @@ rename(Ren, Expr) -> {var, X} -> {var, rename_var(Ren, X)}; {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)}; {binop, Op, E1, E2} -> {binop, Op, rename(Ren, E1), rename(Ren, E2)}; {'let', X, E, Body} -> {Z, Ren1} = rename_binding(Ren, X), diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index b456aed..57b57d2 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -154,6 +154,11 @@ to_scode(Env, {proj, E, I}) -> [to_scode(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), + aeb_fate_code:setelement(?a, ?i(I), ?a, ?a)]; + to_scode(Env, {binop, Op, A, B}) -> [ to_scode(notail(Env), B), to_scode(Env, A), @@ -425,6 +430,7 @@ attributes(I) -> {'NOT', A, B} -> Pure(A, B); {'TUPLE', _} -> Pure(?a, []); {'ELEMENT', A, B, C} -> Pure(A, [B, C]); + {'SETELEMENT', A, B, C, D} -> Pure(A, [B, C, D]); {'MAP_EMPTY', A} -> Pure(A, []); {'MAP_LOOKUP', A, B, C} -> Pure(A, [B, C]); {'MAP_LOOKUPD', A, B, C, D} -> Pure(A, [B, C, D]); @@ -732,12 +738,12 @@ r_write_to_dead_var(_, _) -> false. op_view({Op, R, A, B}) when ?IsBinOp(Op) -> {Op, R, [A, B]}; -op_view({Op, R, A}) when ?IsUnOp(Op) -> +op_view({Op, R, A}) when ?IsUnOp(Op); Op == 'STORE' -> {Op, R, [A]}; -op_view({'STORE', R, A}) -> - {'STORE', R, [A]}; -op_view({'NIL', R}) -> - {'NIL', R, []}; +op_view({Op, R, A, B, C}) when Op == 'SETELEMENT' -> + {Op, R, [A, B, C]}; +op_view({Op, R}) when Op == 'NIL' -> + {Op, R, []}; op_view(_) -> false. -- 2.30.2 From 9ac5a3626574de41fa47b26ec50404588e4e5ee0 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 23 Apr 2019 16:03:24 +0200 Subject: [PATCH 43/87] Compile variants --- src/aeso_ast_to_fcode.erl | 224 ++++++++++++++++++++++++++++--------- src/aeso_fcode_to_fate.erl | 88 +++++++++++---- 2 files changed, 239 insertions(+), 73 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 708406f..dfdba5d 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -30,6 +30,7 @@ | {bool, false | true} | nil | {var, var_name()} + | {con, arities(), tag(), [fexpr()]} | {tuple, [fexpr()]} | {proj, fexpr(), integer()} | {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value @@ -47,6 +48,7 @@ | {int, integer()} | nil | {'::', var_name(), var_name()} + | {con, arities(), tag(), [var_name()]} | {tuple, [var_name()]}. -type ftype() :: integer @@ -77,8 +79,15 @@ -type type_def() :: fun(([ftype()]) -> ftype()). +-type tag() :: non_neg_integer(). +-type arities() :: [non_neg_integer()]. + +-record(con_tag, { tag :: tag(), arities :: arities() }). +-type con_tag() :: #con_tag{}. + -type type_env() :: #{ sophia_name() => type_def() }. -type fun_env() :: #{ sophia_name() => fun_name() }. +-type con_env() :: #{ sophia_name() => con_tag() }. -type context() :: {main_contract, string()} | {namespace, string()} @@ -86,6 +95,7 @@ -type env() :: #{ type_env := type_env(), fun_env := fun_env(), + con_env := con_env(), options := [option()], context => context(), functions := #{ fun_name() => fun_def() } }. @@ -104,6 +114,9 @@ ast_to_fcode(Code, Options) -> init_env(Options) -> #{ type_env => init_type_env(), fun_env => #{}, %% TODO: builtin functions here? + con_env => #{["None"] => #con_tag{ tag = 0, arities = [0, 1] }, + ["Some"] => #con_tag{ tag = 1, arities = [0, 1] } + }, options => Options, functions => #{} }. @@ -181,24 +194,53 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R typedef_to_fcode(Env, {id, _, Name}, Xs, Def) -> Q = qname(Env, Name), FDef = fun(Args) -> + Sub = maps:from_list(lists:zip([X || {tvar, _, X} <- Xs], Args)), case Def of {record_t, Fields} -> {todo, Xs, Args, record_t, Fields}; - {variant_t, Cons} -> {todo, Xs, Args, variant_t, Cons}; - {alias_t, Type} -> {todo, Xs, Args, alias_t, Type} + {variant_t, Cons} -> + FCons = [ begin + {constr_t, _, _, Ts} = Con, + [type_to_fcode(Env, Sub, T) || T <- Ts] + end || Con <- Cons ], + {variant, FCons}; + {alias_t, Type} -> {todo, Xs, Args, alias_t, Type} end end, - bind_type(Env, Q, FDef). + Constructors = + case Def of + {variant_t, Cons} -> + Arities = [ begin + {constr_t, _, _, Args} = Con, + length(Args) + end || Con <- Cons ], + Tags = [ #con_tag{ tag = I, arities = Arities } || I <- lists:seq(0, length(Cons) - 1) ], + GetName = fun({constr_t, _, {con, _, C}, _}) -> C end, + QName = fun(Con) -> qname(Env, GetName(Con)) end, + maps:from_list([ {QName(Con), Tag} || {Tag, Con} <- lists:zip(Tags, Cons) ]); + _ -> #{} + end, + Env1 = bind_constructors(Env, Constructors), + bind_type(Env1, Q, FDef). -spec type_to_fcode(env(), aeso_syntax:type()) -> ftype(). -type_to_fcode(Env, {app_t, _, T = {Id, _, _}, Types}) when Id == id; Id == qid -> - lookup_type(Env, T, [type_to_fcode(Env, Type) || Type <- Types]); -type_to_fcode(Env, T = {Id, _, _}) when Id == id; Id == qid -> +type_to_fcode(Env, Type) -> + type_to_fcode(Env, #{}, Type). + +-spec type_to_fcode(env(), #{var_name() => ftype()}, aeso_syntax:type()) -> ftype(). +type_to_fcode(Env, Sub, {app_t, _, T = {Id, _, _}, Types}) when Id == id; Id == qid -> + lookup_type(Env, T, [type_to_fcode(Env, Sub, Type) || Type <- Types]); +type_to_fcode(Env, _Sub, T = {Id, _, _}) when Id == id; Id == qid -> lookup_type(Env, T, []); -type_to_fcode(Env, {tuple_t, _, Types}) -> - {tuple, [type_to_fcode(Env, T) || T <- Types]}; -type_to_fcode(Env, {record_t, Fields}) -> +type_to_fcode(Env, Sub, {tuple_t, _, Types}) -> + {tuple, [type_to_fcode(Env, Sub, T) || T <- Types]}; +type_to_fcode(Env, Sub, {record_t, Fields}) -> FieldType = fun({field_t, _, _, Ty}) -> Ty end, - type_to_fcode(Env, {tuple_t, [], lists:map(FieldType, Fields)}); -type_to_fcode(_Env, Type) -> + 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, Type) -> error({todo, Type}). -spec args_to_fcode(env(), [aeso_syntax:arg()]) -> [{var_name(), ftype()}]. @@ -220,6 +262,17 @@ expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; %% Variables expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; +%% Constructors +expr_to_fcode(Env, Type, {C, _, _} = Con) when C == con; C == qcon -> + expr_to_fcode(Env, Type, {app, [], {typed, [], Con, Type}, []}); +expr_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Args}) when C == con; C == qcon -> + #con_tag{ tag = I, arities = Arities } = lookup_con(Env, Con), + Arity = lists:nth(I + 1, Arities), + case length(Args) == Arity of + true -> {con, Arities, I, [expr_to_fcode(Env, Arg) || Arg <- Args]}; + false -> fcode_error({constructor_arity_mismatch, Con, length(Args), Arity}) + end; + %% Tuples expr_to_fcode(Env, _Type, {tuple, _, Es}) -> {tuple, [expr_to_fcode(Env, E) || E <- Es]}; @@ -312,7 +365,8 @@ alts_to_fcode(Env, Type, X, Alts) -> | {bool, false | true} | {int, integer()} | nil | {'::', fpat(), fpat()} - | {tuple, [fpat()]}. + | {tuple, [fpat()]} + | {con, arities(), tag(), [fpat()]}. %% %% Invariant: the number of variables matches the number of patterns in each falt. -spec split_tree(env(), [{var_name(), ftype()}], [falt()]) -> fsplit(). @@ -346,15 +400,17 @@ merge_alts(I, X, Alts, Alts1) -> when Alts :: [{fsplit_pat(), [falt()]}]. merge_alt(_, _, {P, A}, []) -> [{P, [A]}]; merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> - Match = fun({var, _}, {var, _}) -> match; - ({tuple, _}, {tuple, _}) -> match; - ({bool, B}, {bool, B}) -> match; - ({int, N}, {int, N}) -> match; - (nil, nil) -> match; - ({'::', _, _}, {'::', _, _}) -> match; - ({var, _}, _) -> expand; - (_, {var, _}) -> insert; - (_, _) -> mismatch + Match = fun({var, _}, {var, _}) -> match; + ({tuple, _}, {tuple, _}) -> match; + ({bool, B}, {bool, B}) -> match; + ({int, N}, {int, N}) -> match; + (nil, nil) -> match; + ({'::', _, _}, {'::', _, _}) -> match; + ({con, _, C, _}, {con, _, C, _}) -> match; + ({con, _, _, _}, {con, _, _, _}) -> mismatch; + ({var, _}, _) -> expand; + (_, {var, _}) -> insert; + (_, _) -> mismatch end, case Match(P, Q) of match -> [{Q, [A | As]} | Rest]; @@ -367,21 +423,25 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> expand(I, X, P, Q, Case = {'case', Ps, E}) -> {Ps0, [{var, Y} | Ps1]} = lists:split(I - 1, Ps), - {Ps0r, Ren1} = rename_pats([{Y, X} || Y /= X], Ps0), - {Ps1r, Ren2} = rename_pats(Ren1, Ps1), + {Ps0r, Ren1} = rename_fpats([{Y, X} || Y /= X], Ps0), + {Ps1r, Ren2} = rename_fpats(Ren1, Ps1), E1 = rename(Ren2, E), Splice = fun(N) -> Ps0r ++ lists:duplicate(N, {var, "_"}) ++ Ps1r end, - Type = fun({tuple, Xs}) -> {tuple, length(Xs)}; - ({bool, _}) -> bool; - ({int, _}) -> int; - (nil) -> list; - ({'::', _, _}) -> list end, + Type = fun({tuple, Xs}) -> {tuple, length(Xs)}; + ({bool, _}) -> bool; + ({int, _}) -> int; + (nil) -> list; + ({'::', _, _}) -> list; + ({con, As, _, _}) -> {variant, As} + end, MkCase = fun(Pat, Vars) -> {Pat, {'case', Splice(Vars), E1}} end, case Type(Q) of - {tuple, N} -> {[MkCase(Q, N)], []}; - bool -> {[MkCase({bool, B}, 0) || B <- [false, true]], []}; - int -> {[MkCase(Q, 0)], [{P, Case}]}; - list -> {[MkCase(nil, 0), MkCase({'::', fresh_name(), fresh_name()}, 2)], []} + {tuple, N} -> {[MkCase(Q, N)], []}; + bool -> {[MkCase({bool, B}, 0) || B <- [false, true]], []}; + int -> {[MkCase(Q, 0)], [{P, Case}]}; + list -> {[MkCase(nil, 0), MkCase({'::', fresh_name(), fresh_name()}, 2)], []}; + {variant, As} -> {[MkCase({con, As, C - 1, [fresh_name() || _ <- lists:seq(1, Ar)]}, Ar) + || {C, Ar} <- indexed(As)], []} end. -spec split_alt(integer(), falt()) -> {fsplit_pat(), falt()}. @@ -396,6 +456,9 @@ split_pat({bool, B}) -> {{bool, B}, []}; split_pat({int, N}) -> {{int, N}, []}; split_pat(nil) -> {nil, []}; split_pat({'::', P, Q}) -> {{'::', fresh_name(), fresh_name()}, [P, Q]}; +split_pat({con, As, I, Pats}) -> + Xs = [fresh_name() || _ <- Pats], + {{con, As, I, Xs}, Pats}; split_pat({tuple, Pats}) -> Xs = [fresh_name() || _ <- Pats], {{tuple, Xs}, Pats}. @@ -405,6 +468,8 @@ split_vars({bool, _}, boolean) -> []; split_vars({int, _}, integer) -> []; split_vars(nil, {list, _}) -> []; split_vars({'::', X, Xs}, {list, T}) -> [{X, T}, {Xs, {list, T}}]; +split_vars({con, _, I, Xs}, {variant, Cons}) -> + lists:zip(Xs, lists:nth(I + 1, Cons)); split_vars({tuple, Xs}, {tuple, Ts}) -> lists:zip(Xs, Ts); split_vars({var, X}, T) -> [{X, T}]. @@ -416,6 +481,7 @@ rename(Ren, Expr) -> {bool, _} -> Expr; nil -> nil; {var, X} -> {var, rename_var(Ren, X)}; + {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)}; @@ -442,23 +508,43 @@ rename_bindings(Ren, [X | Xs]) -> {Zs, Ren2} = rename_bindings(Ren1, Xs), {[Z | Zs], Ren2}. -rename_pats(Ren, []) -> {[], Ren}; -rename_pats(Ren, [P | Ps]) -> - {Q, Ren1} = rename_pat(Ren, P), - {Qs, Ren2} = rename_pats(Ren1, Ps), +rename_fpats(Ren, []) -> {[], Ren}; +rename_fpats(Ren, [P | Ps]) -> + {Q, Ren1} = rename_fpat(Ren, P), + {Qs, Ren2} = rename_fpats(Ren1, Ps), {[Q | Qs], Ren2}. -rename_pat(Ren, P = {bool, _}) -> {P, Ren}; -rename_pat(Ren, P = {int, _}) -> {P, Ren}; -rename_pat(Ren, P = nil) -> {P, Ren}; -rename_pat(Ren, {'::', P, Q}) -> - {P1, Ren1} = rename_pat(Ren, P), - {Q1, Ren2} = rename_pat(Ren1, Q), +rename_fpat(Ren, P = {bool, _}) -> {P, Ren}; +rename_fpat(Ren, P = {int, _}) -> {P, Ren}; +rename_fpat(Ren, P = nil) -> {P, Ren}; +rename_fpat(Ren, {'::', P, Q}) -> + {P1, Ren1} = rename_fpat(Ren, P), + {Q1, Ren2} = rename_fpat(Ren1, Q), {{'::', P1, Q1}, Ren2}; -rename_pat(Ren, {var, X}) -> +rename_fpat(Ren, {var, X}) -> {Z, Ren1} = rename_binding(Ren, X), {{var, Z}, Ren1}; -rename_pat(Ren, {tuple, Xs}) -> +rename_fpat(Ren, {con, Ar, C, Ps}) -> + {Ps1, Ren1} = rename_fpats(Ren, Ps), + {{con, Ar, C, Ps1}, Ren1}; +rename_fpat(Ren, {tuple, Ps}) -> + {Ps1, Ren1} = rename_fpats(Ren, Ps), + {{tuple, Ps1}, Ren1}. + +rename_spat(Ren, P = {bool, _}) -> {P, Ren}; +rename_spat(Ren, P = {int, _}) -> {P, Ren}; +rename_spat(Ren, P = nil) -> {P, Ren}; +rename_spat(Ren, {'::', X, Y}) -> + {X1, Ren1} = rename_binding(Ren, X), + {Y1, Ren2} = rename_binding(Ren1, Y), + {{'::', X1, Y1}, Ren2}; +rename_spat(Ren, {var, X}) -> + {Z, Ren1} = rename_binding(Ren, X), + {{var, Z}, Ren1}; +rename_spat(Ren, {con, Ar, C, Xs}) -> + {Zs, Ren1} = rename_bindings(Ren, Xs), + {{con, Ar, C, Zs}, Ren1}; +rename_spat(Ren, {tuple, Xs}) -> {Zs, Ren1} = rename_bindings(Ren, Xs), {{tuple, Zs}, Ren1}. @@ -467,7 +553,7 @@ rename_split(Ren, {split, Type, X, Cases}) -> rename_split(Ren, {nosplit, E}) -> {nosplit, rename(Ren, E)}. rename_case(Ren, {'case', Pat, Split}) -> - {Pat1, Ren1} = rename_pat(Ren, Pat), + {Pat1, Ren1} = rename_spat(Ren, Pat), {'case', Pat1, rename_split(Ren1, Split)}. -spec next_split([fpat()]) -> integer() | false. @@ -490,6 +576,11 @@ pat_to_fcode(Env, Pat) -> -spec pat_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:pat()) -> fpat(). pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; +pat_to_fcode(Env, Type, {C, _, _} = Con) when C == con; C == qcon -> + pat_to_fcode(Env, Type, {app, [], {typed, [], Con, Type}, []}); +pat_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Pats}) when C == con; C == qcon -> + #con_tag{tag = I, arities = As} = lookup_con(Env, Con), + {con, As, I, [pat_to_fcode(Env, Pat) || Pat <- Pats]}; pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; pat_to_fcode(_Env, _Type, {bool, _, B}) -> @@ -557,6 +648,10 @@ lookup_type(#{ type_env := TypeEnv }, Name, Args, Default) -> bind_type(Env = #{type_env := TEnv}, Q, FDef) -> Env#{ type_env := TEnv#{ Q => FDef } }. +-spec bind_constructors(env(), con_env()) -> env(). +bind_constructors(Env = #{ con_env := ConEnv }, NewCons) -> + Env#{ con_env := maps:merge(ConEnv, NewCons) }. + %% -- Names -- -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env(). @@ -600,6 +695,15 @@ lookup_fun(#{ fun_env := FunEnv }, Name) -> FName -> FName end. +-spec lookup_con(env(), aeso_syntax:con() | aeso_syntax:qcon() | sophia_name()) -> con_tag(). +lookup_con(Env, {con, _, Con}) -> lookup_con(Env, [Con]); +lookup_con(Env, {qcon, _, Con}) -> lookup_con(Env, Con); +lookup_con(#{ con_env := ConEnv }, Con) -> + case maps:get(Con, ConEnv, false) of + false -> error({unbound_constructor, Con}); + Tag -> Tag + end. + init_fresh_names() -> put('%fresh', 0). @@ -640,6 +744,9 @@ get_attributes(Ann) -> indexed(Xs) -> lists:zip(lists:seq(1, length(Xs)), Xs). +fcode_error(Err) -> + error(Err). + %% -- Pretty printing -------------------------------------------------------- format_fexpr(E) -> @@ -659,8 +766,8 @@ pp_above([X | Xs]) -> pp_above(X, pp_above(Xs)). pp_above(A, B) -> prettypr:above(A, B). -pp_parens(Doc) -> - pp_beside([pp_text("("), Doc, pp_text(")")]). +pp_parens(Doc) -> pp_beside([pp_text("("), Doc, pp_text(")")]). +pp_braces(Doc) -> pp_beside([pp_text("{"), Doc, pp_text("}")]). pp_punctuate(_Sep, []) -> []; pp_punctuate(_Sep, [X]) -> [X]; @@ -674,10 +781,17 @@ pp_fexpr(nil) -> pp_text("[]"); pp_fexpr({var, X}) -> pp_text(X); +pp_fexpr({con, _, I, []}) -> + pp_beside(pp_text("C"), pp_text(I)); +pp_fexpr({con, _, I, Es}) -> + pp_beside(pp_fexpr({con, [], I, []}), + pp_fexpr({tuple, Es})); pp_fexpr({tuple, Es}) -> pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); pp_fexpr({proj, E, I}) -> pp_beside([pp_fexpr(E), pp_text("."), pp_text(I)]); +pp_fexpr({set_proj, E, I, A}) -> + pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_text(I), pp_text(" = "), pp_fexpr(A)]))); pp_fexpr({binop, Op, A, B}) -> pp_parens(prettypr:par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); pp_fexpr({'let', X, A, B}) -> @@ -689,7 +803,14 @@ pp_ftype(T) when is_atom(T) -> pp_text(T); pp_ftype({tuple, Ts}) -> pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); pp_ftype({list, T}) -> - pp_beside([pp_text("list("), pp_ftype(T), pp_text(")")]). + pp_beside([pp_text("list("), pp_ftype(T), pp_text(")")]); +pp_ftype({variant, Cons}) -> + prettypr:par( + pp_punctuate(pp_text(" |"), + [ case Args of + [] -> pp_fexpr({con, [], I - 1, []}); + _ -> pp_beside(pp_fexpr({con, [], I - 1, []}), pp_ftype({tuple, Args})) + end || {I, Args} <- indexed(Cons)])). pp_split({nosplit, E}) -> pp_fexpr(E); pp_split({split, Type, X, Alts}) -> @@ -700,7 +821,8 @@ pp_case({'case', Pat, Split}) -> prettypr:sep([pp_beside(pp_pat(Pat), pp_text(" =>")), prettypr:nest(2, pp_split(Split))]). -pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); -pp_pat({'::', X, Xs}) -> pp_fexpr({binop, '::', {var, X}, {var, Xs}}); -pp_pat(Pat) -> pp_fexpr(Pat). +pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); +pp_pat({'::', X, Xs}) -> pp_fexpr({binop, '::', {var, X}, {var, Xs}}); +pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, X} || X <- Xs]}); +pp_pat(Pat) -> pp_fexpr(Pat). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 57b57d2..aa893ef 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -28,7 +28,7 @@ -type var() :: {var, integer()}. -type vars() :: ordsets:ordset(var()). --type stype() :: tuple | boolean. +-type stype() :: tuple | boolean | {variant, [non_neg_integer()]}. -type maybe_scode() :: missing | scode(). -type maybe_scode_a() :: missing | scode_a(). @@ -53,6 +53,7 @@ Op =:= 'AND' orelse Op =:= 'OR' orelse Op =:= 'ELEMENT' orelse + Op =:= 'VARIANT_ELEMENT' orelse Op =:= 'CONS')). -define(IsUnOp(Op), @@ -100,10 +101,16 @@ functions_to_scode(Functions, Options) -> function_to_scode(Name, Args, Body, ResType, Options) -> debug(scode, Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, ResType, Body]), - ArgTypes = [ T || {_, T} <- Args ], + ArgTypes = [ type_to_scode(T) || {_, T} <- Args ], SCode = to_scode(init_env(Args), Body), debug(scode, Options, " scode: ~p\n", [SCode]), - {{ArgTypes, ResType}, SCode}. + {{ArgTypes, type_to_scode(ResType)}, SCode}. + +type_to_scode({variant, Cons}) -> {variant, lists:map(fun length/1, Cons)}; +type_to_scode({list, Type}) -> {list, type_to_scode(Type)}; +type_to_scode({tuple, Types}) -> {tuple, lists:map(fun type_to_scode/1, Types)}; +type_to_scode({map, Key, Val}) -> {map, type_to_scode(Key), type_to_scode(Val)}; +type_to_scode(T) -> T. %% -- Phase I ---------------------------------------------------------------- %% Icode to structured assembly @@ -145,6 +152,11 @@ to_scode(_Env, nil) -> aeb_fate_code:nil(?a); to_scode(Env, {var, X}) -> [aeb_fate_code:push(lookup_var(Env, X))]; +to_scode(Env, {con, Ar, I, As}) -> + N = length(As), + [[to_scode(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 ], @@ -182,13 +194,14 @@ split_to_scode(Env, {nosplit, Expr}) -> [switch_body, to_scode(Env, Expr)]; split_to_scode(Env, {split, {tuple, _}, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), + Arg = lookup_var(Env, X), Alt = case [ {Xs, Split} || {'case', {tuple, Xs}, Split} <- Alts1 ] of [] -> missing; [{Xs, S} | _] -> - {Code, Env1} = match_tuple(Env, Xs), + {Code, Env1} = match_tuple(Env, Arg, Xs), [Code, split_to_scode(Env1, S)] end, - [aeb_fate_code:push(lookup_var(Env, X)), + [aeb_fate_code:push(Arg), case Def == missing andalso Alt /= missing of true -> Alt; % skip the switch if single tuple pattern false -> {switch, tuple, [Alt], Def} @@ -225,6 +238,20 @@ split_to_scode(Env, {split, {list, _}, X, Alts}) -> split_to_scode(Env, {split, integer, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), literal_split_to_scode(Env, integer, X, Alts1, Def); +split_to_scode(Env, {split, {variant, Cons}, X, Alts}) -> + {Def, Alts1} = catchall_to_scode(Env, X, Alts), + Arg = lookup_var(Env, X), + GetAlt = fun(I) -> + case [{Xs, S} || {'case', {con, _, J, Xs}, S} <- Alts1, I == J] of + [] -> missing; + [{Xs, S} | _] -> + {Code, Env1} = match_variant(Env, Arg, Xs), + [Code, split_to_scode(Env1, S)] + end + end, + SType = {variant, [length(Args) || Args <- Cons]}, + [aeb_fate_code:push(Arg), + {switch, SType, [GetAlt(I) || I <- lists:seq(0, length(Cons) - 1)], Def}]; split_to_scode(_, Split = {split, _, _, _}) -> ?TODO({'case', Split}). @@ -250,18 +277,20 @@ catchall_to_scode(Env, X, [Alt | Alts], Acc) -> catchall_to_scode(_, _, [], Acc) -> {missing, lists:reverse(Acc)}. %% Tuple is in the accumulator. Arguments are the variable names. -match_tuple(Env, Xs) -> - match_tuple(Env, 0, Xs). +match_tuple(Env, Arg, Xs) -> + match_tuple(Env, 0, fun aeb_fate_code:element_op/3, Arg, Xs). -match_tuple(Env, I, ["_" | Xs]) -> - match_tuple(Env, I + 1, Xs); -match_tuple(Env, I, [X | Xs]) -> +match_variant(Env, Arg, Xs) -> + Elem = fun(Dst, I, Val) -> aeb_fate_code:variant_element(Dst, Val, I) end, + match_tuple(Env, 0, Elem, Arg, Xs). + +match_tuple(Env, I, Elem, Arg, ["_" | Xs]) -> + match_tuple(Env, I + 1, Elem, Arg, Xs); +match_tuple(Env, I, Elem, Arg, [X | Xs]) -> {J, Env1} = bind_local(X, Env), - {Code, Env2} = match_tuple(Env1, I + 1, Xs), - {[ [aeb_fate_code:dup() || [] /= [Y || Y <- Xs, Y /= "_"]], %% Don't DUP the last one - aeb_fate_code:element_op({var, J}, ?i(I), ?a), - Code], Env2}; -match_tuple(Env, _, []) -> + {Code, Env2} = match_tuple(Env1, I + 1, Elem, Arg, Xs), + {[Elem({var, J}, ?i(I), Arg), Code], Env2}; +match_tuple(Env, _, _, _, []) -> {[], Env}. %% -- Operators -- @@ -315,8 +344,9 @@ simpl_loop(N, Code, Options) -> pp_ann(Ind, [{switch, Type, Alts, Def} | Code]) -> Tags = case Type of - boolean -> ["FALSE", "TRUE"]; - tuple -> ["(_)"] + boolean -> ["FALSE", "TRUE"]; + tuple -> ["(_)"]; + {variant, Ar} -> ["C" ++ integer_to_list(I) || I <- lists:seq(0, length(Ar) - 1)] end, [[[Ind, Tag, " =>\n", pp_ann(" " ++ Ind, Alt)] || {Tag, Alt} <- lists:zip(Tags, Alts), Alt /= missing], @@ -851,7 +881,13 @@ block(Blk = #blk{code = [{switch, Type, Alts, Default} | Code], {Blk#blk{code = ElseCode}, [{jumpif, ThenRef}], ThenBlk}; tuple -> [TCode] = Alts, - {Blk#blk{code = TCode ++ [{jump, RestRef}]}, [], []} + {Blk#blk{code = TCode ++ [{jump, RestRef}]}, [], []}; + {variant, _Ar} -> + MkBlk = fun(missing) -> {DefRef, []}; + (ACode) -> FreshBlk(ACode ++ [{jump, RestRef}], DefRef) + end, + {AltRefs, AltBs} = lists:unzip(lists:map(MkBlk, Alts)), + {Blk#blk{code = []}, [{switch, AltRefs}], lists:append(AltBs)} end, Blk2 = Blk1#blk{catchall = DefRef}, %% Update catchall ref block(Blk2, Code1 ++ Acc, DefBlk ++ RestBlk ++ AltBlks ++ Blocks, BlockAcc); @@ -883,7 +919,8 @@ reorder_blocks(Ref, Code, Blocks, Acc) -> ['RETURN'|_] -> reorder_blocks(Blocks, Acc1); [{'RETURNR', _}|_] -> reorder_blocks(Blocks, Acc1); [{'ABORT', _}|_] -> reorder_blocks(Blocks, Acc1); - [{jump, L}|_] -> + [{switch, _}|_] -> reorder_blocks(Blocks, Acc1); + [{jump, L}|_] -> NotL = fun({L1, _}) -> L1 /= L end, case lists:splitwith(NotL, Blocks) of {Blocks1, [{L, Code1} | Blocks2]} -> @@ -911,9 +948,10 @@ remove_dead_blocks(Blocks = [{Top, _} | _]) -> chase_labels([], _, Live) -> Live; chase_labels([L | Ls], Map, Live) -> Code = maps:get(L, Map), - Jump = fun({jump, A}) -> [A || not maps:is_key(A, Live)]; - ({jumpif, A}) -> [A || not maps:is_key(A, Live)]; - (_) -> [] end, + Jump = fun({jump, A}) -> [A || not maps:is_key(A, Live)]; + ({jumpif, A}) -> [A || not maps:is_key(A, Live)]; + ({switch, As}) -> [A || A <- As, not maps:is_key(A, Live)]; + (_) -> [] end, New = lists:flatmap(Jump, Code), chase_labels(New ++ Ls, Map, Live#{ L => true }). @@ -928,6 +966,12 @@ set_labels(Labels, {Ref, Code}) when is_reference(Ref) -> {maps:get(Ref, Labels), [ set_labels(Labels, I) || I <- Code ]}; set_labels(Labels, {jump, Ref}) -> aeb_fate_code:jump(maps:get(Ref, Labels)); set_labels(Labels, {jumpif, Ref}) -> aeb_fate_code:jumpif(?a, maps:get(Ref, Labels)); +set_labels(Labels, {switch, Refs}) -> + case [ maps:get(Ref, Labels) || Ref <- Refs ] of + [R1, R2] -> aeb_fate_code:switch(?a, R1, R2); + [R1, R2, R3] -> aeb_fate_code:switch(?a, R1, R2, R3); + Rs -> aeb_fate_code:switch(?a, Rs) + end; set_labels(_, I) -> I. %% -- Helpers ---------------------------------------------------------------- -- 2.30.2 From 6806554d77768985a3bea15af45f2afedb0bfd5f Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 25 Apr 2019 13:22:56 +0200 Subject: [PATCH 44/87] Remove incorrect push for tuple switches --- src/aeso_fcode_to_fate.erl | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index aa893ef..f814284 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -201,11 +201,10 @@ split_to_scode(Env, {split, {tuple, _}, X, Alts}) -> {Code, Env1} = match_tuple(Env, Arg, Xs), [Code, split_to_scode(Env1, S)] end, - [aeb_fate_code:push(Arg), - case Def == missing andalso Alt /= missing of - true -> Alt; % skip the switch if single tuple pattern - false -> {switch, tuple, [Alt], Def} - end]; + case Def == missing andalso Alt /= missing of + true -> Alt; % skip the switch if single tuple pattern + false -> [{switch, tuple, [Alt], Def}] + end; split_to_scode(Env, {split, boolean, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), GetAlt = fun(B) -> -- 2.30.2 From 960ffb383f5dbdd47396410f32b1c3c1ce466c83 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 25 Apr 2019 13:23:11 +0200 Subject: [PATCH 45/87] Optimize matching on single constructors datatypes --- src/aeso_fcode_to_fate.erl | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index f814284..dbd77d7 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -248,9 +248,19 @@ split_to_scode(Env, {split, {variant, Cons}, X, Alts}) -> [Code, split_to_scode(Env1, S)] end end, - SType = {variant, [length(Args) || Args <- Cons]}, - [aeb_fate_code:push(Arg), - {switch, SType, [GetAlt(I) || I <- lists:seq(0, length(Cons) - 1)], Def}]; + SType = {variant, [length(Args) || Args <- Cons]}, + case {[GetAlt(I) || I <- lists:seq(0, length(Cons) - 1)], Def} of + %% Skip the switch for single constructor datatypes (with no catchall) + {[SAlt], missing} when SAlt /= missing -> SAlt; + {[SAlt], _} -> + %% Single-case switches are not compiled to a SWITCH instruction, so + %% we don't need to push the argument. See [SINGLE_CON_SWITCH] + %% below. We need the scode switch to keep track of the default + %% case though. + [{switch, SType, [SAlt], Def}]; + {SAlts, _} -> + [aeb_fate_code:push(Arg), {switch, SType, SAlts, Def}] + end; split_to_scode(_, Split = {split, _, _, _}) -> ?TODO({'case', Split}). @@ -881,6 +891,11 @@ block(Blk = #blk{code = [{switch, Type, Alts, Default} | Code], tuple -> [TCode] = Alts, {Blk#blk{code = TCode ++ [{jump, RestRef}]}, [], []}; + {variant, [_]} -> + %% [SINGLE_CON_SWITCH] Single constructor switches don't need a + %% switch instruction. + [AltCode] = Alts, + {Blk#blk{code = AltCode ++ [{jump, RestRef}]}, [], []}; {variant, _Ar} -> MkBlk = fun(missing) -> {DefRef, []}; (ACode) -> FreshBlk(ACode ++ [{jump, RestRef}], DefRef) -- 2.30.2 From 0ce144db131aac95c754c1e6a463df5d87818c34 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Thu, 25 Apr 2019 13:59:35 +0200 Subject: [PATCH 46/87] Use the fact that SWITCH and JUMPIF can use args and vars --- src/aeso_fcode_to_fate.erl | 108 +++++++++++++++++++------------------ 1 file changed, 56 insertions(+), 52 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index dbd77d7..3c01923 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -14,13 +14,15 @@ %% -- Preamble --------------------------------------------------------------- -type scode() :: [sinstr()]. --type sinstr() :: {switch, stype(), [maybe_scode()], maybe_scode()} %% last arg is catch-all +-type sinstr() :: {switch, arg(), stype(), [maybe_scode()], maybe_scode()} %% last arg is catch-all | switch_body | tuple(). %% FATE instruction +-type arg() :: aeb_fate_code:fate_arg(). + %% Annotated scode -type scode_a() :: [sinstr_a()]. --type sinstr_a() :: {switch, stype(), [maybe_scode_a()], maybe_scode_a()} %% last arg is catch-all +-type sinstr_a() :: {switch, arg(), stype(), [maybe_scode_a()], maybe_scode_a()} %% last arg is catch-all | switch_body | {i, ann(), tuple()}. %% FATE instruction @@ -203,7 +205,7 @@ split_to_scode(Env, {split, {tuple, _}, X, Alts}) -> end, case Def == missing andalso Alt /= missing of true -> Alt; % skip the switch if single tuple pattern - false -> [{switch, tuple, [Alt], Def}] + false -> [{switch, Arg, tuple, [Alt], Def}] end; split_to_scode(Env, {split, boolean, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), @@ -214,8 +216,8 @@ split_to_scode(Env, {split, boolean, X, Alts}) -> end end, SAlts = [GetAlt(false), GetAlt(true)], - [aeb_fate_code:push(lookup_var(Env, X)), - {switch, boolean, SAlts, Def}]; + Arg = lookup_var(Env, X), + [{switch, Arg, boolean, SAlts, Def}]; split_to_scode(Env, {split, {list, _}, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), Arg = lookup_var(Env, X), @@ -233,10 +235,10 @@ split_to_scode(Env, {split, {list, _}, X, Alts}) -> end, SAlts = [GetAlt('::'), GetAlt(nil)], [aeb_fate_code:is_nil(?a, Arg), - {switch, boolean, SAlts, Def}]; + {switch, ?a, boolean, SAlts, Def}]; split_to_scode(Env, {split, integer, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), - literal_split_to_scode(Env, integer, X, Alts1, Def); + literal_split_to_scode(Env, integer, lookup_var(Env, X), Alts1, Def); split_to_scode(Env, {split, {variant, Cons}, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), Arg = lookup_var(Env, X), @@ -252,29 +254,22 @@ split_to_scode(Env, {split, {variant, Cons}, X, Alts}) -> case {[GetAlt(I) || I <- lists:seq(0, length(Cons) - 1)], Def} of %% Skip the switch for single constructor datatypes (with no catchall) {[SAlt], missing} when SAlt /= missing -> SAlt; - {[SAlt], _} -> - %% Single-case switches are not compiled to a SWITCH instruction, so - %% we don't need to push the argument. See [SINGLE_CON_SWITCH] - %% below. We need the scode switch to keep track of the default - %% case though. - [{switch, SType, [SAlt], Def}]; - {SAlts, _} -> - [aeb_fate_code:push(Arg), {switch, SType, SAlts, Def}] + {SAlts, _} -> [{switch, Arg, SType, SAlts, Def}] end; split_to_scode(_, Split = {split, _, _, _}) -> ?TODO({'case', Split}). -literal_split_to_scode(_Env, _Type, _X, [], Def) -> - {switch, boolean, [missing, missing], Def}; -literal_split_to_scode(Env, integer, X, [{'case', {int, N}, Body} | Alts], Def) -> +literal_split_to_scode(_Env, _Type, Arg, [], Def) -> + {switch, Arg, boolean, [missing, missing], Def}; +literal_split_to_scode(Env, integer, Arg, [{'case', {int, N}, Body} | Alts], Def) -> True = split_to_scode(Env, Body), False = case Alts of [] -> missing; - _ -> literal_split_to_scode(Env, integer, X, Alts, missing) + _ -> literal_split_to_scode(Env, integer, Arg, Alts, missing) end, - [aeb_fate_code:eq(?a, lookup_var(Env, X), ?i(N)), - {switch, boolean, [False, True], Def}]. + [aeb_fate_code:eq(?a, Arg, ?i(N)), + {switch, ?a, boolean, [False, True], Def}]. catchall_to_scode(Env, X, Alts) -> catchall_to_scode(Env, X, Alts, []). @@ -320,8 +315,8 @@ optimize_scode(Funs, Options) -> flatten(missing) -> missing; flatten(Code) -> lists:map(fun flatten_s/1, lists:flatten(Code)). -flatten_s({switch, Type, Alts, Catch}) -> - {switch, Type, [flatten(Alt) || Alt <- Alts], flatten(Catch)}; +flatten_s({switch, Arg, Type, Alts, Catch}) -> + {switch, Arg, Type, [flatten(Alt) || Alt <- Alts], flatten(Catch)}; flatten_s(I) -> I. -define(MAX_SIMPL_ITERATIONS, 10). @@ -350,16 +345,19 @@ simpl_loop(N, Code, Options) -> false -> simpl_loop(N + 1, Code2, Options) end. -pp_ann(Ind, [{switch, Type, Alts, Def} | Code]) -> +pp_ann(Ind, [{switch, Arg, Type, Alts, Def} | Code]) -> Tags = case Type of boolean -> ["FALSE", "TRUE"]; tuple -> ["(_)"]; {variant, Ar} -> ["C" ++ integer_to_list(I) || I <- lists:seq(0, length(Ar) - 1)] end, - [[[Ind, Tag, " =>\n", pp_ann(" " ++ Ind, Alt)] + Ind1 = " " ++ Ind, + Ind2 = " " ++ Ind1, + [Ind, "SWITCH ", pp_arg(Arg), "\n", + [[Ind1, Tag, " =>\n", pp_ann(Ind2, Alt)] || {Tag, Alt} <- lists:zip(Tags, Alts), Alt /= missing], - [[Ind, "_ =>\n", pp_ann(" " ++ Ind, Def)] || Def /= missing], + [[Ind1, "_ =>\n", pp_ann(" " ++ Ind, Def)] || Def /= missing], pp_ann(Ind, Code)]; pp_ann(Ind, [switch_body | Code]) -> [Ind, "SWITCH-BODY\n", pp_ann(Ind, Code)]; @@ -373,6 +371,12 @@ pp_ann(Ind, [{i, #{ live_in := In, live_out := Out }, I} | Code]) -> pp_ann(Ind, Code)]; pp_ann(_, []) -> []. + +pp_arg(?i(I)) -> io_lib:format("~w", [I]); +pp_arg({arg, N}) -> io_lib:format("arg~p", [N]); +pp_arg({var, N}) -> io_lib:format("var~p", [N]); +pp_arg(?a) -> "a". + %% -- Analysis -- annotate_code(Code) -> @@ -384,11 +388,11 @@ annotate_code(Code) -> ann_writes(missing, Writes, []) -> {missing, Writes}; ann_writes([switch_body | Code], Writes, Acc) -> ann_writes(Code, Writes, [switch_body | Acc]); -ann_writes([{switch, Type, Alts, Def} | Code], Writes, Acc) -> +ann_writes([{switch, Arg, Type, Alts, Def} | Code], Writes, Acc) -> {Alts1, WritesAlts} = lists:unzip([ ann_writes(Alt, Writes, []) || Alt <- Alts ]), {Def1, WritesDef} = ann_writes(Def, Writes, []), Writes1 = ordsets:union(Writes, ordsets:intersection([WritesDef | WritesAlts])), - ann_writes(Code, Writes1, [{switch, Type, Alts1, Def1} | Acc]); + ann_writes(Code, Writes1, [{switch, Arg, Type, Alts1, Def1} | Acc]); ann_writes([I | Code], Writes, Acc) -> Ws = var_writes(I), Writes1 = ordsets:union(Writes, Ws), @@ -401,11 +405,11 @@ ann_writes([], Writes, Acc) -> ann_reads(missing, Reads, []) -> {missing, Reads}; ann_reads([switch_body | Code], Reads, Acc) -> ann_reads(Code, Reads, [switch_body | Acc]); -ann_reads([{switch, Type, Alts, Def} | Code], Reads, Acc) -> +ann_reads([{switch, Arg, Type, Alts, Def} | Code], Reads, Acc) -> {Alts1, ReadsAlts} = lists:unzip([ ann_reads(Alt, Reads, []) || Alt <- Alts ]), {Def1, ReadsDef} = ann_reads(Def, Reads, []), - Reads1 = ordsets:union([Reads, ReadsDef | ReadsAlts]), - ann_reads(Code, Reads1, [{switch, Type, Alts1, Def1} | Acc]); + Reads1 = ordsets:union([[Arg], Reads, ReadsDef | ReadsAlts]), + ann_reads(Code, Reads1, [{switch, Arg, Type, Alts1, Def1} | Acc]); ann_reads([{i, Ann, I} | Code], Reads, Acc) -> #{ writes_in := WritesIn, writes_out := WritesOut } = Ann, #{ read := Rs, write := W, pure := Pure } = attributes(I), @@ -554,8 +558,8 @@ var_writes(I) -> _ -> [] end. -independent({switch, _, _, _}, _) -> false; -independent(_, {switch, _, _, _}) -> false; +independent({switch, _, _, _, _}, _) -> false; +independent(_, {switch, _, _, _, _}) -> false; independent(switch_body, _) -> true; independent(_, switch_body) -> true; independent({i, _, I}, {i, _, J}) -> @@ -601,8 +605,8 @@ simplify(missing, _) -> missing; simplify([I | Code], Options) -> simpl_top(simpl_s(I, Options), simplify(Code, Options), Options). -simpl_s({switch, Type, Alts, Def}, Options) -> - {switch, Type, [simplify(A, Options) || A <- Alts], simplify(Def, Options)}; +simpl_s({switch, Arg, Type, Alts, Def}, Options) -> + {switch, Arg, Type, [simplify(A, Options) || A <- Alts], simplify(Def, Options)}; simpl_s(I, _) -> I. simpl_top(I, Code, Options) -> @@ -793,8 +797,8 @@ from_op_view(Op, R, As) -> list_to_tuple([Op, R | As]). (sinstr_a()) -> sinstr(); (missing) -> missing. unannotate(switch_body) -> [switch_body]; -unannotate({switch, Type, Alts, Def}) -> - [{switch, Type, [unannotate(A) || A <- Alts], unannotate(Def)}]; +unannotate({switch, Arg, Type, Alts, Def}) -> + [{switch, Arg, Type, [unannotate(A) || A <- Alts], unannotate(Def)}]; unannotate(missing) -> missing; unannotate(Code) when is_list(Code) -> lists:flatmap(fun unannotate/1, Code); @@ -803,8 +807,8 @@ unannotate({i, _Ann, I}) -> [I]. %% Desugar and specialize desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_code:inc()]; desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_code:dec()]; -desugar({switch, Type, Alts, Def}) -> - [{switch, Type, [desugar(A) || A <- Alts], desugar(Def)}]; +desugar({switch, Arg, Type, Alts, Def}) -> + [{switch, Arg, Type, [desugar(A) || A <- Alts], desugar(Def)}]; desugar(missing) -> missing; desugar(Code) when is_list(Code) -> lists:flatmap(fun desugar/1, Code); @@ -858,7 +862,7 @@ block(#blk{ref = Ref, code = []}, CodeAcc, Blocks, BlockAcc) -> block(Blk = #blk{code = [switch_body | Code]}, Acc, Blocks, BlockAcc) -> %% Reached the body of a switch. Clear catchall ref. block(Blk#blk{code = Code, catchall = none}, Acc, Blocks, BlockAcc); -block(Blk = #blk{code = [{switch, Type, Alts, Default} | Code], +block(Blk = #blk{code = [{switch, Arg, Type, Alts, Default} | Code], catchall = Catchall}, Acc, Blocks, BlockAcc) -> FreshBlk = fun(C, Ca) -> R = make_ref(), @@ -887,7 +891,7 @@ block(Blk = #blk{code = [{switch, Type, Alts, Default} | Code], missing -> [{jump, DefRef}]; _ -> FalseCode ++ [{jump, RestRef}] end, - {Blk#blk{code = ElseCode}, [{jumpif, ThenRef}], ThenBlk}; + {Blk#blk{code = ElseCode}, [{jumpif, Arg, ThenRef}], ThenBlk}; tuple -> [TCode] = Alts, {Blk#blk{code = TCode ++ [{jump, RestRef}]}, [], []}; @@ -901,7 +905,7 @@ block(Blk = #blk{code = [{switch, Type, Alts, Default} | Code], (ACode) -> FreshBlk(ACode ++ [{jump, RestRef}], DefRef) end, {AltRefs, AltBs} = lists:unzip(lists:map(MkBlk, Alts)), - {Blk#blk{code = []}, [{switch, AltRefs}], lists:append(AltBs)} + {Blk#blk{code = []}, [{switch, Arg, AltRefs}], lists:append(AltBs)} end, Blk2 = Blk1#blk{catchall = DefRef}, %% Update catchall ref block(Blk2, Code1 ++ Acc, DefBlk ++ RestBlk ++ AltBlks ++ Blocks, BlockAcc); @@ -933,7 +937,7 @@ reorder_blocks(Ref, Code, Blocks, Acc) -> ['RETURN'|_] -> reorder_blocks(Blocks, Acc1); [{'RETURNR', _}|_] -> reorder_blocks(Blocks, Acc1); [{'ABORT', _}|_] -> reorder_blocks(Blocks, Acc1); - [{switch, _}|_] -> reorder_blocks(Blocks, Acc1); + [{switch, _, _}|_] -> reorder_blocks(Blocks, Acc1); [{jump, L}|_] -> NotL = fun({L1, _}) -> L1 /= L end, case lists:splitwith(NotL, Blocks) of @@ -962,10 +966,10 @@ remove_dead_blocks(Blocks = [{Top, _} | _]) -> chase_labels([], _, Live) -> Live; chase_labels([L | Ls], Map, Live) -> Code = maps:get(L, Map), - Jump = fun({jump, A}) -> [A || not maps:is_key(A, Live)]; - ({jumpif, A}) -> [A || not maps:is_key(A, Live)]; - ({switch, As}) -> [A || A <- As, not maps:is_key(A, Live)]; - (_) -> [] end, + Jump = fun({jump, A}) -> [A || not maps:is_key(A, Live)]; + ({jumpif, _, A}) -> [A || not maps:is_key(A, Live)]; + ({switch, _, As}) -> [A || A <- As, not maps:is_key(A, Live)]; + (_) -> [] end, New = lists:flatmap(Jump, Code), chase_labels(New ++ Ls, Map, Live#{ L => true }). @@ -979,12 +983,12 @@ use_returnr(Code) -> Code. set_labels(Labels, {Ref, Code}) when is_reference(Ref) -> {maps:get(Ref, Labels), [ set_labels(Labels, I) || I <- Code ]}; set_labels(Labels, {jump, Ref}) -> aeb_fate_code:jump(maps:get(Ref, Labels)); -set_labels(Labels, {jumpif, Ref}) -> aeb_fate_code:jumpif(?a, maps:get(Ref, Labels)); -set_labels(Labels, {switch, Refs}) -> +set_labels(Labels, {jumpif, Arg, Ref}) -> aeb_fate_code:jumpif(Arg, maps:get(Ref, Labels)); +set_labels(Labels, {switch, Arg, Refs}) -> case [ maps:get(Ref, Labels) || Ref <- Refs ] of - [R1, R2] -> aeb_fate_code:switch(?a, R1, R2); - [R1, R2, R3] -> aeb_fate_code:switch(?a, R1, R2, R3); - Rs -> aeb_fate_code:switch(?a, Rs) + [R1, R2] -> aeb_fate_code:switch(Arg, R1, R2); + [R1, R2, R3] -> aeb_fate_code:switch(Arg, R1, R2, R3); + Rs -> aeb_fate_code:switch(Arg, Rs) end; set_labels(_, I) -> I. -- 2.30.2 From b7153b1d75c61c1c0bcbfaa49b09b7ec190834e6 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 10:34:38 +0200 Subject: [PATCH 47/87] string literals and pattern matching on the same --- src/aeso_ast_to_fcode.erl | 57 ++++++++++++++++++++++++++------------ src/aeso_fcode_to_fate.erl | 19 +++++++++---- 2 files changed, 52 insertions(+), 24 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index dfdba5d..820b2cc 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -27,6 +27,7 @@ -type binop() :: '+' | '-' | '==' | '::'. -type fexpr() :: {int, integer()} + | {string, binary()} | {bool, false | true} | nil | {var, var_name()} @@ -46,6 +47,7 @@ -type fsplit_pat() :: {var, var_name()} | {bool, false | true} | {int, integer()} + | {string, binary()} | nil | {'::', var_name(), var_name()} | {con, arities(), tag(), [var_name()]} @@ -256,8 +258,9 @@ expr_to_fcode(Env, Expr) -> -spec expr_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:expr()) -> fexpr(). %% Literals -expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; -expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; +expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; +expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; +expr_to_fcode(_Env, _Type, {string, _, S}) -> {string, S}; %% Variables expr_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; @@ -364,6 +367,7 @@ alts_to_fcode(Env, Type, X, Alts) -> -type fpat() :: {var, var_name()} | {bool, false | true} | {int, integer()} + | {string, binary()} | nil | {'::', fpat(), fpat()} | {tuple, [fpat()]} | {con, arities(), tag(), [fpat()]}. @@ -404,6 +408,7 @@ merge_alt(I, X, {P, A}, [{Q, As} | Rest]) -> ({tuple, _}, {tuple, _}) -> match; ({bool, B}, {bool, B}) -> match; ({int, N}, {int, N}) -> match; + ({string, S}, {string, S}) -> match; (nil, nil) -> match; ({'::', _, _}, {'::', _, _}) -> match; ({con, _, C, _}, {con, _, C, _}) -> match; @@ -430,6 +435,7 @@ expand(I, X, P, Q, Case = {'case', Ps, E}) -> Type = fun({tuple, Xs}) -> {tuple, length(Xs)}; ({bool, _}) -> bool; ({int, _}) -> int; + ({string, _}) -> string; (nil) -> list; ({'::', _, _}) -> list; ({con, As, _, _}) -> {variant, As} @@ -439,6 +445,7 @@ expand(I, X, P, Q, Case = {'case', Ps, E}) -> {tuple, N} -> {[MkCase(Q, N)], []}; bool -> {[MkCase({bool, B}, 0) || B <- [false, true]], []}; int -> {[MkCase(Q, 0)], [{P, Case}]}; + string -> {[MkCase(Q, 0)], [{P, Case}]}; list -> {[MkCase(nil, 0), MkCase({'::', fresh_name(), fresh_name()}, 2)], []}; {variant, As} -> {[MkCase({con, As, C - 1, [fresh_name() || _ <- lists:seq(1, Ar)]}, Ar) || {C, Ar} <- indexed(As)], []} @@ -454,6 +461,7 @@ split_alt(I, {'case', Pats, Body}) -> split_pat(P = {var, _}) -> {{var, fresh_name()}, [P]}; split_pat({bool, B}) -> {{bool, B}, []}; split_pat({int, N}) -> {{int, N}, []}; +split_pat({string, N}) -> {{string, N}, []}; split_pat(nil) -> {nil, []}; split_pat({'::', P, Q}) -> {{'::', fresh_name(), fresh_name()}, [P, Q]}; split_pat({con, As, I, Pats}) -> @@ -464,9 +472,10 @@ split_pat({tuple, Pats}) -> {{tuple, Xs}, Pats}. -spec split_vars(fsplit_pat(), ftype()) -> [{var_name(), ftype()}]. -split_vars({bool, _}, boolean) -> []; -split_vars({int, _}, integer) -> []; -split_vars(nil, {list, _}) -> []; +split_vars({bool, _}, boolean) -> []; +split_vars({int, _}, integer) -> []; +split_vars({string, _}, string) -> []; +split_vars(nil, {list, _}) -> []; split_vars({'::', X, Xs}, {list, T}) -> [{X, T}, {Xs, {list, T}}]; split_vars({con, _, I, Xs}, {variant, Cons}) -> lists:zip(Xs, lists:nth(I + 1, Cons)); @@ -478,6 +487,7 @@ split_vars({var, X}, T) -> [{X, T}]. rename(Ren, Expr) -> case Expr of {int, _} -> Expr; + {string, _} -> Expr; {bool, _} -> Expr; nil -> nil; {var, X} -> {var, rename_var(Ren, X)}; @@ -514,10 +524,11 @@ rename_fpats(Ren, [P | Ps]) -> {Qs, Ren2} = rename_fpats(Ren1, Ps), {[Q | Qs], Ren2}. -rename_fpat(Ren, P = {bool, _}) -> {P, Ren}; -rename_fpat(Ren, P = {int, _}) -> {P, Ren}; -rename_fpat(Ren, P = nil) -> {P, Ren}; -rename_fpat(Ren, {'::', P, Q}) -> +rename_fpat(Ren, P = {bool, _}) -> {P, Ren}; +rename_fpat(Ren, P = {int, _}) -> {P, Ren}; +rename_fpat(Ren, P = {string, _}) -> {P, Ren}; +rename_fpat(Ren, P = nil) -> {P, Ren}; +rename_fpat(Ren, {'::', P, Q}) -> {P1, Ren1} = rename_fpat(Ren, P), {Q1, Ren2} = rename_fpat(Ren1, Q), {{'::', P1, Q1}, Ren2}; @@ -531,9 +542,10 @@ rename_fpat(Ren, {tuple, Ps}) -> {Ps1, Ren1} = rename_fpats(Ren, Ps), {{tuple, Ps1}, Ren1}. -rename_spat(Ren, P = {bool, _}) -> {P, Ren}; -rename_spat(Ren, P = {int, _}) -> {P, Ren}; -rename_spat(Ren, P = nil) -> {P, Ren}; +rename_spat(Ren, P = {bool, _}) -> {P, Ren}; +rename_spat(Ren, P = {int, _}) -> {P, Ren}; +rename_spat(Ren, P = {string, _}) -> {P, Ren}; +rename_spat(Ren, P = nil) -> {P, Ren}; rename_spat(Ren, {'::', X, Y}) -> {X1, Ren1} = rename_binding(Ren, X), {Y1, Ren2} = rename_binding(Ren1, Y), @@ -587,6 +599,8 @@ pat_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; pat_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; +pat_to_fcode(_Env, _Type, {string, _, N}) -> + {string, N}; pat_to_fcode(Env, _Type, {list, _, Ps}) -> lists:foldr(fun(P, Qs) -> {'::', pat_to_fcode(Env, P), Qs} @@ -752,6 +766,8 @@ fcode_error(Err) -> format_fexpr(E) -> prettypr:format(pp_fexpr(E)). +pp_text(<<>>) -> prettypr:text("\"\""); +pp_text(Bin) when is_binary(Bin) -> prettypr:text(lists:flatten(io_lib:format("~p", [binary_to_list(Bin)]))); pp_text(S) -> prettypr:text(lists:concat([S])). pp_beside([]) -> prettypr:empty(); @@ -773,8 +789,13 @@ pp_punctuate(_Sep, []) -> []; pp_punctuate(_Sep, [X]) -> [X]; pp_punctuate(Sep, [X | Xs]) -> [pp_beside(X, Sep) | pp_punctuate(Sep, Xs)]. +pp_par([]) -> prettypr:empty(); +pp_par(Xs) -> prettypr:par(Xs). + pp_fexpr({int, N}) -> pp_text(N); +pp_fexpr({string, S}) -> + pp_text(S); pp_fexpr({bool, B}) -> pp_text(B); pp_fexpr(nil) -> @@ -787,25 +808,25 @@ pp_fexpr({con, _, I, Es}) -> pp_beside(pp_fexpr({con, [], I, []}), pp_fexpr({tuple, Es})); pp_fexpr({tuple, Es}) -> - pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); + pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); pp_fexpr({proj, E, I}) -> pp_beside([pp_fexpr(E), pp_text("."), pp_text(I)]); pp_fexpr({set_proj, E, I, A}) -> pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_text(I), pp_text(" = "), pp_fexpr(A)]))); pp_fexpr({binop, Op, A, B}) -> - pp_parens(prettypr:par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); + pp_parens(pp_par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); pp_fexpr({'let', X, A, B}) -> - prettypr:par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), - pp_fexpr(B)]); + pp_par([pp_beside([pp_text("let "), pp_text(X), pp_text(" = "), pp_fexpr(A), pp_text(" in")]), + pp_fexpr(B)]); pp_fexpr({switch, Split}) -> pp_split(Split). pp_ftype(T) when is_atom(T) -> pp_text(T); pp_ftype({tuple, Ts}) -> - pp_parens(prettypr:par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); + pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); pp_ftype({list, T}) -> pp_beside([pp_text("list("), pp_ftype(T), pp_text(")")]); pp_ftype({variant, Cons}) -> - prettypr:par( + pp_par( pp_punctuate(pp_text(" |"), [ case Args of [] -> pp_fexpr({con, [], I - 1, []}); diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 3c01923..37978de 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -144,7 +144,10 @@ lookup_var(Env = #env{ vars = Vars }, X) -> %% -- The compiler -- to_scode(_Env, {int, N}) -> - [aeb_fate_code:push(?i(N))]; %% Doesn't exist (yet), translated by desugaring + [aeb_fate_code:push(?i(N))]; + +to_scode(_Env, {string, S}) -> + [aeb_fate_code:push(?i(aeb_fate_data:make_string(S)))]; to_scode(_Env, {bool, B}) -> [aeb_fate_code:push(?i(B))]; @@ -236,9 +239,9 @@ split_to_scode(Env, {split, {list, _}, X, Alts}) -> SAlts = [GetAlt('::'), GetAlt(nil)], [aeb_fate_code:is_nil(?a, Arg), {switch, ?a, boolean, SAlts, Def}]; -split_to_scode(Env, {split, integer, X, Alts}) -> +split_to_scode(Env, {split, Type, X, Alts}) when Type == integer; Type == string -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), - literal_split_to_scode(Env, integer, lookup_var(Env, X), Alts1, Def); + literal_split_to_scode(Env, Type, lookup_var(Env, X), Alts1, Def); split_to_scode(Env, {split, {variant, Cons}, X, Alts}) -> {Def, Alts1} = catchall_to_scode(Env, X, Alts), Arg = lookup_var(Env, X), @@ -261,14 +264,18 @@ split_to_scode(_, Split = {split, _, _, _}) -> literal_split_to_scode(_Env, _Type, Arg, [], Def) -> {switch, Arg, boolean, [missing, missing], Def}; -literal_split_to_scode(Env, integer, Arg, [{'case', {int, N}, Body} | Alts], Def) -> +literal_split_to_scode(Env, Type, Arg, [{'case', Lit, Body} | Alts], Def) when Type == integer; Type == string -> True = split_to_scode(Env, Body), False = case Alts of [] -> missing; - _ -> literal_split_to_scode(Env, integer, Arg, Alts, missing) + _ -> literal_split_to_scode(Env, Type, Arg, Alts, missing) end, - [aeb_fate_code:eq(?a, Arg, ?i(N)), + SLit = case Lit of + {int, N} -> N; + {string, S} -> aeb_fate_data:make_string(S) + end, + [aeb_fate_code:eq(?a, Arg, ?i(SLit)), {switch, ?a, boolean, [False, True], Def}]. catchall_to_scode(Env, X, Alts) -> catchall_to_scode(Env, X, Alts, []). -- 2.30.2 From 3c6e06e99a7e5cbc5c49ad7851a10915f6de475c Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 11:09:59 +0200 Subject: [PATCH 48/87] Compile character literals --- src/aeso_ast_infer_types.erl | 6 +++++- src/aeso_ast_to_fcode.erl | 12 ++++++------ 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 4fba745..324def0 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -379,7 +379,7 @@ global_env() -> %% Abort {"abort", Fun1(String, A)}]) , types = MkDefs( - [{"int", 0}, {"bool", 0}, {"string", 0}, {"address", 0}, + [{"int", 0}, {"bool", 0}, {"char", 0}, {"string", 0}, {"address", 0}, {"hash", {[], {alias_t, Bytes(32)}}}, {"signature", {[], {alias_t, Bytes(64)}}}, {"bits", 0}, @@ -909,6 +909,8 @@ infer_expr(_Env, Body={bool, As, _}) -> {typed, As, Body, {id, As, "bool"}}; infer_expr(_Env, Body={int, As, _}) -> {typed, As, Body, {id, As, "int"}}; +infer_expr(_Env, Body={char, As, _}) -> + {typed, As, Body, {id, As, "char"}}; infer_expr(_Env, Body={string, As, _}) -> {typed, As, Body, {id, As, "string"}}; infer_expr(_Env, Body={bytes, As, Bin}) -> @@ -1179,6 +1181,8 @@ infer_prefix({IntOp,As}) when IntOp =:= '-' -> free_vars({int, _, _}) -> []; +free_vars({char, _, _}) -> + []; free_vars({string, _, _}) -> []; free_vars({bool, _, _}) -> diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 820b2cc..820d4c4 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -131,6 +131,7 @@ init_type_env() -> #{ ["int"] => ?type(integer), ["bool"] => ?type(boolean), ["bits"] => ?type(bits), + ["char"] => ?type(integer), ["string"] => ?type(string), ["address"] => ?type(address), ["hash"] => ?type(hash), @@ -259,6 +260,7 @@ expr_to_fcode(Env, Expr) -> %% Literals expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; +expr_to_fcode(_Env, _Type, {char, _, N}) -> {int, N}; expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; expr_to_fcode(_Env, _Type, {string, _, S}) -> {string, S}; @@ -595,12 +597,10 @@ pat_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Pats}) when C {con, As, I, [pat_to_fcode(Env, Pat) || Pat <- Pats]}; pat_to_fcode(Env, _Type, {tuple, _, Pats}) -> {tuple, [ pat_to_fcode(Env, Pat) || Pat <- Pats ]}; -pat_to_fcode(_Env, _Type, {bool, _, B}) -> - {bool, B}; -pat_to_fcode(_Env, _Type, {int, _, N}) -> - {int, N}; -pat_to_fcode(_Env, _Type, {string, _, N}) -> - {string, N}; +pat_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; +pat_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; +pat_to_fcode(_Env, _Type, {char, _, N}) -> {int, N}; +pat_to_fcode(_Env, _Type, {string, _, N}) -> {string, N}; pat_to_fcode(Env, _Type, {list, _, Ps}) -> lists:foldr(fun(P, Qs) -> {'::', pat_to_fcode(Env, P), Qs} -- 2.30.2 From c419b105bf3d5b7a3b312c78fc057fc5690edd73 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 12:16:17 +0200 Subject: [PATCH 49/87] Minor refactoring of op instruction handling --- src/aeso_fcode_to_fate.erl | 87 ++++++++++++++++++++++++-------------- 1 file changed, 56 insertions(+), 31 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 37978de..46d1c80 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -39,28 +39,56 @@ -define(i(X), {immediate, X}). -define(a, {stack, 0}). --define(IsBinOp(Op), - (Op =:= 'ADD' orelse - Op =:= 'SUB' orelse - Op =:= 'MUL' orelse - Op =:= 'DIV' orelse - Op =:= 'MOD' orelse - Op =:= 'POW' orelse - Op =:= 'LT' orelse - Op =:= 'GT' orelse - Op =:= 'EQ' orelse - Op =:= 'ELT' orelse - Op =:= 'EGT' orelse - Op =:= 'NEQ' orelse - Op =:= 'AND' orelse - Op =:= 'OR' orelse - Op =:= 'ELEMENT' orelse +-define(IsOp(Op), ( + Op =:= 'STORE' orelse + Op =:= 'ADD' orelse + Op =:= 'SUB' orelse + Op =:= 'MUL' orelse + Op =:= 'DIV' orelse + Op =:= 'MOD' orelse + Op =:= 'POW' orelse + Op =:= 'LT' orelse + Op =:= 'GT' orelse + Op =:= 'EQ' orelse + Op =:= 'ELT' orelse + Op =:= 'EGT' orelse + Op =:= 'NEQ' orelse + Op =:= 'AND' orelse + Op =:= 'OR' orelse + Op =:= 'NOT' orelse + Op =:= 'ELEMENT' orelse + Op =:= 'MAP_EMPTY' orelse + Op =:= 'MAP_LOOKUP' orelse + Op =:= 'MAP_LOOKUPD' orelse + Op =:= 'MAP_UPDATE' orelse + Op =:= 'MAP_DELETE' orelse + Op =:= 'MAP_MEMBER' orelse + Op =:= 'MAP_FROM_LIST' orelse + Op =:= 'NIL' orelse + Op =:= 'IS_NIL' orelse + Op =:= 'CONS' orelse + Op =:= 'HD' orelse + Op =:= 'TL' orelse + Op =:= 'LENGTH' orelse + Op =:= 'STR_EQ' orelse + Op =:= 'STR_JOIN' orelse + Op =:= 'INT_TO_STR' orelse + Op =:= 'ADDR_TO_STR' orelse + Op =:= 'STR_REVERSE' orelse + Op =:= 'INT_TO_ADDR' orelse + Op =:= 'VARIANT_TEST' orelse Op =:= 'VARIANT_ELEMENT' orelse - Op =:= 'CONS')). - --define(IsUnOp(Op), - (Op =:= 'HD' orelse - Op =:= 'TL')). + Op =:= 'BITS_NONE' orelse + Op =:= 'BITS_ALL' orelse + Op =:= 'BITS_ALL_N' orelse + Op =:= 'BITS_SET' orelse + Op =:= 'BITS_CLEAR' orelse + Op =:= 'BITS_TEST' orelse + Op =:= 'BITS_SUM' orelse + Op =:= 'BITS_OR' orelse + Op =:= 'BITS_AND' orelse + Op =:= 'BITS_DIFF' orelse + false)). -record(env, { vars = [], locals = [], tailpos = true }). @@ -786,16 +814,13 @@ r_write_to_dead_var({i, Ann, I}, Code) -> end; r_write_to_dead_var(_, _) -> false. -op_view({Op, R, A, B}) when ?IsBinOp(Op) -> - {Op, R, [A, B]}; -op_view({Op, R, A}) when ?IsUnOp(Op); Op == 'STORE' -> - {Op, R, [A]}; -op_view({Op, R, A, B, C}) when Op == 'SETELEMENT' -> - {Op, R, [A, B, C]}; -op_view({Op, R}) when Op == 'NIL' -> - {Op, R, []}; -op_view(_) -> - false. +op_view(T) when is_tuple(T) -> + case tuple_to_list(T) of + [Op, R | As] when ?IsOp(Op) -> + {Op, R, As}; + _ -> false + end; +op_view(_) -> false. from_op_view(Op, R, As) -> list_to_tuple([Op, R | As]). -- 2.30.2 From 272c247b4df8286b62f12383eea1bf98a7ae78fa Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 12:33:50 +0200 Subject: [PATCH 50/87] compile address literals --- src/aeso_ast_to_fcode.erl | 41 +++++++++++++++++++++++++------------- src/aeso_fcode_to_fate.erl | 13 ++++++++++++ 2 files changed, 40 insertions(+), 14 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 820d4c4..b478822 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -28,6 +28,10 @@ -type fexpr() :: {int, integer()} | {string, binary()} + | {account_pubkey, binary()} + | {contract_pubkey, binary()} + | {oracle_pubkey, binary()} + | {oracle_query_id, binary()} | {bool, false | true} | nil | {var, var_name()} @@ -259,10 +263,14 @@ expr_to_fcode(Env, Expr) -> -spec expr_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:expr()) -> fexpr(). %% Literals -expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; -expr_to_fcode(_Env, _Type, {char, _, N}) -> {int, N}; -expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; -expr_to_fcode(_Env, _Type, {string, _, S}) -> {string, S}; +expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; +expr_to_fcode(_Env, _Type, {char, _, N}) -> {int, N}; +expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; +expr_to_fcode(_Env, _Type, {string, _, S}) -> {string, S}; +expr_to_fcode(_Env, _Type, {account_pubkey, _, K}) -> {account_pubkey, K}; +expr_to_fcode(_Env, _Type, {contract_pubkey, _, K}) -> {contract_pubkey, K}; +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}; @@ -488,9 +496,13 @@ split_vars({var, X}, T) -> [{X, T}]. -spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). rename(Ren, Expr) -> case Expr of - {int, _} -> Expr; - {string, _} -> Expr; - {bool, _} -> Expr; + {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)}; {con, Ar, I, Es} -> {con, Ar, I, [rename(Ren, E) || E <- Es]}; @@ -791,13 +803,14 @@ pp_punctuate(Sep, [X | Xs]) -> [pp_beside(X, Sep) | pp_punctuate(Sep, Xs)]. pp_par([]) -> prettypr:empty(); pp_par(Xs) -> prettypr:par(Xs). - -pp_fexpr({int, N}) -> - pp_text(N); -pp_fexpr({string, S}) -> - pp_text(S); -pp_fexpr({bool, B}) -> - pp_text(B); +pp_fexpr({Tag, Lit}) when Tag == int; + Tag == string; + Tag == bool; + Tag == account_pubkey; + Tag == contract_pubkey; + Tag == oracle_pubkey; + Tag == oracle_query_id -> + aeso_pretty:expr({Tag, [], Lit}); pp_fexpr(nil) -> pp_text("[]"); pp_fexpr({var, X}) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 46d1c80..e134e5d 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -180,6 +180,19 @@ to_scode(_Env, {string, S}) -> to_scode(_Env, {bool, B}) -> [aeb_fate_code:push(?i(B))]; +to_scode(_Env, {account_pubkey, K}) -> + [aeb_fate_code:push(?i(aeb_fate_data:make_address(K)))]; + +to_scode(_Env, {contract_pubkey, K}) -> + [aeb_fate_code:push(?i(aeb_fate_data:make_contract(K)))]; + +to_scode(_Env, {oracle_pubkey, K}) -> + [aeb_fate_code:push(?i(aeb_fate_data:make_oracle(K)))]; + +to_scode(_Env, {oracle_query_id, K}) -> + %% Not actually in FATE yet + [aeb_fate_code:push(?i(aeb_fate_data:make_oracle_query(K)))]; + to_scode(_Env, nil) -> aeb_fate_code:nil(?a); to_scode(Env, {var, X}) -> -- 2.30.2 From 88139fe99c281c21e7090644ac2867b36e1e5a3e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 13:35:35 +0200 Subject: [PATCH 51/87] Get rid of unit in AST --- src/aeso_ast_infer_types.erl | 2 -- src/aeso_parser.erl | 4 +--- src/aeso_pretty.erl | 1 - src/aeso_syntax.erl | 1 - 4 files changed, 1 insertion(+), 7 deletions(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index 324def0..f157eb7 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -938,8 +938,6 @@ infer_expr(Env, Id = {Tag, As, _}) when Tag == id; Tag == qid -> infer_expr(Env, Id = {Tag, As, _}) when Tag == con; Tag == qcon -> {QName, Type} = lookup_name(Env, As, Id, [freshen]), {typed, As, QName, Type}; -infer_expr(Env, {unit, As}) -> - infer_expr(Env, {tuple, As, []}); infer_expr(Env, {tuple, As, Cpts}) -> NewCpts = [infer_expr(Env, C) || C <- Cpts], CptTypes = [T || {typed, _, _, T} <- NewCpts], diff --git a/src/aeso_parser.erl b/src/aeso_parser.erl index c174a6b..ba9e8b9 100644 --- a/src/aeso_parser.erl +++ b/src/aeso_parser.erl @@ -441,7 +441,7 @@ build_if(Ann, Cond, Then, [{elif, Ann1, Cond1, Then1} | Elses]) -> build_if(Ann, Cond, Then, [{else, _Ann, Else}]) -> {'if', Ann, Cond, Then, Else}; build_if(Ann, Cond, Then, []) -> - {'if', Ann, Cond, Then, {unit, [{origin, system}]}}. + {'if', Ann, Cond, Then, {tuple, [{origin, system}], []}}. else_branches([Elif = {elif, _, _, _} | Stmts], Acc) -> else_branches(Stmts, [Elif | Acc]); @@ -457,7 +457,6 @@ fun_t(Domains, Type) -> lists:foldr(fun({Dom, Ann}, T) -> {fun_t, Ann, [], Dom, T} end, Type, Domains). -tuple_e(Ann, []) -> {unit, Ann}; tuple_e(_Ann, [Expr]) -> Expr; %% Not a tuple tuple_e(Ann, Exprs) -> {tuple, Ann, Exprs}. @@ -478,7 +477,6 @@ parse_pattern({record, Ann, Fs}) -> {record, Ann, lists:map(fun parse_field_pattern/1, Fs)}; parse_pattern(E = {con, _, _}) -> E; parse_pattern(E = {id, _, _}) -> E; -parse_pattern(E = {unit, _}) -> E; parse_pattern(E = {int, _, _}) -> E; parse_pattern(E = {bool, _, _}) -> E; parse_pattern(E = {bytes, _, _}) -> E; diff --git a/src/aeso_pretty.erl b/src/aeso_pretty.erl index 8a09fbc..3177e60 100644 --- a/src/aeso_pretty.erl +++ b/src/aeso_pretty.erl @@ -332,7 +332,6 @@ expr_p(_, {Type, _, Bin}) Type == oracle_pubkey; Type == oracle_query_id -> text(binary_to_list(aeser_api_encoder:encode(Type, Bin))); -expr_p(_, {unit, _}) -> text("()"); expr_p(_, {string, _, S}) -> term(binary_to_list(S)); expr_p(_, {char, _, C}) -> case C of diff --git a/src/aeso_syntax.erl b/src/aeso_syntax.erl index 25f0963..63f192d 100644 --- a/src/aeso_syntax.erl +++ b/src/aeso_syntax.erl @@ -75,7 +75,6 @@ | {contract_pubkey, binary()} | {oracle_pubkey, binary()} | {oracle_query_id, binary()} - | {unit, ann()} | {string, ann(), binary()} | {char, ann(), integer()}. -- 2.30.2 From a4bbe2bc2f0f434768a13c43b12f9a60a82654ed Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 13:49:26 +0200 Subject: [PATCH 52/87] Unary operators --- src/aeso_ast_to_fcode.erl | 11 +++++++++-- src/aeso_fcode_to_fate.erl | 10 +++++++--- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index b478822..218fc7d 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -25,6 +25,7 @@ -type sophia_name() :: [string()]. -type binop() :: '+' | '-' | '==' | '::'. +-type unop() :: '!'. -type fexpr() :: {int, integer()} | {string, binary()} @@ -39,7 +40,8 @@ | {tuple, [fexpr()]} | {proj, fexpr(), integer()} | {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value - | {binop, binop(), fexpr(), fexpr()} + | {op, binop(), fexpr(), fexpr()} + | {op, unop(), fexpr()} | {'let', var_name(), fexpr(), fexpr()} | {switch, fsplit()}. @@ -360,7 +362,12 @@ expr_to_fcode(Env, _Type, {block, _, Stmts}) -> %% Binary operator expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> FOp = binop_to_fcode(Op), - {binop, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; + {op, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; +expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) -> + case Op of + '-' -> {op, '-', {int, 0}, expr_to_fcode(Env, A)}; + '!' -> {op, '!', expr_to_fcode(Env, A)} + end; 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 e134e5d..58cf387 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -217,10 +217,13 @@ to_scode(Env, {set_proj, R, I, E}) -> to_scode(Env, R), aeb_fate_code:setelement(?a, ?i(I), ?a, ?a)]; -to_scode(Env, {binop, Op, A, B}) -> +to_scode(Env, {op, Op, A, B}) -> [ to_scode(notail(Env), B), - to_scode(Env, A), + to_scode(notail(Env), A), binop_to_scode(Op) ]; +to_scode(Env, {op, Op, A}) -> + [ to_scode(notail(Env), A), + unop_to_scode(Op) ]; to_scode(Env, {'let', X, {var, Y}, Body}) -> Env1 = bind_var(X, lookup_var(Env, Y), Env), @@ -351,7 +354,8 @@ binop_to_scode('+') -> aeb_fate_code:add(?a, ?a, ?a); binop_to_scode('-') -> aeb_fate_code:sub(?a, ?a, ?a); binop_to_scode('==') -> aeb_fate_code:eq(?a, ?a, ?a); binop_to_scode('::') -> aeb_fate_code:cons(?a, ?a, ?a). -% binop_to_scode(Op) -> ?TODO(Op). + +unop_to_scode('!') -> aeb_fate_code:not_op(?a, ?a). %% -- Phase II --------------------------------------------------------------- %% Optimize -- 2.30.2 From 8a5c64ad45171bee4f2eb20ba052a2c40081efdc Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 26 Apr 2019 15:05:38 +0200 Subject: [PATCH 53/87] 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) -> -- 2.30.2 From e13e81d1ca83c23a6ddc8bdb4107310d20353404 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 29 Apr 2019 12:01:36 +0200 Subject: [PATCH 54/87] fix breakage after unary operators --- src/aeso_ast_to_fcode.erl | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 57e06d4..e03f36d 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -325,7 +325,7 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> %% Lists expr_to_fcode(Env, _Type, {list, _, Es}) -> - lists:foldr(fun(E, L) -> {binop, '::', expr_to_fcode(Env, E), L} end, + lists:foldr(fun(E, L) -> {op, '::', expr_to_fcode(Env, E), L} end, nil, Es); %% Conditionals @@ -520,7 +520,8 @@ rename(Ren, Expr) -> {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)}; - {binop, Op, E1, E2} -> {binop, Op, rename(Ren, E1), rename(Ren, E2)}; + {op, Op, E1, E2} -> {op, Op, rename(Ren, E1), rename(Ren, E2)}; + {op, Op, E} -> {op, Op, rename(Ren, E)}; {'let', X, E, Body} -> {Z, Ren1} = rename_binding(Ren, X), {'let', Z, rename(Ren, E), rename(Ren1, Body)}; @@ -837,8 +838,10 @@ pp_fexpr({proj, E, I}) -> pp_beside([pp_fexpr(E), pp_text("."), pp_text(I)]); pp_fexpr({set_proj, E, I, A}) -> pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_text(I), pp_text(" = "), pp_fexpr(A)]))); -pp_fexpr({binop, Op, A, B}) -> +pp_fexpr({op, Op, A, B}) -> pp_parens(pp_par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); +pp_fexpr({op, Op, A}) -> + pp_parens(pp_par([pp_text(Op), pp_fexpr(A)])); 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)]); @@ -866,8 +869,8 @@ pp_case({'case', Pat, Split}) -> prettypr:sep([pp_beside(pp_pat(Pat), pp_text(" =>")), prettypr:nest(2, pp_split(Split))]). -pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); -pp_pat({'::', X, Xs}) -> pp_fexpr({binop, '::', {var, X}, {var, Xs}}); -pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, X} || X <- Xs]}); +pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, [X]} || X <- Xs]}); +pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', {var, [X]}, {var, [Xs]}}); +pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, [X]} || X <- Xs]}); pp_pat(Pat) -> pp_fexpr(Pat). -- 2.30.2 From 97db2b9800ab97a35a03861dbdbbc734b28a6fc3 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 29 Apr 2019 12:02:07 +0200 Subject: [PATCH 55/87] variables are now lists of names in fcode --- src/aeso_ast_to_fcode.erl | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index e03f36d..95d9d28 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -306,7 +306,7 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> X = fresh_name(), - Proj = fun(I) -> {proj, {var, X}, I - 1} end, + Proj = fun(I) -> {proj, {var, [X]}, I - 1} end, Comp = fun({I, false}) -> Proj(I); ({_, {set, E}}) -> expr_to_fcode(Env, E); ({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(Env, E)} @@ -319,7 +319,7 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> Updates = [ {I, field_value(FT, Fields)} || {I, FT} <- indexed(FieldTypes) ], Body = case Expand of true -> {tuple, lists:map(Comp, Updates)}; - false -> lists:foldr(Set, {var, X}, Updates) + false -> lists:foldr(Set, {var, [X]}, Updates) end, {'let', X, expr_to_fcode(Env, Rec), Body}; @@ -336,8 +336,8 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> {'case', {bool, true}, {nosplit, expr_to_fcode(Env, Then)}}]}} end, case Cond of - {var, X} -> Switch(X); - _ -> + {var, [X]} -> Switch(X); + _ -> X = fresh_name(), {'let', X, expr_to_fcode(Env, Cond), Switch(X)} end; @@ -515,7 +515,8 @@ rename(Ren, Expr) -> {oracle_pubkey, _} -> Expr; {oracle_query_id, _} -> Expr; nil -> nil; - {var, X} -> {var, rename_var(Ren, X)}; + {var, [X]} -> {var, [rename_var(Ren, X)]}; + {var, _} -> Expr; {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}; @@ -872,5 +873,6 @@ pp_case({'case', Pat, Split}) -> pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, [X]} || X <- Xs]}); pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', {var, [X]}, {var, [Xs]}}); pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, [X]} || X <- Xs]}); +pp_pat({var, X}) -> pp_fexpr({var, [X]}); pp_pat(Pat) -> pp_fexpr(Pat). -- 2.30.2 From 690d55eefe659bc73afea8dc5a2a6a9a3c4f00f6 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 29 Apr 2019 12:02:23 +0200 Subject: [PATCH 56/87] pretty printing for function calls --- src/aeso_ast_to_fcode.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 95d9d28..916d70a 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -846,6 +846,8 @@ pp_fexpr({op, Op, A}) -> 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({funcall, Fun, As}) -> + pp_beside(pp_fexpr(Fun), pp_fexpr({tuple, As})); pp_fexpr({switch, Split}) -> pp_split(Split). pp_ftype(T) when is_atom(T) -> pp_text(T); -- 2.30.2 From 081a4d28b683ff01cef5d5c185219cddae794027 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 29 Apr 2019 12:03:33 +0200 Subject: [PATCH 57/87] use STORE ?a instead of PUSH during optimizations --- src/aeso_fcode_to_fate.erl | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 1ba49c7..1a64bac 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -195,31 +195,31 @@ resolve_name(#env{ vars = Vars, contract = Contract, locals = Funs }, X) -> %% -- The compiler -- to_scode(_Env, {int, N}) -> - [aeb_fate_code:push(?i(N))]; + [push(?i(N))]; to_scode(_Env, {string, S}) -> - [aeb_fate_code:push(?i(aeb_fate_data:make_string(S)))]; + [push(?i(aeb_fate_data:make_string(S)))]; to_scode(_Env, {bool, B}) -> - [aeb_fate_code:push(?i(B))]; + [push(?i(B))]; to_scode(_Env, {account_pubkey, K}) -> - [aeb_fate_code:push(?i(aeb_fate_data:make_address(K)))]; + [push(?i(aeb_fate_data:make_address(K)))]; to_scode(_Env, {contract_pubkey, K}) -> - [aeb_fate_code:push(?i(aeb_fate_data:make_contract(K)))]; + [push(?i(aeb_fate_data:make_contract(K)))]; to_scode(_Env, {oracle_pubkey, K}) -> - [aeb_fate_code:push(?i(aeb_fate_data:make_oracle(K)))]; + [push(?i(aeb_fate_data:make_oracle(K)))]; to_scode(_Env, {oracle_query_id, K}) -> %% Not actually in FATE yet - [aeb_fate_code:push(?i(aeb_fate_data:make_oracle_query(K)))]; + [push(?i(aeb_fate_data:make_oracle_query(K)))]; to_scode(_Env, nil) -> aeb_fate_code:nil(?a); to_scode(Env, {var, X}) -> - [aeb_fate_code:push(lookup_var(Env, X))]; + [push(lookup_var(Env, X))]; to_scode(Env, {con, Ar, I, As}) -> N = length(As), @@ -399,6 +399,10 @@ binop_to_scode('::') -> aeb_fate_code:cons(?a, ?a, ?a). unop_to_scode('!') -> aeb_fate_code:not_op(?a, ?a). +%% PUSH and STORE ?a are the same, so we use STORE to make optimizations +%% easier, and specialize to PUSH (which is cheaper) at the end. +push(A) -> aeb_fate_code:store(?a, A). + %% -- Phase II --------------------------------------------------------------- %% Optimize @@ -740,12 +744,12 @@ rules() -> ]. %% Removing pushes that are immediately consumed. -r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, {'POP', B}} | Code]) -> +r_push_consume({i, Ann1, {'STORE', ?a, A}}, [{i, Ann2, {'POP', B}} | Code]) -> case live_out(B, Ann2) of true -> {[{i, merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; false -> {[], Code} end; -r_push_consume({i, Ann1, {'PUSH', A}}, [{i, Ann2, I} | Code]) -> +r_push_consume({i, Ann1, {'STORE', ?a, A}}, [{i, Ann2, I} | Code]) -> case op_view(I) of {Op, R, As} -> case lists:splitwith(fun(X) -> X /= ?a end, As) of @@ -765,7 +769,7 @@ r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) -> r_push_consume(_, _) -> false. %% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations -r_dup_to_push({i, Ann1, Push={'PUSH', _}}, [{i, Ann2, 'DUPA'} | Code]) -> +r_dup_to_push({i, Ann1, Push={'STORE', ?a, _}}, [{i, Ann2, 'DUPA'} | Code]) -> #{ live_in := LiveIn } = Ann1, Ann1_ = Ann1#{ live_out => LiveIn }, Ann2_ = Ann2#{ live_in => LiveIn }, @@ -773,7 +777,7 @@ r_dup_to_push({i, Ann1, Push={'PUSH', _}}, [{i, Ann2, 'DUPA'} | Code]) -> r_dup_to_push(_, _) -> false. %% Move PUSH A past non-stack instructions. -r_swap_push(Push = {i, _, {'PUSH', _}}, [I | Code]) -> +r_swap_push(Push = {i, _, {'STORE', ?a, _}}, [I | Code]) -> case independent(Push, I) of true -> {I1, Push1} = swap_instrs(Push, I), @@ -844,7 +848,6 @@ r_one_shot_var({i, Ann1, I}, [{i, Ann2, J} | Code]) -> case op_view(I) of {Op, R, As} -> Copy = case J of - {'PUSH', R} -> {write_to, ?a}; {'STORE', S, R} -> {write_to, S}; _ -> false end, @@ -898,6 +901,7 @@ unannotate({i, _Ann, I}) -> [I]. %% Desugar and specialize desugar({'ADD', ?a, ?i(1), ?a}) -> [aeb_fate_code:inc()]; desugar({'SUB', ?a, ?a, ?i(1)}) -> [aeb_fate_code:dec()]; +desugar({'STORE', ?a, A}) -> [aeb_fate_code:push(A)]; desugar({switch, Arg, Type, Alts, Def}) -> [{switch, Arg, Type, [desugar(A) || A <- Alts], desugar(Def)}]; desugar(missing) -> missing; -- 2.30.2 From 4c2288274d0103c451fb1aebe98742bbd4346afd Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 29 Apr 2019 12:40:19 +0200 Subject: [PATCH 58/87] no-op fcode optimization pass --- src/aeso_ast_to_fcode.erl | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 916d70a..ccc4baa 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -116,7 +116,7 @@ %% and produces Fate intermediate code. -spec ast_to_fcode(aeso_syntax:ast(), [option()]) -> fcode(). ast_to_fcode(Code, Options) -> - to_fcode(init_env(Options), Code). + optimize_fcode(to_fcode(init_env(Options), Code)). %% -- Environment ------------------------------------------------------------ @@ -657,10 +657,18 @@ stmts_to_fcode(Env, [Expr]) -> %% - Translate && and || to ifte %% - Deadcode elimination %% - Unused variable analysis (replace by _) -%% - Simplified case trees (FATE has special instructions for shallow matching) %% - Case specialization %% - Constant propagation +-spec optimize_fcode(fcode()) -> fcode(). +optimize_fcode(Code = #{ functions := Funs }) -> + Code#{ functions := maps:map(fun(Name, Def) -> optimize_fun(Code, Name, Def) end, Funs) }. + +-spec optimize_fun(fcode(), fun_name(), fun_def()) -> fun_def(). +optimize_fun(_Fcode, _Fun, Def = #{ body := _Body }) -> + %% io:format("Optimizing ~p =\n~s\n", [Fun, prettypr:format(pp_fexpr(Body))]), + Def. + %% -- Helper functions ------------------------------------------------------- %% -- Types -- -- 2.30.2 From 389a5c4e625a22ae2bf0a1a845443453dbb498b8 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 29 Apr 2019 12:40:50 +0200 Subject: [PATCH 59/87] some constant propagation optimizations --- src/aeso_fcode_to_fate.erl | 117 ++++++++++++++++++++++++++++++++----- 1 file changed, 103 insertions(+), 14 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 1a64bac..f3ee8e3 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -693,7 +693,15 @@ swap_instrs({i, #{ live_in := Live1 }, I}, {i, #{ live_in := Live2, live_out := {{i, #{ live_in => Live1, live_out => Live2_ }, J}, {i, #{ live_in => Live2_, live_out => Live3 }, I}}. -live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn). +live_in(R, #{ live_in := LiveIn }) -> ordsets:is_element(R, LiveIn); +live_in(R, {i, Ann, _}) -> live_in(R, Ann); +live_in(R, [I = {i, _, _} | _]) -> live_in(R, I); +live_in(R, [switch_body | Code]) -> live_in(R, Code); +live_in(R, [{switch, A, _, Alts, Def} | _]) -> + R == A orelse lists:any(fun(Code) -> live_in(R, Code) end, [Def | Alts]); +live_in(_, missing) -> false; +live_in(_, []) -> false. + live_out(R, #{ live_out := LiveOut }) -> ordsets:is_element(R, LiveOut). %% -- Optimizations -- @@ -732,7 +740,8 @@ apply_rules_once([{RName, Rule} | Rules], I, Code) -> merge_rules() -> [?RULE(r_push_consume), ?RULE(r_one_shot_var), - ?RULE(r_write_to_dead_var) + ?RULE(r_write_to_dead_var), + ?RULE(r_inline_switch_target) ]. rules() -> @@ -740,6 +749,8 @@ rules() -> [?RULE(r_dup_to_push), ?RULE(r_swap_push), ?RULE(r_swap_write), + ?RULE(r_constant_propagation), + ?RULE(r_prune_impossible_branches), ?RULE(r_inline_store) ]. @@ -812,10 +823,75 @@ r_swap_write(Pre, I, Code0 = [J | Code]) -> end; r_swap_write(_, _, _) -> false. +%% Precompute instructions with known values +r_constant_propagation({i, Ann, I}, Code) -> + case op_view(I) of + false -> false; + {Op, R, As} -> + Vs = [V || ?i(V) <- As], + case length(Vs) == length(As) of + false -> false; + true -> + case eval_op(Op, Vs) of + no_eval -> false; + V -> {[{i, Ann, {'STORE', R, ?i(V)}}], Code} + end + end + end; +r_constant_propagation(_, _) -> false. + +eval_op('EQ', [X, Y]) -> X =:= Y; %% TODO: more +eval_op(_, _) -> no_eval. + +%% Prune impossible branches from switches +r_prune_impossible_branches({switch, ?i(V), Type, Alts, missing}, Code) -> + case pick_branch(Type, V, Alts) of + false -> false; + Alt -> {Alt, Code} + end; +r_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def}, Code) -> + Alts1 = [if V -> missing; true -> False end, + if V -> True; true -> missing end], + case Alts == Alts1 of + true -> false; + false -> + {[{switch, ?i(V), boolean, Alts1, Def}], Code} + end; +r_prune_impossible_branches(_, _) -> false. + +pick_branch(boolean, V, [False, True]) -> + Alt = if V -> True; true -> False end, + case Alt of + missing -> false; + _ -> Alt + end; +pick_branch(_Type, _V, _Alts) -> + false. + +%% STORE R A, SWITCH R --> SWITCH A +r_inline_switch_target(Store = {i, _, {'STORE', R, A}}, [{switch, R, Type, Alts, Def} | Code]) -> + Switch = {switch, A, Type, Alts, Def}, + case R of + ?a -> {[Switch], Code}; + {var, _} -> + case lists:any(fun(Alt) -> live_in(R, Alt) end, [Def | Alts]) of + false -> {[Switch], Code}; + true -> {[Store, Switch], Code} + end; + _ -> false %% impossible + end; +r_inline_switch_target(_, _) -> false. + %% Inline stores -r_inline_store(I = {i, _, {'STORE', R = {var, _}, A = {arg, _}}}, Code) -> +r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) -> %% Not when A is var unless updating the annotations properly. - r_inline_store([I], R, A, Code); + Inline = case A of + {arg, _} -> true; + ?i(_) -> true; + _ -> false + end, + if Inline -> r_inline_store([I], R, A, Code); + true -> false end; r_inline_store(_, _) -> false. r_inline_store(Acc, R, A, [switch_body | Code]) -> @@ -987,7 +1063,12 @@ block(Blk = #blk{code = [{switch, Arg, Type, Alts, Default} | Code], missing -> [{jump, DefRef}]; _ -> FalseCode ++ [{jump, RestRef}] end, - {Blk#blk{code = ElseCode}, [{jumpif, Arg, ThenRef}], ThenBlk}; + case lists:usort(Alts) == [missing] of + true -> + {Blk#blk{code = [{jump, DefRef}]}, [], []}; + false -> + {Blk#blk{code = ElseCode}, [{jumpif, Arg, ThenRef}], ThenBlk} + end; tuple -> [TCode] = Alts, {Blk#blk{code = TCode ++ [{jump, RestRef}]}, [], []}; @@ -1018,7 +1099,7 @@ optimize_blocks(Blocks) -> RBlocks1 = reorder_blocks(RBlocks, []), RBlocks2 = [ {Ref, inline_block(RBlockMap, Ref, Code)} || {Ref, Code} <- RBlocks1 ], RBlocks3 = remove_dead_blocks(RBlocks2), - RBlocks4 = [ {Ref, use_returnr(Code)} || {Ref, Code} <- RBlocks3 ], + RBlocks4 = [ {Ref, tweak_returns(Code)} || {Ref, Code} <- RBlocks3 ], Rev(RBlocks4). %% Choose the next block based on the final jump. @@ -1030,11 +1111,13 @@ reorder_blocks([{Ref, Code} | Blocks], Acc) -> reorder_blocks(Ref, Code, Blocks, Acc) -> Acc1 = [{Ref, Code} | Acc], case Code of - ['RETURN'|_] -> reorder_blocks(Blocks, Acc1); - [{'RETURNR', _}|_] -> reorder_blocks(Blocks, Acc1); - [{'ABORT', _}|_] -> reorder_blocks(Blocks, Acc1); - [{switch, _, _}|_] -> reorder_blocks(Blocks, Acc1); - [{jump, L}|_] -> + ['RETURN'|_] -> reorder_blocks(Blocks, Acc1); + [{'RETURNR', _}|_] -> reorder_blocks(Blocks, Acc1); + [{'CALL_T', _}|_] -> reorder_blocks(Blocks, Acc1); + [{'CALL_TR', _, _}|_] -> reorder_blocks(Blocks, Acc1); + [{'ABORT', _}|_] -> reorder_blocks(Blocks, Acc1); + [{switch, _, _}|_] -> reorder_blocks(Blocks, Acc1); + [{jump, L}|_] -> NotL = fun({L1, _}) -> L1 /= L end, case lists:splitwith(NotL, Blocks) of {Blocks1, [{L, Code1} | Blocks2]} -> @@ -1069,10 +1152,16 @@ chase_labels([L | Ls], Map, Live) -> New = lists:flatmap(Jump, Code), chase_labels(New ++ Ls, Map, Live#{ L => true }). -%% Replace PUSH, RETURN by RETURNR -use_returnr(['RETURN', {'PUSH', A} | Code]) -> +%% Replace PUSH, RETURN by RETURNR, drop returns after tail calls. +tweak_returns(['RETURN', {'PUSH', A} | Code]) -> [{'RETURNR', A} | Code]; -use_returnr(Code) -> Code. +%% tweak_returns(['RETURN', {'PUSH', A} | Code]) -> +%% [{'RETURNR', A} | Code]; +tweak_returns(['RETURN' | Code = [{'CALL_T', _} | _]]) -> + Code; +tweak_returns(['RETURN' | Code = [{'CALL_TR', _, _} | _]]) -> + Code; +tweak_returns(Code) -> Code. %% -- Split basic blocks at CALL instructions -- %% Calls can only return to a new basic block. -- 2.30.2 From 0307a82433629450415b3721488514127ee310f2 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 29 Apr 2019 14:21:37 +0200 Subject: [PATCH 60/87] Case on constructor optimization --- src/aeso_fcode_to_fate.erl | 61 +++++++++++++++++++++++++++++++------- 1 file changed, 50 insertions(+), 11 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index f3ee8e3..6808586 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -455,7 +455,7 @@ pp_ann(Ind, [{switch, Arg, Type, Alts, Def} | Code]) -> [Ind, "SWITCH ", pp_arg(Arg), "\n", [[Ind1, Tag, " =>\n", pp_ann(Ind2, Alt)] || {Tag, Alt} <- lists:zip(Tags, Alts), Alt /= missing], - [[Ind1, "_ =>\n", pp_ann(" " ++ Ind, Def)] || Def /= missing], + [[Ind1, "_ =>\n", pp_ann(Ind2, Def)] || Def /= missing], pp_ann(Ind, Code)]; pp_ann(Ind, [switch_body | Code]) -> [Ind, "SWITCH-BODY\n", pp_ann(Ind, Code)]; @@ -591,7 +591,7 @@ attributes(I) -> {'ADDR_TO_STR', A, B} -> Pure(A, B); {'STR_REVERSE', A, B} -> Pure(A, B); {'INT_TO_ADDR', A, B} -> Pure(A, B); - {'VARIANT', A, B, C, D} -> Pure(A, [B, C, D]); + {'VARIANT', A, B, C, D} -> Pure(A, [?a, B, C, D]); {'VARIANT_TEST', A, B, C} -> Pure(A, [B, C]); {'VARIANT_ELEMENT', A, B, C} -> Pure(A, [B, C]); 'BITS_NONEA' -> Pure(?a, []); @@ -751,7 +751,8 @@ rules() -> ?RULE(r_swap_write), ?RULE(r_constant_propagation), ?RULE(r_prune_impossible_branches), - ?RULE(r_inline_store) + ?RULE(r_inline_store), + ?RULE(r_float_switch_body) ]. %% Removing pushes that are immediately consumed. @@ -772,11 +773,17 @@ r_push_consume({i, Ann1, {'STORE', ?a, A}}, [{i, Ann2, I} | Code]) -> end; %% Writing directly to memory instead of going through the accumulator. r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) -> - case op_view(I) of - {Op, ?a, As} -> {[{i, merge_ann(Ann1, Ann2), from_op_view(Op, R, As)}], Code}; - _ -> false - end; - + IsPush = + case op_view(I) of + {_, ?a, _} -> true; + _ -> false + end orelse + case I of + {'VARIANT', ?a, _, _, _} -> true; + _ -> false + end, + if IsPush -> {[{i, merge_ann(Ann1, Ann2), setelement(2, I, R)}], Code}; + true -> false end; r_push_consume(_, _) -> false. %% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations @@ -824,6 +831,18 @@ r_swap_write(Pre, I, Code0 = [J | Code]) -> r_swap_write(_, _, _) -> false. %% Precompute instructions with known values +r_constant_propagation(Cons = {i, _, {'CONS', R, _, _}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) -> + Store = {i, Ann, {'STORE', S, ?i(false)}}, + case R of + ?a -> {[Store], Code}; + _ -> {[Cons, Store], Code} + end; +r_constant_propagation(Cons = {i, _, {'NIL', R}}, [{i, Ann, {'IS_NIL', S, R}} | Code]) -> + Store = {i, Ann, {'STORE', S, ?i(true)}}, + case R of + ?a -> {[Store], Code}; + _ -> {[Cons, Store], Code} + end; r_constant_propagation({i, Ann, I}, Code) -> case op_view(I) of false -> false; @@ -855,7 +874,21 @@ r_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def}, case Alts == Alts1 of true -> false; false -> - {[{switch, ?i(V), boolean, Alts1, Def}], Code} + case Alts1 of + [missing, missing] -> {Def, Code}; + _ -> {[{switch, ?i(V), boolean, Alts1, Def}], Code} + end + end; +r_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_)}}, + [{switch, R, Type, Alts, missing} | Code]) -> + case {R, lists:nth(Tag + 1, Alts)} of + {_, missing} -> {[Variant, {switch, R, Type, [missing || _ <- Alts], missing}]}; + {?a, Alt} -> {Alt, Code}; + {_, Alt} -> + case live_in(R, Alt) of + true -> {[Variant | Alt], Code}; + false -> {Alt, Code} + end end; r_prune_impossible_branches(_, _) -> false. @@ -875,13 +908,19 @@ r_inline_switch_target(Store = {i, _, {'STORE', R, A}}, [{switch, R, Type, Alts, ?a -> {[Switch], Code}; {var, _} -> case lists:any(fun(Alt) -> live_in(R, Alt) end, [Def | Alts]) of - false -> {[Switch], Code}; - true -> {[Store, Switch], Code} + false -> {[Switch], Code}; + true when A /= ?a -> {[Store, Switch], Code}; + true -> false end; _ -> false %% impossible end; r_inline_switch_target(_, _) -> false. +%% Float switch-body to closest switch +r_float_switch_body(I = {i, _, _}, [switch_body | Code]) -> + {[], [switch_body, I | Code]}; +r_float_switch_body(_, _) -> false. + %% Inline stores r_inline_store(I = {i, _, {'STORE', R = {var, _}, A}}, Code) -> %% Not when A is var unless updating the annotations properly. -- 2.30.2 From 8559ab06286332023a94467a8bdd05df40481c90 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 30 Apr 2019 09:51:46 +0200 Subject: [PATCH 61/87] fix minor bugs --- src/aeso_ast_to_fcode.erl | 3 ++- src/aeso_fcode_to_fate.erl | 10 ++++++++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index ccc4baa..c432ef8 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -376,7 +376,8 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun, Args}) -> expr_to_fcode(_Env, Type, Expr) -> error({todo, {Expr, ':', Type}}). -binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '==' -> Op. +binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '=='; + Op == '::' -> Op. -spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fsplit(). alts_to_fcode(Env, Type, X, Alts) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 6808586..f94982f 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -216,7 +216,8 @@ to_scode(_Env, {oracle_query_id, K}) -> %% Not actually in FATE yet [push(?i(aeb_fate_data:make_oracle_query(K)))]; -to_scode(_Env, nil) -> aeb_fate_code:nil(?a); +to_scode(_Env, nil) -> + [aeb_fate_code:nil(?a)]; to_scode(Env, {var, X}) -> [push(lookup_var(Env, X))]; @@ -882,7 +883,12 @@ r_prune_impossible_branches({switch, ?i(V), boolean, [False, True] = Alts, Def}, r_prune_impossible_branches(Variant = {i, _, {'VARIANT', R, ?i(_), ?i(Tag), ?i(_)}}, [{switch, R, Type, Alts, missing} | Code]) -> case {R, lists:nth(Tag + 1, Alts)} of - {_, missing} -> {[Variant, {switch, R, Type, [missing || _ <- Alts], missing}]}; + {_, missing} -> + Alts1 = [missing || _ <- Alts], + case Alts == Alts1 of + true -> false; + false -> {[Variant, {switch, R, Type, Alts1, missing}], Code} + end; {?a, Alt} -> {Alt, Code}; {_, Alt} -> case live_in(R, Alt) of -- 2.30.2 From cd454fb5382ad0de75145d7499dd80caf37300dc Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 30 Apr 2019 11:43:27 +0200 Subject: [PATCH 62/87] Compile all the operators --- src/aeso_ast_to_fcode.erl | 227 +++++++++++++++++++++---------------- src/aeso_fcode_to_fate.erl | 14 ++- 2 files changed, 142 insertions(+), 99 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index c432ef8..78488ce 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -24,7 +24,8 @@ -type var_name() :: string(). -type sophia_name() :: [string()]. --type binop() :: '+' | '-' | '==' | '::'. +-type binop() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' | + '<' | '>' | '=<' | '>=' | '==' | '!='. -type unop() :: '!'. -type fexpr() :: {int, integer()} @@ -360,9 +361,11 @@ expr_to_fcode(Env, _Type, {block, _, Stmts}) -> stmts_to_fcode(Env, Stmts); %% Binary operator +expr_to_fcode(Env, _Type, Expr = {app, _, {Op, _}, [_, _]}) when Op == '&&'; Op == '||' -> + Tree = expr_to_decision_tree(Env, Expr), + decision_tree_to_fcode(Tree); expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> - FOp = binop_to_fcode(Op), - {op, FOp, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; + {op, Op, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) -> case Op of '-' -> {op, '-', {int, 0}, expr_to_fcode(Env, A)}; @@ -376,8 +379,7 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun, Args}) -> expr_to_fcode(_Env, Type, Expr) -> error({todo, {Expr, ':', Type}}). -binop_to_fcode(Op) when Op == '+'; Op == '-'; Op == '=='; - Op == '::' -> Op. +%% -- Pattern matching -- -spec alts_to_fcode(env(), ftype(), var_name(), [aeso_syntax:alt()]) -> fsplit(). alts_to_fcode(Env, Type, X, Alts) -> @@ -505,97 +507,6 @@ split_vars({tuple, Xs}, {tuple, Ts}) -> lists:zip(Xs, Ts); split_vars({var, X}, T) -> [{X, T}]. --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)]}; - {var, _} -> Expr; - {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, E1, E2} -> {op, Op, rename(Ren, E1), rename(Ren, E2)}; - {op, Op, E} -> {op, Op, rename(Ren, E)}; - {'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)} - end. - -rename_var(Ren, X) -> proplists:get_value(X, Ren, X). -rename_binding(Ren, X) -> - Ren1 = lists:keydelete(X, 1, Ren), - case lists:keymember(X, 2, Ren) of - false -> {X, Ren1}; - true -> - Z = fresh_name(), - {Z, [{X, Z} | Ren1]} - end. - -rename_bindings(Ren, []) -> {[], Ren}; -rename_bindings(Ren, [X | Xs]) -> - {Z, Ren1} = rename_binding(Ren, X), - {Zs, Ren2} = rename_bindings(Ren1, Xs), - {[Z | Zs], Ren2}. - -rename_fpats(Ren, []) -> {[], Ren}; -rename_fpats(Ren, [P | Ps]) -> - {Q, Ren1} = rename_fpat(Ren, P), - {Qs, Ren2} = rename_fpats(Ren1, Ps), - {[Q | Qs], Ren2}. - -rename_fpat(Ren, P = {bool, _}) -> {P, Ren}; -rename_fpat(Ren, P = {int, _}) -> {P, Ren}; -rename_fpat(Ren, P = {string, _}) -> {P, Ren}; -rename_fpat(Ren, P = nil) -> {P, Ren}; -rename_fpat(Ren, {'::', P, Q}) -> - {P1, Ren1} = rename_fpat(Ren, P), - {Q1, Ren2} = rename_fpat(Ren1, Q), - {{'::', P1, Q1}, Ren2}; -rename_fpat(Ren, {var, X}) -> - {Z, Ren1} = rename_binding(Ren, X), - {{var, Z}, Ren1}; -rename_fpat(Ren, {con, Ar, C, Ps}) -> - {Ps1, Ren1} = rename_fpats(Ren, Ps), - {{con, Ar, C, Ps1}, Ren1}; -rename_fpat(Ren, {tuple, Ps}) -> - {Ps1, Ren1} = rename_fpats(Ren, Ps), - {{tuple, Ps1}, Ren1}. - -rename_spat(Ren, P = {bool, _}) -> {P, Ren}; -rename_spat(Ren, P = {int, _}) -> {P, Ren}; -rename_spat(Ren, P = {string, _}) -> {P, Ren}; -rename_spat(Ren, P = nil) -> {P, Ren}; -rename_spat(Ren, {'::', X, Y}) -> - {X1, Ren1} = rename_binding(Ren, X), - {Y1, Ren2} = rename_binding(Ren1, Y), - {{'::', X1, Y1}, Ren2}; -rename_spat(Ren, {var, X}) -> - {Z, Ren1} = rename_binding(Ren, X), - {{var, Z}, Ren1}; -rename_spat(Ren, {con, Ar, C, Xs}) -> - {Zs, Ren1} = rename_bindings(Ren, Xs), - {{con, Ar, C, Zs}, Ren1}; -rename_spat(Ren, {tuple, Xs}) -> - {Zs, Ren1} = rename_bindings(Ren, Xs), - {{tuple, Zs}, Ren1}. - -rename_split(Ren, {split, Type, X, Cases}) -> - {split, Type, rename_var(Ren, X), [rename_case(Ren, C) || C <- Cases]}; -rename_split(Ren, {nosplit, E}) -> {nosplit, rename(Ren, E)}. - -rename_case(Ren, {'case', Pat, Split}) -> - {Pat1, Ren1} = rename_spat(Ren, Pat), - {'case', Pat1, rename_split(Ren1, Split)}. - -spec next_split([fpat()]) -> integer() | false. next_split(Pats) -> IsVar = fun({var, _}) -> true; (_) -> false end, @@ -646,6 +557,34 @@ pat_to_fcode(Env, {record_t, Fields}, {record, _, FieldPats}) -> pat_to_fcode(_Env, Type, Pat) -> error({todo, Pat, ':', Type}). +%% -- Decision trees for boolean operators -- + +decision_op('&&', {atom, A}, B) -> {'if', A, B, false}; +decision_op('&&', false, _) -> false; +decision_op('&&', true, B) -> B; +decision_op('||', {atom, A}, B) -> {'if', A, true, B}; +decision_op('||', false, B) -> B; +decision_op('||', true, _) -> true; +decision_op(Op, {'if', A, Then, Else}, B) -> + {'if', A, decision_op(Op, Then, B), decision_op(Op, Else, B)}. + +expr_to_decision_tree(Env, {app, _Ann, {Op, _}, [A, B]}) when Op == '&&'; Op == '||' -> + decision_op(Op, expr_to_decision_tree(Env, A), expr_to_decision_tree(Env, B)); +expr_to_decision_tree(Env, {typed, _, Expr, _}) -> expr_to_decision_tree(Env, Expr); +expr_to_decision_tree(Env, Expr) -> + {atom, expr_to_fcode(Env, Expr)}. + +decision_tree_to_fcode(false) -> {bool, false}; +decision_tree_to_fcode(true) -> {bool, true}; +decision_tree_to_fcode({atom, B}) -> B; +decision_tree_to_fcode({'if', A, Then, Else}) -> + X = fresh_name(), + {'let', X, A, + {switch, {split, boolean, X, [{'case', {bool, false}, {nosplit, decision_tree_to_fcode(Else)}}, + {'case', {bool, true}, {nosplit, decision_tree_to_fcode(Then)}}]}}}. + +%% -- Statements -- + -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(Env, Stmts)}; @@ -667,7 +606,7 @@ optimize_fcode(Code = #{ functions := Funs }) -> -spec optimize_fun(fcode(), fun_name(), fun_def()) -> fun_def(). optimize_fun(_Fcode, _Fun, Def = #{ body := _Body }) -> - %% io:format("Optimizing ~p =\n~s\n", [Fun, prettypr:format(pp_fexpr(Body))]), + %% io:format("Optimizing ~p =\n~s\n", [_Fun, prettypr:format(pp_fexpr(_Body))]), Def. %% -- Helper functions ------------------------------------------------------- @@ -764,6 +703,100 @@ fresh_name() -> put('%fresh', N + 1), lists:concat(["%", N]). +%% -- Renaming -- + +-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)]}; + {var, _} -> Expr; + {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, E1, E2} -> {op, Op, rename(Ren, E1), rename(Ren, E2)}; + {op, Op, E} -> {op, Op, rename(Ren, E)}; + {funcall, Fun, Es} -> {funcall, Fun, [rename(Ren, E) || E <- Es]}; + {'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)} + end. + +rename_var(Ren, X) -> proplists:get_value(X, Ren, X). +rename_binding(Ren, X) -> + Ren1 = lists:keydelete(X, 1, Ren), + case lists:keymember(X, 2, Ren) of + false -> {X, Ren1}; + true -> + Z = fresh_name(), + {Z, [{X, Z} | Ren1]} + end. + +rename_bindings(Ren, []) -> {[], Ren}; +rename_bindings(Ren, [X | Xs]) -> + {Z, Ren1} = rename_binding(Ren, X), + {Zs, Ren2} = rename_bindings(Ren1, Xs), + {[Z | Zs], Ren2}. + +rename_fpats(Ren, []) -> {[], Ren}; +rename_fpats(Ren, [P | Ps]) -> + {Q, Ren1} = rename_fpat(Ren, P), + {Qs, Ren2} = rename_fpats(Ren1, Ps), + {[Q | Qs], Ren2}. + +rename_fpat(Ren, P = {bool, _}) -> {P, Ren}; +rename_fpat(Ren, P = {int, _}) -> {P, Ren}; +rename_fpat(Ren, P = {string, _}) -> {P, Ren}; +rename_fpat(Ren, P = nil) -> {P, Ren}; +rename_fpat(Ren, {'::', P, Q}) -> + {P1, Ren1} = rename_fpat(Ren, P), + {Q1, Ren2} = rename_fpat(Ren1, Q), + {{'::', P1, Q1}, Ren2}; +rename_fpat(Ren, {var, X}) -> + {Z, Ren1} = rename_binding(Ren, X), + {{var, Z}, Ren1}; +rename_fpat(Ren, {con, Ar, C, Ps}) -> + {Ps1, Ren1} = rename_fpats(Ren, Ps), + {{con, Ar, C, Ps1}, Ren1}; +rename_fpat(Ren, {tuple, Ps}) -> + {Ps1, Ren1} = rename_fpats(Ren, Ps), + {{tuple, Ps1}, Ren1}. + +rename_spat(Ren, P = {bool, _}) -> {P, Ren}; +rename_spat(Ren, P = {int, _}) -> {P, Ren}; +rename_spat(Ren, P = {string, _}) -> {P, Ren}; +rename_spat(Ren, P = nil) -> {P, Ren}; +rename_spat(Ren, {'::', X, Y}) -> + {X1, Ren1} = rename_binding(Ren, X), + {Y1, Ren2} = rename_binding(Ren1, Y), + {{'::', X1, Y1}, Ren2}; +rename_spat(Ren, {var, X}) -> + {Z, Ren1} = rename_binding(Ren, X), + {{var, Z}, Ren1}; +rename_spat(Ren, {con, Ar, C, Xs}) -> + {Zs, Ren1} = rename_bindings(Ren, Xs), + {{con, Ar, C, Zs}, Ren1}; +rename_spat(Ren, {tuple, Xs}) -> + {Zs, Ren1} = rename_bindings(Ren, Xs), + {{tuple, Zs}, Ren1}. + +rename_split(Ren, {split, Type, X, Cases}) -> + {split, Type, rename_var(Ren, X), [rename_case(Ren, C) || C <- Cases]}; +rename_split(Ren, {nosplit, E}) -> {nosplit, rename(Ren, E)}. + +rename_case(Ren, {'case', Pat, Split}) -> + {Pat1, Ren1} = rename_spat(Ren, Pat), + {'case', Pat1, rename_split(Ren1, Split)}. + %% -- Records -- field_index({typed, _, _, RecTy}, X) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index f94982f..089e5d1 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -395,8 +395,18 @@ match_tuple(Env, _, _, _, []) -> binop_to_scode('+') -> aeb_fate_code:add(?a, ?a, ?a); binop_to_scode('-') -> aeb_fate_code:sub(?a, ?a, ?a); +binop_to_scode('*') -> aeb_fate_code:mul(?a, ?a, ?a); +binop_to_scode('/') -> aeb_fate_code:divide(?a, ?a, ?a); +binop_to_scode(mod) -> aeb_fate_code:modulo(?a, ?a, ?a); +binop_to_scode('^') -> aeb_fate_code:pow(?a, ?a, ?a); +binop_to_scode('++') -> aeb_fate_code:append(?a, ?a, ?a); +binop_to_scode('::') -> aeb_fate_code:cons(?a, ?a, ?a); +binop_to_scode('<') -> aeb_fate_code:lt(?a, ?a, ?a); +binop_to_scode('>') -> aeb_fate_code:gt(?a, ?a, ?a); +binop_to_scode('=<') -> aeb_fate_code:elt(?a, ?a, ?a); +binop_to_scode('>=') -> aeb_fate_code:egt(?a, ?a, ?a); binop_to_scode('==') -> aeb_fate_code:eq(?a, ?a, ?a); -binop_to_scode('::') -> aeb_fate_code:cons(?a, ?a, ?a). +binop_to_scode('!=') -> aeb_fate_code:neq(?a, ?a, ?a). unop_to_scode('!') -> aeb_fate_code:not_op(?a, ?a). @@ -586,7 +596,7 @@ attributes(I) -> {'HD', A, B} -> Pure(A, B); {'TL', A, B} -> Pure(A, B); {'LENGTH', A, B} -> Pure(A, B); - {'STR_EQ', A, B, C} -> Pure(A, [B, C]); + {'APPEND', A, B, C} -> Pure(A, [B, C]); {'STR_JOIN', A, B, C} -> Pure(A, [B, C]); {'INT_TO_STR', A, B} -> Pure(A, B); {'ADDR_TO_STR', A, B} -> Pure(A, B); -- 2.30.2 From 4a8fb5ba05d9837006e99f2156fe518d2c6d87a7 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 30 Apr 2019 13:27:55 +0200 Subject: [PATCH 63/87] Compile maps --- src/aeso_ast_to_fcode.erl | 31 +++++++++++++++++++++++++++++++ src/aeso_fcode_to_fate.erl | 18 ++++++++++++++++++ 2 files changed, 49 insertions(+) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 78488ce..f73d7a8 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -41,6 +41,10 @@ | {tuple, [fexpr()]} | {proj, fexpr(), integer()} | {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value + | map_empty + | {map_set, fexpr(), fexpr(), fexpr()} % map, key, val + | {map_get, fexpr(), fexpr()} % map, key + | {map_get, fexpr(), fexpr(), fexpr()} % map, key, default | {op, binop(), fexpr(), fexpr()} | {op, unop(), fexpr()} | {'let', var_name(), fexpr(), fexpr()} @@ -376,6 +380,33 @@ expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) -> expr_to_fcode(Env, _Type, {app, _Ann, Fun, Args}) -> {funcall, expr_to_fcode(Env, Fun), [expr_to_fcode(Env, Arg) || Arg <- Args]}; +%% Maps +expr_to_fcode(_Env, _Type, {map, _, []}) -> + 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). + Fields = [{field, Ann, [{map_get, Ann, K}], V} || {K, V} <- KVs], + expr_to_fcode(Env, Type, {map, Ann, {map, Ann, []}, Fields}); +expr_to_fcode(Env, _Type, {map, _, Map, KVs}) -> + X = fresh_name(), + Map1 = {var, [X]}, + {'let', X, expr_to_fcode(Env, Map), + lists:foldr(fun(Fld, M) -> + case Fld of + {field, _, [{map_get, _, K}], V} -> + {map_set, M, expr_to_fcode(Env, K), expr_to_fcode(Env, V)}; + {field_upd, _, [{map_get, _, K}], {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], V}, _}} -> + Y = fresh_name(), + {'let', Y, expr_to_fcode(Env, K), + {'let', Z, {map_get, Map1, {var, [Y]}}, + {map_set, M, {var, [Y]}, expr_to_fcode(Env, V)}}} + end end, Map1, KVs)}; +expr_to_fcode(Env, _Type, {map_get, _, Map, Key}) -> + {map_get, expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)}; +expr_to_fcode(Env, _Type, {map_get, _, Map, Key, Def}) -> + {map_get, expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)}; + 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 089e5d1..d14b49b 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -249,6 +249,24 @@ to_scode(Env, {op, Op, A}) -> [ to_scode(notail(Env), A), unop_to_scode(Op) ]; +%% Maps +to_scode(_Env, map_empty) -> + [aeb_fate_code:map_empty(?a)]; +to_scode(Env, {map_set, Map, Key, Val}) -> + [to_scode(notail(Env), Val), + to_scode(notail(Env), Key), + to_scode(notail(Env), Map), + aeb_fate_code:map_update(?a, ?a, ?a, ?a)]; +to_scode(Env, {map_get, Map, Key}) -> + [to_scode(notail(Env), Key), + to_scode(notail(Env), Map), + aeb_fate_code:map_lookup(?a, ?a, ?a)]; +to_scode(Env, {map_get, Map, Key, Default}) -> + [to_scode(notail(Env), Default), + to_scode(notail(Env), Key), + to_scode(notail(Env), Map), + aeb_fate_code:map_lookup(?a, ?a, ?a, ?a)]; + to_scode(Env, {'let', X, {var, Y}, Body}) -> Env1 = bind_var(X, lookup_var(Env, Y), Env), to_scode(Env1, Body); -- 2.30.2 From ef120a71941104909f55ae13661368d5646ce0b4 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 08:49:17 +0200 Subject: [PATCH 64/87] Simplify JUMPIF on true/false --- src/aeso_fcode_to_fate.erl | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index d14b49b..572a4e1 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -1137,10 +1137,13 @@ block(Blk = #blk{code = [{switch, Arg, Type, Alts, Default} | Code], _ -> FalseCode ++ [{jump, RestRef}] end, case lists:usort(Alts) == [missing] of - true -> - {Blk#blk{code = [{jump, DefRef}]}, [], []}; + true -> {Blk#blk{code = [{jump, DefRef}]}, [], []}; false -> - {Blk#blk{code = ElseCode}, [{jumpif, Arg, ThenRef}], ThenBlk} + case Arg of + ?i(false) -> {Blk#blk{code = ElseCode}, [], ThenBlk}; + ?i(true) -> {Blk#blk{code = []}, [{jump, ThenRef}], ThenBlk}; + _ -> {Blk#blk{code = ElseCode}, [{jumpif, Arg, ThenRef}], ThenBlk} + end end; tuple -> [TCode] = Alts, -- 2.30.2 From b5330882ba78e733cf2ed4b6d7a88e46385da4fc Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 08:56:49 +0200 Subject: [PATCH 65/87] Fixed left-over reference to STR_EQ --- src/aeso_fcode_to_fate.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 572a4e1..75e5e5f 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -70,7 +70,7 @@ Op =:= 'HD' orelse Op =:= 'TL' orelse Op =:= 'LENGTH' orelse - Op =:= 'STR_EQ' orelse + Op =:= 'APPEND' orelse Op =:= 'STR_JOIN' orelse Op =:= 'INT_TO_STR' orelse Op =:= 'ADDR_TO_STR' orelse -- 2.30.2 From 1d39464190893c26d59f631770eeeb489711876d Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 09:06:44 +0200 Subject: [PATCH 66/87] Add compile-time evaluation for more operators --- src/aeso_fcode_to_fate.erl | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 75e5e5f..c7851ca 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -888,8 +888,20 @@ r_constant_propagation({i, Ann, I}, Code) -> end; r_constant_propagation(_, _) -> false. -eval_op('EQ', [X, Y]) -> X =:= Y; %% TODO: more -eval_op(_, _) -> no_eval. +eval_op('ADD', [X, Y]) -> X + Y; +eval_op('SUB', [X, Y]) -> X - Y; +eval_op('MUL', [X, Y]) -> X * Y; +eval_op('DIV', [X, Y]) when Y /= 0 -> X div Y; +eval_op('MOD', [X, Y]) when Y /= 0 -> X rem Y; +eval_op('POW', [_, _]) -> no_eval; +eval_op('LT', [X, Y]) -> X < Y; +eval_op('GT', [X, Y]) -> X > Y; +eval_op('EQ', [X, Y]) -> X =:= Y; +eval_op('ELT', [X, Y]) -> X =< Y; +eval_op('EGT', [X, Y]) -> X >= Y; +eval_op('NEQ', [X, Y]) -> X =/= Y; +eval_op('NOT', [X]) -> not X; +eval_op(_, _) -> no_eval. %% TODO: bits? %% Prune impossible branches from switches r_prune_impossible_branches({switch, ?i(V), Type, Alts, missing}, Code) -> -- 2.30.2 From 6f17477c7298485589427f74cc99bec485682346 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 10:16:55 +0200 Subject: [PATCH 67/87] Distinguish local vars and top-level names already in fcode --- src/aeso_ast_to_fcode.erl | 80 +++++++++++++++++++++++++++----------- src/aeso_fcode_to_fate.erl | 54 ++++++++----------------- 2 files changed, 74 insertions(+), 60 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index f73d7a8..8b99401 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -36,7 +36,8 @@ | {oracle_query_id, binary()} | {bool, false | true} | nil - | {var, sophia_name()} + | {var, var_name()} + | {def, fun_name()} | {con, arities(), tag(), [fexpr()]} | {tuple, [fexpr()]} | {proj, fexpr(), integer()} @@ -113,6 +114,7 @@ con_env := con_env(), options := [option()], context => context(), + vars => [var_name()], functions := #{ fun_name() => fun_def() } }. %% -- Entrypoint ------------------------------------------------------------- @@ -197,7 +199,7 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R Attrs = get_attributes(Ann), FName = lookup_fun(Env, qname(Env, Name)), FArgs = args_to_fcode(Env, Args), - FBody = expr_to_fcode(Env, Body), + FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body), %% io:format("Body of ~s:\n~s\n", [Name, format_fexpr(FBody)]), Def = #{ attrs => Attrs, args => FArgs, @@ -279,8 +281,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, {qid, _, X}) -> {var, X}; +expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]); +expr_to_fcode(Env, _Type, {qid, _, X}) -> resolve_var(Env, X); %% Constructors expr_to_fcode(Env, Type, {C, _, _} = Con) when C == con; C == qcon -> @@ -311,20 +313,21 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> X = fresh_name(), - Proj = fun(I) -> {proj, {var, [X]}, I - 1} end, + Proj = fun(I) -> {proj, {var, X}, I - 1} end, Comp = fun({I, false}) -> Proj(I); ({_, {set, E}}) -> expr_to_fcode(Env, E); ({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(Env, E)} end, Set = fun({_, false}, R) -> R; ({I, {set, E}}, R) -> {set_proj, R, I - 1, expr_to_fcode(Env, E)}; - ({I, {upd, Z, E}}, R) -> {set_proj, R, I - 1, {'let', Z, Proj(I), expr_to_fcode(Env, E)}} + ({I, {upd, Z, E}}, R) -> {set_proj, R, I - 1, + {'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)}} end, Expand = length(Fields) == length(FieldTypes), Updates = [ {I, field_value(FT, Fields)} || {I, FT} <- indexed(FieldTypes) ], Body = case Expand of true -> {tuple, lists:map(Comp, Updates)}; - false -> lists:foldr(Set, {var, [X]}, Updates) + false -> lists:foldr(Set, {var, X}, Updates) end, {'let', X, expr_to_fcode(Env, Rec), Body}; @@ -341,7 +344,7 @@ expr_to_fcode(Env, _Type, {'if', _, Cond, Then, Else}) -> {'case', {bool, true}, {nosplit, expr_to_fcode(Env, Then)}}]}} end, case Cond of - {var, [X]} -> Switch(X); + {var, X} -> Switch(X); _ -> X = fresh_name(), {'let', X, expr_to_fcode(Env, Cond), Switch(X)} @@ -390,7 +393,7 @@ expr_to_fcode(Env, Type, {map, Ann, KVs}) -> expr_to_fcode(Env, Type, {map, Ann, {map, Ann, []}, Fields}); expr_to_fcode(Env, _Type, {map, _, Map, KVs}) -> X = fresh_name(), - Map1 = {var, [X]}, + Map1 = {var, X}, {'let', X, expr_to_fcode(Env, Map), lists:foldr(fun(Fld, M) -> case Fld of @@ -399,8 +402,8 @@ expr_to_fcode(Env, _Type, {map, _, Map, KVs}) -> {field_upd, _, [{map_get, _, K}], {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], V}, _}} -> Y = fresh_name(), {'let', Y, expr_to_fcode(Env, K), - {'let', Z, {map_get, Map1, {var, [Y]}}, - {map_set, M, {var, [Y]}, expr_to_fcode(Env, V)}}} + {'let', Z, {map_get, Map1, {var, Y}}, + {map_set, M, {var, Y}, expr_to_fcode(bind_var(Env, Z), V)}}} end end, Map1, KVs)}; expr_to_fcode(Env, _Type, {map_get, _, Map, Key}) -> {map_get, expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)}; @@ -548,7 +551,9 @@ next_split(Pats) -> -spec alt_to_fcode(env(), aeso_syntax:alt()) -> falt(). alt_to_fcode(Env, {'case', _, Pat, Expr}) -> - {'case', [pat_to_fcode(Env, Pat)], expr_to_fcode(Env, Expr)}. + FPat = pat_to_fcode(Env, Pat), + FExpr = expr_to_fcode(bind_vars(Env, pat_vars(FPat)), Expr), + {'case', [FPat], FExpr}. -spec pat_to_fcode(env(), aeso_syntax:pat()) -> fpat(). pat_to_fcode(Env, {typed, _, Pat, Type}) -> @@ -618,18 +623,18 @@ decision_tree_to_fcode({'if', A, Then, Else}) -> -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> - {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(Env, Stmts)}; + {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)}; stmts_to_fcode(Env, [Expr]) -> expr_to_fcode(Env, Expr). %% -- Optimisations ---------------------------------------------------------- -%% - Translate && and || to ifte %% - Deadcode elimination %% - Unused variable analysis (replace by _) %% - Case specialization %% - Constant propagation +%% - Inlining -spec optimize_fcode(fcode()) -> fcode(). optimize_fcode(Code = #{ functions := Funs }) -> @@ -722,6 +727,24 @@ lookup_con(#{ con_env := ConEnv }, Con) -> Tag -> Tag end. +bind_vars(Env, Xs) -> + lists:foldl(fun(X, E) -> bind_var(E, X) end, Env, Xs). + +bind_var(Env = #{ vars := Vars }, X) -> Env#{ vars := [X | Vars] }. + +resolve_var(#{ vars := Vars } = Env, [X]) -> + case lists:member(X, Vars) of + true -> {var, X}; + false -> resolve_fun(Env, [X]) + end; +resolve_var(Env, Q) -> resolve_fun(Env, Q). + +resolve_fun(#{ fun_env := Funs }, Q) -> + case maps:get(Q, Funs, not_found) of + not_found -> fcode_error({unbound_variable, Q}); + Fun -> {def, Fun} + end. + init_fresh_names() -> put('%fresh', 0). @@ -734,6 +757,17 @@ fresh_name() -> put('%fresh', N + 1), lists:concat(["%", N]). +-spec pat_vars(fpat()) -> [var_name()]. +pat_vars({var, X}) -> [X || X /= "_"]; +pat_vars({bool, _}) -> []; +pat_vars({int, _}) -> []; +pat_vars({string, _}) -> []; +pat_vars(nil) -> []; +pat_vars({'::', P, Q}) -> pat_vars(P) ++ pat_vars(Q); +pat_vars({tuple, Ps}) -> pat_vars(Ps); +pat_vars({con, _, _, Ps}) -> pat_vars(Ps); +pat_vars(Ps) when is_list(Ps) -> [X || P <- Ps, X <- pat_vars(P)]. + %% -- Renaming -- -spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). @@ -747,8 +781,8 @@ rename(Ren, Expr) -> {oracle_pubkey, _} -> Expr; {oracle_query_id, _} -> Expr; nil -> nil; - {var, [X]} -> {var, [rename_var(Ren, X)]}; - {var, _} -> Expr; + {var, X} -> {var, rename_var(Ren, X)}; + {def, _} -> Expr; {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}; @@ -899,8 +933,10 @@ pp_fexpr({Tag, Lit}) when Tag == int; aeso_pretty:expr({Tag, [], Lit}); pp_fexpr(nil) -> pp_text("[]"); -pp_fexpr({var, X}) -> - pp_text(X); +pp_fexpr({var, X}) -> pp_text(X); +pp_fexpr({def, {entrypoint, E}}) -> pp_text(E); +pp_fexpr({def, {local_fun, Q}}) -> pp_text(string:join(Q, ".")); +pp_fexpr({def, {builtin, B}}) -> pp_text(B); pp_fexpr({con, _, I, []}) -> pp_beside(pp_text("C"), pp_text(I)); pp_fexpr({con, _, I, Es}) -> @@ -945,9 +981,9 @@ pp_case({'case', Pat, Split}) -> prettypr:sep([pp_beside(pp_pat(Pat), pp_text(" =>")), prettypr:nest(2, pp_split(Split))]). -pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, [X]} || X <- Xs]}); -pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', {var, [X]}, {var, [Xs]}}); -pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, [X]} || X <- Xs]}); -pp_pat({var, X}) -> pp_fexpr({var, [X]}); +pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); +pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', {var, X}, {var, Xs}}); +pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, X} || X <- Xs]}); +pp_pat({var, X}) -> pp_fexpr({var, X}); pp_pat(Pat) -> pp_fexpr(Pat). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index c7851ca..8ef2e13 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -149,7 +149,7 @@ type_to_scode(T) -> T. %% -- Environment functions -- init_env(ContractName, FunNames, Args) -> - #env{ vars = [ {[X], {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], + #env{ vars = [ {X, {arg, I}} || {I, {X, _}} <- with_ixs(Args) ], contract = ContractName, locals = FunNames, tailpos = true }. @@ -158,7 +158,7 @@ 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), @@ -168,28 +168,10 @@ notail(Env) -> Env#env{ tailpos = false }. 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) -> +lookup_var(#env{vars = Vars}, X) -> case lists:keyfind(X, 1, Vars) of - {_, 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 + {_, Var} -> Var; + false -> code_error({unbound_variable, X, Vars}) end. %% -- The compiler -- @@ -278,21 +260,17 @@ to_scode(Env, {'let', X, Expr, 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}) + {var, _} -> + ?TODO({funcall, Fun}); + {def, {builtin, _}} -> + ?TODO({funcall, Fun}); + {def, Def} -> + FName = make_function_name(Def), + Lbl = aeb_fate_data:make_string(FName), + 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 ] end; to_scode(Env, {switch, Case}) -> -- 2.30.2 From 1f40d2a321042ecf5ab37a0cfc3b1e8537be9091 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 12:28:57 +0200 Subject: [PATCH 68/87] Compile builtins --- src/aeso_ast_to_fcode.erl | 150 +++++++++++++++++++++++++------ src/aeso_fcode_to_fate.erl | 175 ++++++++++++++++++++++++++++--------- 2 files changed, 257 insertions(+), 68 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 8b99401..1fac9ba 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -24,9 +24,13 @@ -type var_name() :: string(). -type sophia_name() :: [string()]. --type binop() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' | - '<' | '>' | '=<' | '>=' | '==' | '!='. --type unop() :: '!'. +-type builtin() :: atom(). + +-type op() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' | + '<' | '>' | '=<' | '>=' | '==' | '!=' | '!' | + map_from_list | map_to_list | map_delete | map_member | map_size | + string_length | string_concat | bits_set | bits_clear | bits_test | + bits_sum | bits_intersection | bits_union | bits_difference. -type fexpr() :: {int, integer()} | {string, binary()} @@ -38,6 +42,8 @@ | nil | {var, var_name()} | {def, fun_name()} + | {builtin, builtin(), non_neg_integer() | none} %% Unapplied builtin + | {builtin, builtin(), [fexpr()]} | {con, arities(), tag(), [fexpr()]} | {tuple, [fexpr()]} | {proj, fexpr(), integer()} @@ -46,8 +52,7 @@ | {map_set, fexpr(), fexpr(), fexpr()} % map, key, val | {map_get, fexpr(), fexpr()} % map, key | {map_get, fexpr(), fexpr(), fexpr()} % map, key, default - | {op, binop(), fexpr(), fexpr()} - | {op, unop(), fexpr()} + | {op, op(), [fexpr()]} | {'let', var_name(), fexpr(), fexpr()} | {funcall, fexpr(), [fexpr()]} | {switch, fsplit()}. @@ -104,6 +109,7 @@ -type type_env() :: #{ sophia_name() => type_def() }. -type fun_env() :: #{ sophia_name() => fun_name() }. -type con_env() :: #{ sophia_name() => con_tag() }. +-type builtins() :: #{ sophia_name() => {builtin(), non_neg_integer() | none} }. -type context() :: {main_contract, string()} | {namespace, string()} @@ -112,6 +118,7 @@ -type env() :: #{ type_env := type_env(), fun_env := fun_env(), con_env := con_env(), + builtins := builtins(), options := [option()], context => context(), vars => [var_name()], @@ -130,13 +137,47 @@ ast_to_fcode(Code, Options) -> -spec init_env([option()]) -> env(). init_env(Options) -> #{ type_env => init_type_env(), - fun_env => #{}, %% TODO: builtin functions here? - con_env => #{["None"] => #con_tag{ tag = 0, arities = [0, 1] }, - ["Some"] => #con_tag{ tag = 1, arities = [0, 1] } + fun_env => #{}, + builtins => builtins(), + con_env => #{["None"] => #con_tag{ tag = 0, arities = [0, 1] }, + ["Some"] => #con_tag{ tag = 1, arities = [0, 1] }, + ["RelativeTTL"] => #con_tag{ tag = 0, arities = [1, 1] }, + ["FixedTTL"] => #con_tag{ tag = 1, arities = [1, 1] } }, options => Options, functions => #{} }. +-spec builtins() -> builtins(). +builtins() -> + MkName = fun(NS, Fun) -> + list_to_atom(string:to_lower(string:join(NS ++ [Fun], "_"))) + end, + Scopes = [{[], [{"abort", 1}]}, + {["Chain"], [{"spend", 2}, {"balance", 1}, {"block_hash", 1}, {"coinbase", none}, + {"timestamp", none}, {"block_height", none}, {"difficulty", none}, + {"gas_limit", none}]}, + {["Contract"], [{"address", none}, {"balance", none}]}, + {["Call"], [{"origin", none}, {"caller", none}, {"value", none}, {"gas_price", none}, + {"gas_left", 0}]}, + {["Oracle"], [{"register", 4}, {"query_fee", 1}, {"query", 5}, {"get_question", 2}, + {"respond", 4}, {"extend", 3}, {"get_answer", 2}]}, + {["AENS"], [{"resolve", 2}, {"preclaim", 3}, {"claim", 4}, {"transfer", 4}, + {"revoke", 3}]}, + {["Map"], [{"from_list", 1}, {"to_list", 1}, {"lookup", 2}, + {"lookup_default", 3}, {"delete", 2}, {"member", 2}, {"size", 1}]}, + {["Crypto"], [{"ecverify", 3}, {"ecverify_secp256k1", 3}, {"sha3", 1}, + {"sha256", 1}, {"blake2b", 1}]}, + {["Auth"], [{"tx_hash", none}]}, + {["String"], [{"length", 1}, {"concat", 2}, {"sha3", 1}, {"sha256", 1}, {"blake2b", 1}]}, + {["Bits"], [{"set", 2}, {"clear", 2}, {"test", 2}, {"sum", 1}, {"intersection", 2}, + {"union", 2}, {"difference", 2}, {"none", none}, {"all", none}]}, + {["Int"], [{"to_str", 1}]}, + {["Address"], [{"to_str", 1}]} + ], + maps:from_list([ {NS ++ [Fun], {MkName(NS, Fun), Arity}} + || {NS, Funs} <- Scopes, + {Fun, Arity} <- Funs ]). + -define(type(T), fun([]) -> T end). -define(type(X, T), fun([X]) -> T end). -define(type(X, Y, T), fun([X, Y]) -> T end). @@ -333,7 +374,7 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> %% Lists expr_to_fcode(Env, _Type, {list, _, Es}) -> - lists:foldr(fun(E, L) -> {op, '::', expr_to_fcode(Env, E), L} end, + lists:foldr(fun(E, L) -> {op, '::', [expr_to_fcode(Env, E), L]} end, nil, Es); %% Conditionals @@ -372,16 +413,25 @@ expr_to_fcode(Env, _Type, Expr = {app, _, {Op, _}, [_, _]}) when Op == '&&'; Op Tree = expr_to_decision_tree(Env, Expr), decision_tree_to_fcode(Tree); expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> - {op, Op, expr_to_fcode(Env, A), expr_to_fcode(Env, B)}; + {op, Op, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]}; expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) -> case Op of - '-' -> {op, '-', {int, 0}, expr_to_fcode(Env, A)}; - '!' -> {op, '!', expr_to_fcode(Env, A)} + '-' -> {op, '-', [{int, 0}, expr_to_fcode(Env, A)]}; + '!' -> {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, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT, _, _}}, Args}) -> + 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) -> + case length(FArgs) of + N when N == Ar -> builtin_to_fcode(B, FArgs); + N when N < Ar -> error({todo, eta_expand, B, FArgs}) + end; + FFun -> {funcall, FFun, FArgs} + end; %% Maps expr_to_fcode(_Env, _Type, {map, _, []}) -> @@ -628,6 +678,24 @@ stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) - stmts_to_fcode(Env, [Expr]) -> expr_to_fcode(Env, Expr). +%% -- Builtins -- + +op_builtins() -> + [map_from_list, map_to_list, map_delete, map_member, map_size, + string_length, string_concat, string_sha3, string_sha256, string_blake2b, + bits_set, bits_clear, bits_test, bits_sum, bits_intersection, bits_union, + bits_difference, int_to_str, address_to_str]. + +builtin_to_fcode(map_lookup, [Key, Map]) -> + {map_get, Map, Key}; +builtin_to_fcode(map_lookup_default, [Key, Map, Def]) -> + {map_get, Map, Key, Def}; +builtin_to_fcode(Builtin, Args) -> + case lists:member(Builtin, op_builtins()) of + true -> {op, Builtin, Args}; + false -> {builtin, Builtin, Args} + end. + %% -- Optimisations ---------------------------------------------------------- %% - Deadcode elimination @@ -739,9 +807,10 @@ resolve_var(#{ vars := Vars } = Env, [X]) -> end; resolve_var(Env, Q) -> resolve_fun(Env, Q). -resolve_fun(#{ fun_env := Funs }, Q) -> - case maps:get(Q, Funs, not_found) of +resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) -> + case maps:get(Q, maps:merge(Funs, Builtin), not_found) of not_found -> fcode_error({unbound_variable, Q}); + {B, Ar} -> {builtin, B, Ar}; Fun -> {def, Fun} end. @@ -768,6 +837,19 @@ pat_vars({tuple, Ps}) -> pat_vars(Ps); pat_vars({con, _, _, Ps}) -> pat_vars(Ps); pat_vars(Ps) when is_list(Ps) -> [X || P <- Ps, X <- pat_vars(P)]. +get_named_args(NamedArgsT, Args) -> + IsNamed = fun({named_arg, _, _, _}) -> true; + (_) -> false end, + {Named, NotNamed} = lists:partition(IsNamed, Args), + NamedArgs = [get_named_arg(NamedArg, Named) || NamedArg <- NamedArgsT], + NamedArgs ++ NotNamed. + +get_named_arg({named_arg_t, _, {id, _, Name}, _, Default}, Args) -> + case [ Val || {named_arg, _, {id, _, X}, Val} <- Args, X == Name ] of + [Val] -> Val; + [] -> Default + end. + %% -- Renaming -- -spec rename([{var_name(), var_name()}], fexpr()) -> fexpr(). @@ -787,8 +869,7 @@ rename(Ren, Expr) -> {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, E1, E2} -> {op, Op, rename(Ren, E1), rename(Ren, E2)}; - {op, Op, E} -> {op, Op, rename(Ren, E)}; + {op, Op, Es} -> {op, Op, [rename(Ren, E) || E <- Es]}; {funcall, Fun, Es} -> {funcall, Fun, [rename(Ren, E) || E <- Es]}; {'let', X, E, Body} -> {Z, Ren1} = rename_binding(Ren, X), @@ -936,7 +1017,6 @@ pp_fexpr(nil) -> pp_fexpr({var, X}) -> pp_text(X); pp_fexpr({def, {entrypoint, E}}) -> pp_text(E); pp_fexpr({def, {local_fun, Q}}) -> pp_text(string:join(Q, ".")); -pp_fexpr({def, {builtin, B}}) -> pp_text(B); pp_fexpr({con, _, I, []}) -> pp_beside(pp_text("C"), pp_text(I)); pp_fexpr({con, _, I, Es}) -> @@ -948,17 +1028,33 @@ pp_fexpr({proj, E, I}) -> pp_beside([pp_fexpr(E), pp_text("."), pp_text(I)]); pp_fexpr({set_proj, E, I, A}) -> pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_text(I), pp_text(" = "), pp_fexpr(A)]))); -pp_fexpr({op, Op, A, B}) -> - pp_parens(pp_par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])); -pp_fexpr({op, Op, A}) -> - pp_parens(pp_par([pp_text(Op), pp_fexpr(A)])); +pp_fexpr({op, Op, [A, B] = Args}) -> + case is_infix(Op) of + false -> pp_call(pp_text(Op), Args); + true -> pp_parens(pp_par([pp_fexpr(A), pp_text(Op), pp_fexpr(B)])) + end; +pp_fexpr({op, Op, [A] = Args}) -> + case is_infix(Op) of + false -> pp_call(pp_text(Op), Args); + true -> pp_parens(pp_par([pp_text(Op), pp_fexpr(A)])) + end; +pp_fexpr({op, Op, As}) -> + pp_beside(pp_text(Op), pp_fexpr({tuple, 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_beside([pp_text(B), pp_text("/"), pp_text(N)]); +pp_fexpr({builtin, B, As}) when is_list(As) -> + pp_call(pp_text(B), As); pp_fexpr({funcall, Fun, As}) -> - pp_beside(pp_fexpr(Fun), pp_fexpr({tuple, As})); + pp_call(pp_fexpr(Fun), As); pp_fexpr({switch, Split}) -> pp_split(Split). +pp_call(Fun, Args) -> + pp_beside(Fun, pp_fexpr({tuple, Args})). + pp_ftype(T) when is_atom(T) -> pp_text(T); pp_ftype({tuple, Ts}) -> pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); @@ -982,8 +1078,12 @@ pp_case({'case', Pat, Split}) -> prettypr:nest(2, pp_split(Split))]). pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); -pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', {var, X}, {var, Xs}}); +pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', [{var, X}, {var, Xs}]}); pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, X} || X <- Xs]}); pp_pat({var, X}) -> pp_fexpr({var, X}); pp_pat(Pat) -> pp_fexpr(Pat). +is_infix(Op) -> + C = hd(atom_to_list(Op)), + C < $a orelse C > $z. + diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 8ef2e13..1115f87 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -223,31 +223,20 @@ to_scode(Env, {set_proj, R, I, E}) -> to_scode(notail(Env), R), aeb_fate_code:setelement(?a, ?i(I), ?a, ?a)]; -to_scode(Env, {op, Op, A, B}) -> - [ to_scode(notail(Env), B), - to_scode(notail(Env), A), - binop_to_scode(Op) ]; -to_scode(Env, {op, Op, A}) -> - [ to_scode(notail(Env), A), - unop_to_scode(Op) ]; +to_scode(Env, {op, Op, Args}) -> + call_to_scode(Env, op_to_scode(Op), Args); %% Maps to_scode(_Env, map_empty) -> [aeb_fate_code:map_empty(?a)]; to_scode(Env, {map_set, Map, Key, Val}) -> - [to_scode(notail(Env), Val), - to_scode(notail(Env), Key), - to_scode(notail(Env), Map), - aeb_fate_code:map_update(?a, ?a, ?a, ?a)]; + call_to_scode(Env, aeb_fate_code:map_update(?a, ?a, ?a, ?a), + [Map, Key, Val]); to_scode(Env, {map_get, Map, Key}) -> - [to_scode(notail(Env), Key), - to_scode(notail(Env), Map), - aeb_fate_code:map_lookup(?a, ?a, ?a)]; + call_to_scode(Env, aeb_fate_code:map_lookup(?a, ?a, ?a), [Map, Key]); to_scode(Env, {map_get, Map, Key, Default}) -> - [to_scode(notail(Env), Default), - to_scode(notail(Env), Key), - to_scode(notail(Env), Map), - aeb_fate_code:map_lookup(?a, ?a, ?a, ?a)]; + call_to_scode(Env, aeb_fate_code:map_lookup(?a, ?a, ?a, ?a), + [Map, Key, Default]); to_scode(Env, {'let', X, {var, Y}, Body}) -> Env1 = bind_var(X, lookup_var(Env, Y), Env), @@ -276,6 +265,9 @@ to_scode(Env, {funcall, Fun, Args}) -> to_scode(Env, {switch, Case}) -> split_to_scode(Env, Case); +to_scode(Env, {builtin, B, Args}) -> + builtin_to_scode(Env, B, Args); + to_scode(_Env, Icode) -> ?TODO(Icode). split_to_scode(Env, {nosplit, Expr}) -> @@ -387,24 +379,123 @@ match_tuple(Env, I, Elem, Arg, [X | Xs]) -> match_tuple(Env, _, _, _, []) -> {[], Env}. +%% -- Builtins -- + +call_to_scode(Env, CallCode, Args) -> + [[to_scode(notail(Env), A) || A <- lists:reverse(Args)], + CallCode]. + +builtin_to_scode(_Env, bits_none, none) -> + [aeb_fate_code:bits_none(?a)]; +builtin_to_scode(_Env, bits_all, none) -> + [aeb_fate_code:bits_all(?a)]; +builtin_to_scode(Env, abort, [_] = Args) -> + call_to_scode(Env, aeb_fate_code:abort(?a), Args); +builtin_to_scode(Env, chain_spend, [_, _] = Args) -> + call_to_scode(Env, [aeb_fate_code:spend(?a, ?a), + 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}]) -> + [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) -> + [aeb_fate_code:beneficiary(?a)]; +builtin_to_scode(_Env, chain_timestamp, none) -> + [aeb_fate_code:timestamp(?a)]; +builtin_to_scode(_Env, chain_block_height, none) -> + [aeb_fate_code:generation(?a)]; +builtin_to_scode(_Env, chain_difficulty, none) -> + [aeb_fate_code:difficulty(?a)]; +builtin_to_scode(_Env, chain_gas_limit, none) -> + [aeb_fate_code:gaslimit(?a)]; +builtin_to_scode(_Env, contract_balance, none) -> + [aeb_fate_code:balance(?a)]; +builtin_to_scode(_Env, contract_address, none) -> + [aeb_fate_code:address(?a)]; +builtin_to_scode(_Env, call_origin, none) -> + [aeb_fate_code:origin(?a)]; +builtin_to_scode(_Env, call_caller, none) -> + [aeb_fate_code:caller(?a)]; +builtin_to_scode(_Env, call_value, none) -> + ?TODO(fate_call_value_instruction); +builtin_to_scode(_Env, call_gas_price, none) -> + [aeb_fate_code:gasprice(?a)]; +builtin_to_scode(_Env, call_gas_left, []) -> + [aeb_fate_code:gas(?a)]; +builtin_to_scode(_Env, oracle_register, [_, _, _, _] = _Args) -> + ?TODO(fate_oracle_register_instruction); +builtin_to_scode(_Env, oracle_query_fee, [_] = _Args) -> + ?TODO(fate_oracle_query_fee_instruction); +builtin_to_scode(_Env, oracle_query, [_, _, _, _, _] = _Args) -> + ?TODO(fate_oracle_query_instruction); +builtin_to_scode(_Env, oracle_get_question, [_, _] = _Args) -> + ?TODO(fate_oracle_get_question_instruction); +builtin_to_scode(_Env, oracle_respond, [_, _, _, _] = _Args) -> + ?TODO(fate_oracle_respond_instruction); +builtin_to_scode(_Env, oracle_extend, [_, _, _] = _Args) -> + ?TODO(fate_oracle_extend_instruction); +builtin_to_scode(_Env, oracle_get_answer, [_, _] = _Args) -> + ?TODO(fate_oracle_get_answer_instruction); +builtin_to_scode(_Env, aens_resolve, [_, _] = _Args) -> + ?TODO(fate_aens_resolve_instruction); +builtin_to_scode(_Env, aens_preclaim, [_, _, _] = _Args) -> + ?TODO(fate_aens_preclaim_instruction); +builtin_to_scode(_Env, aens_claim, [_, _, _, _] = _Args) -> + ?TODO(fate_aens_claim_instruction); +builtin_to_scode(_Env, aens_transfer, [_, _, _, _] = _Args) -> + ?TODO(fate_aens_transfer_instruction); +builtin_to_scode(_Env, aens_revoke, [_, _, _] = _Args) -> + ?TODO(fate_aens_revoke_instruction); +builtin_to_scode(_Env, crypto_ecverify, [_, _, _] = _Args) -> + ?TODO(fate_crypto_ecverify_instruction); +builtin_to_scode(_Env, crypto_ecverify_secp256k1, [_, _, _] = _Args) -> + ?TODO(fate_crypto_ecverify_secp256k1_instruction); +builtin_to_scode(_Env, crypto_sha3, [_] = _Args) -> + ?TODO(fate_crypto_sha3_instruction); +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) -> + ?TODO(fate_auth_tx_hash_instruction); +builtin_to_scode(_, B, Args) -> + ?TODO({builtin, B, Args}). + %% -- Operators -- -binop_to_scode('+') -> aeb_fate_code:add(?a, ?a, ?a); -binop_to_scode('-') -> aeb_fate_code:sub(?a, ?a, ?a); -binop_to_scode('*') -> aeb_fate_code:mul(?a, ?a, ?a); -binop_to_scode('/') -> aeb_fate_code:divide(?a, ?a, ?a); -binop_to_scode(mod) -> aeb_fate_code:modulo(?a, ?a, ?a); -binop_to_scode('^') -> aeb_fate_code:pow(?a, ?a, ?a); -binop_to_scode('++') -> aeb_fate_code:append(?a, ?a, ?a); -binop_to_scode('::') -> aeb_fate_code:cons(?a, ?a, ?a); -binop_to_scode('<') -> aeb_fate_code:lt(?a, ?a, ?a); -binop_to_scode('>') -> aeb_fate_code:gt(?a, ?a, ?a); -binop_to_scode('=<') -> aeb_fate_code:elt(?a, ?a, ?a); -binop_to_scode('>=') -> aeb_fate_code:egt(?a, ?a, ?a); -binop_to_scode('==') -> aeb_fate_code:eq(?a, ?a, ?a); -binop_to_scode('!=') -> aeb_fate_code:neq(?a, ?a, ?a). - -unop_to_scode('!') -> aeb_fate_code:not_op(?a, ?a). +op_to_scode('+') -> aeb_fate_code:add(?a, ?a, ?a); +op_to_scode('-') -> aeb_fate_code:sub(?a, ?a, ?a); +op_to_scode('*') -> aeb_fate_code:mul(?a, ?a, ?a); +op_to_scode('/') -> aeb_fate_code:divide(?a, ?a, ?a); +op_to_scode(mod) -> aeb_fate_code:modulo(?a, ?a, ?a); +op_to_scode('^') -> aeb_fate_code:pow(?a, ?a, ?a); +op_to_scode('++') -> aeb_fate_code:append(?a, ?a, ?a); +op_to_scode('::') -> aeb_fate_code:cons(?a, ?a, ?a); +op_to_scode('<') -> aeb_fate_code:lt(?a, ?a, ?a); +op_to_scode('>') -> aeb_fate_code:gt(?a, ?a, ?a); +op_to_scode('=<') -> aeb_fate_code:elt(?a, ?a, ?a); +op_to_scode('>=') -> aeb_fate_code:egt(?a, ?a, ?a); +op_to_scode('==') -> aeb_fate_code:eq(?a, ?a, ?a); +op_to_scode('!=') -> aeb_fate_code:neq(?a, ?a, ?a); +op_to_scode('!') -> aeb_fate_code:not_op(?a, ?a); +op_to_scode(map_from_list) -> aeb_fate_code:map_from_list(?a, ?a); +op_to_scode(map_to_list) -> ?TODO(fate_map_to_list_instruction); +op_to_scode(map_delete) -> aeb_fate_code:map_delete(?a, ?a, ?a); +op_to_scode(map_member) -> aeb_fate_code:map_member(?a, ?a, ?a); +op_to_scode(map_size) -> ?TODO(fate_map_size_instruction); +op_to_scode(string_length) -> ?TODO(fate_string_length_instruction); +op_to_scode(string_concat) -> aeb_fate_code:str_join(?a, ?a, ?a); +op_to_scode(bits_set) -> aeb_fate_code:bits_set(?a, ?a, ?a); +op_to_scode(bits_clear) -> aeb_fate_code:bits_clear(?a, ?a, ?a); +op_to_scode(bits_test) -> aeb_fate_code:bits_test(?a, ?a, ?a); +op_to_scode(bits_sum) -> aeb_fate_code:bits_sum(?a, ?a); +op_to_scode(bits_intersection) -> aeb_fate_code:bits_and(?a, ?a, ?a); +op_to_scode(bits_union) -> aeb_fate_code:bits_or(?a, ?a, ?a); +op_to_scode(bits_difference) -> aeb_fate_code:bits_diff(?a, ?a, ?a); +op_to_scode(address_to_str) -> aeb_fate_code:addr_to_str(?a, ?a); +op_to_scode(int_to_str) -> aeb_fate_code:int_to_str(?a, ?a). %% PUSH and STORE ?a are the same, so we use STORE to make optimizations %% easier, and specialize to PUSH (which is cheaper) at the end. @@ -614,7 +705,8 @@ attributes(I) -> {'BITS_AND', A, B, C} -> Pure(A, [B, C]); {'BITS_DIFF', A, B, C} -> Pure(A, [B, C]); {'ADDRESS', A} -> Pure(A, []); - {'BALANCE', A} -> Pure(A, []); + {'BALANCE', A} -> Impure(A, []); + {'BALANCE_OTHER', A, B} -> Impure(A, [B]); {'ORIGIN', A} -> Pure(A, []); {'CALLER', A} -> Pure(A, []); {'GASPRICE', A} -> Pure(A, []); @@ -633,6 +725,7 @@ attributes(I) -> {'LOG4', A, B, C, D, E, F} -> Impure(none, [A, B, C, D, E, F]); 'DEACTIVATE' -> Impure(none, []); {'SPEND', A, B} -> Impure(none, [A, B]); + {'ORACLE_REGISTER', A, B, C, D, E, F} -> Impure(A, [B, C, D, E, F]); 'ORACLE_QUERY' -> Impure(?a, []); %% TODO 'ORACLE_RESPOND' -> Impure(?a, []); %% TODO @@ -1219,14 +1312,10 @@ chase_labels([L | Ls], Map, Live) -> chase_labels(New ++ Ls, Map, Live#{ L => true }). %% Replace PUSH, RETURN by RETURNR, drop returns after tail calls. -tweak_returns(['RETURN', {'PUSH', A} | Code]) -> - [{'RETURNR', A} | Code]; -%% tweak_returns(['RETURN', {'PUSH', A} | Code]) -> -%% [{'RETURNR', A} | Code]; -tweak_returns(['RETURN' | Code = [{'CALL_T', _} | _]]) -> - Code; -tweak_returns(['RETURN' | Code = [{'CALL_TR', _, _} | _]]) -> - Code; +tweak_returns(['RETURN', {'PUSH', A} | Code]) -> [{'RETURNR', A} | Code]; +tweak_returns(['RETURN' | Code = [{'CALL_T', _} | _]]) -> Code; +tweak_returns(['RETURN' | Code = [{'CALL_TR', _, _} | _]]) -> Code; +tweak_returns(['RETURN' | Code = [{'ABORT', _} | _]]) -> Code; tweak_returns(Code) -> Code. %% -- Split basic blocks at CALL instructions -- -- 2.30.2 From 2291f8d4c16792e91595beefb03a2ba0c1573455 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 16:54:03 +0200 Subject: [PATCH 69/87] Compile bytes(N) Compile to FATE strings for now --- src/aeso_ast_infer_types.erl | 2 +- src/aeso_ast_to_fcode.erl | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/src/aeso_ast_infer_types.erl b/src/aeso_ast_infer_types.erl index f157eb7..a24aaea 100644 --- a/src/aeso_ast_infer_types.erl +++ b/src/aeso_ast_infer_types.erl @@ -359,7 +359,7 @@ global_env() -> Fun1 = fun(S, T) -> Fun([S], T) end, TVar = fun(X) -> {tvar, Ann, "'" ++ X} end, SignId = {id, Ann, "signature"}, - SignDef = {tuple, Ann, [{int, Ann, 0}, {int, Ann, 0}]}, + SignDef = {bytes, Ann, <<0:64/unit:8>>}, Signature = {named_arg_t, Ann, SignId, SignId, {typed, Ann, SignDef, SignId}}, SignFun = fun(Ts, T) -> {type_sig, Ann, [Signature], Ts, T} end, TTL = {qid, Ann, ["Chain", "ttl"]}, diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 1fac9ba..57ab3b3 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -294,6 +294,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, {bytes_t, _, _N}) -> + string; %% TODO: add bytes type to FATE? type_to_fcode(_Env, Sub, {tvar, _, X}) -> maps:get(X, Sub, any); type_to_fcode(_Env, _Sub, Type) -> @@ -321,6 +323,8 @@ expr_to_fcode(_Env, _Type, {contract_pubkey, _, K}) -> {contract_pubkey, K}; expr_to_fcode(_Env, _Type, {oracle_pubkey, _, K}) -> {oracle_pubkey, K}; expr_to_fcode(_Env, _Type, {oracle_query_id, _, K}) -> {oracle_query_id, K}; +expr_to_fcode(_Env, _Type, {bytes, _, Bin}) -> {string, Bin}; + %% Variables expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]); expr_to_fcode(Env, _Type, {qid, _, X}) -> resolve_var(Env, X); -- 2.30.2 From 4371bf7db4c969efcc36c722a1e0927d91d09f9e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 16:54:33 +0200 Subject: [PATCH 70/87] Improve inlining of PUSH --- src/aeso_fcode_to_fate.erl | 40 ++++++++++++++++++++++++++++---------- 1 file changed, 30 insertions(+), 10 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 1115f87..2996b2e 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -861,16 +861,8 @@ r_push_consume({i, Ann1, {'STORE', ?a, A}}, [{i, Ann2, {'POP', B}} | Code]) -> true -> {[{i, merge_ann(Ann1, Ann2), {'STORE', B, A}}], Code}; false -> {[], Code} end; -r_push_consume({i, Ann1, {'STORE', ?a, A}}, [{i, Ann2, I} | Code]) -> - case op_view(I) of - {Op, R, As} -> - case lists:splitwith(fun(X) -> X /= ?a end, As) of - {_, []} -> false; - {As1, [?a | As2]} -> - {[{i, merge_ann(Ann1, Ann2), from_op_view(Op, R, As1 ++ [A] ++ As2)}], Code} - end; - _ -> false - end; +r_push_consume({i, Ann1, {'STORE', ?a, A}}, Code) -> + inline_push(Ann1, A, 0, Code, []); %% Writing directly to memory instead of going through the accumulator. r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) -> IsPush = @@ -886,6 +878,34 @@ r_push_consume({i, Ann1, I}, [{i, Ann2, {'STORE', R, ?a}} | Code]) -> true -> false end; r_push_consume(_, _) -> false. +inline_push(Ann, Arg, Stack, [switch_body | Code], Acc) -> + inline_push(Ann, Arg, Stack, Code, [switch_body | Acc]); +inline_push(Ann1, Arg, Stack, [{i, Ann2, I} = AI | Code], Acc) -> + case op_view(I) of + {Op, R, As} -> + Consumes = length([ ?a || ?a <- As ]), + Produces = length([ ?a || ?a == R ]), + case Consumes > Stack of + true -> + {As0, As1} = split_stack_arg(Stack, As), + Acc1 = [{i, merge_ann(Ann1, Ann2), from_op_view(Op, R, As0 ++ [Arg] ++ As1)} | Acc], + {lists:reverse(Acc1), Code}; + false -> + {AI1, {i, Ann1b, _}} = swap_instrs({i, Ann1, {'STORE', ?a, Arg}}, AI), + inline_push(Ann1b, Arg, Stack + Produces - Consumes, Code, [AI1 | Acc]) + end; + false -> false + end; +inline_push(_, _, _, _, _) -> false. + +split_stack_arg(N, As) -> split_stack_arg(N, As, []). +split_stack_arg(0, [?a | As], Acc) -> + {lists:reverse(Acc), As}; +split_stack_arg(N, [A | As], Acc) -> + N1 = if A == ?a -> N - 1; + true -> N end, + split_stack_arg(N1, As, [A | Acc]). + %% Changing PUSH A, DUPA to PUSH A, PUSH A enables further optimisations r_dup_to_push({i, Ann1, Push={'STORE', ?a, _}}, [{i, Ann2, 'DUPA'} | Code]) -> #{ live_in := LiveIn } = Ann1, -- 2.30.2 From c06e032199af5ca7fd45511aa5d594ad692e6d66 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Fri, 3 May 2019 17:01:09 +0200 Subject: [PATCH 71/87] Fix name resolution bug --- src/aeso_ast_to_fcode.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 57ab3b3..db3b3d9 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -812,10 +812,10 @@ resolve_var(#{ vars := Vars } = Env, [X]) -> resolve_var(Env, Q) -> resolve_fun(Env, Q). resolve_fun(#{ fun_env := Funs, builtins := Builtin }, Q) -> - case maps:get(Q, maps:merge(Funs, Builtin), not_found) of - not_found -> fcode_error({unbound_variable, Q}); - {B, Ar} -> {builtin, B, Ar}; - Fun -> {def, Fun} + 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, _} -> {def, Fun} end. init_fresh_names() -> -- 2.30.2 From ff0f2b57d2e2c04948e9b44f6057f05c9c735a6e Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 09:03:25 +0200 Subject: [PATCH 72/87] Change map_get/set to operators in fcode --- src/aeso_ast_to_fcode.erl | 27 ++++++++++++--------------- src/aeso_fcode_to_fate.erl | 17 +++++------------ 2 files changed, 17 insertions(+), 27 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index db3b3d9..a47a4c7 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -28,9 +28,10 @@ -type op() :: '+' | '-' | '*' | '/' | mod | '^' | '++' | '::' | '<' | '>' | '=<' | '>=' | '==' | '!=' | '!' | - map_from_list | map_to_list | map_delete | map_member | map_size | - string_length | string_concat | bits_set | bits_clear | bits_test | - bits_sum | bits_intersection | bits_union | bits_difference. + map_get | map_get_d | map_set | map_from_list | map_to_list | + map_delete | map_member | map_size | string_length | + string_concat | bits_set | bits_clear | bits_test | bits_sum | + bits_intersection | bits_union | bits_difference. -type fexpr() :: {int, integer()} | {string, binary()} @@ -48,10 +49,6 @@ | {tuple, [fexpr()]} | {proj, fexpr(), integer()} | {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value - | map_empty - | {map_set, fexpr(), fexpr(), fexpr()} % map, key, val - | {map_get, fexpr(), fexpr()} % map, key - | {map_get, fexpr(), fexpr(), fexpr()} % map, key, default | {op, op(), [fexpr()]} | {'let', var_name(), fexpr(), fexpr()} | {funcall, fexpr(), [fexpr()]} @@ -439,7 +436,7 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT, %% Maps expr_to_fcode(_Env, _Type, {map, _, []}) -> - map_empty; + {builtin, map_empty, none}; 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). @@ -452,17 +449,17 @@ expr_to_fcode(Env, _Type, {map, _, Map, KVs}) -> lists:foldr(fun(Fld, M) -> case Fld of {field, _, [{map_get, _, K}], V} -> - {map_set, M, expr_to_fcode(Env, K), expr_to_fcode(Env, V)}; + {op, map_set, [M, expr_to_fcode(Env, K), expr_to_fcode(Env, V)]}; {field_upd, _, [{map_get, _, K}], {typed, _, {lam, _, [{arg, _, {id, _, Z}, _}], V}, _}} -> Y = fresh_name(), {'let', Y, expr_to_fcode(Env, K), - {'let', Z, {map_get, Map1, {var, Y}}, - {map_set, M, {var, Y}, expr_to_fcode(bind_var(Env, Z), V)}}} + {'let', Z, {op, map_get, [Map1, {var, Y}]}, + {op, map_set, [M, {var, Y}, expr_to_fcode(bind_var(Env, Z), V)]}}} end end, Map1, KVs)}; expr_to_fcode(Env, _Type, {map_get, _, Map, Key}) -> - {map_get, expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)}; + {op, map_get, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key)]}; expr_to_fcode(Env, _Type, {map_get, _, Map, Key, Def}) -> - {map_get, expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)}; + {op, map_get_d, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)]}; expr_to_fcode(_Env, Type, Expr) -> error({todo, {Expr, ':', Type}}). @@ -691,9 +688,9 @@ op_builtins() -> bits_difference, int_to_str, address_to_str]. builtin_to_fcode(map_lookup, [Key, Map]) -> - {map_get, Map, Key}; + {op, map_get, [Map, Key]}; builtin_to_fcode(map_lookup_default, [Key, Map, Def]) -> - {map_get, Map, Key, Def}; + {op, map_get_d, [Map, Key, Def]}; builtin_to_fcode(Builtin, Args) -> case lists:member(Builtin, op_builtins()) of true -> {op, Builtin, Args}; diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 2996b2e..9372bff 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -226,18 +226,6 @@ to_scode(Env, {set_proj, R, I, E}) -> to_scode(Env, {op, Op, Args}) -> call_to_scode(Env, op_to_scode(Op), Args); -%% Maps -to_scode(_Env, map_empty) -> - [aeb_fate_code:map_empty(?a)]; -to_scode(Env, {map_set, Map, Key, Val}) -> - call_to_scode(Env, aeb_fate_code:map_update(?a, ?a, ?a, ?a), - [Map, Key, Val]); -to_scode(Env, {map_get, Map, Key}) -> - call_to_scode(Env, aeb_fate_code:map_lookup(?a, ?a, ?a), [Map, Key]); -to_scode(Env, {map_get, Map, Key, Default}) -> - call_to_scode(Env, aeb_fate_code:map_lookup(?a, ?a, ?a, ?a), - [Map, Key, Default]); - to_scode(Env, {'let', X, {var, Y}, Body}) -> Env1 = bind_var(X, lookup_var(Env, Y), Env), to_scode(Env1, Body); @@ -385,6 +373,8 @@ call_to_scode(Env, CallCode, Args) -> [[to_scode(notail(Env), A) || A <- lists:reverse(Args)], CallCode]. +builtin_to_scode(_Env, map_empty, none) -> + [aeb_fate_code:map_empty(?a)]; builtin_to_scode(_Env, bits_none, none) -> [aeb_fate_code:bits_none(?a)]; builtin_to_scode(_Env, bits_all, none) -> @@ -480,6 +470,9 @@ op_to_scode('>=') -> aeb_fate_code:egt(?a, ?a, ?a); op_to_scode('==') -> aeb_fate_code:eq(?a, ?a, ?a); op_to_scode('!=') -> aeb_fate_code:neq(?a, ?a, ?a); op_to_scode('!') -> aeb_fate_code:not_op(?a, ?a); +op_to_scode(map_get) -> aeb_fate_code:map_lookup(?a, ?a, ?a); +op_to_scode(map_get_d) -> aeb_fate_code:map_lookup(?a, ?a, ?a, ?a); +op_to_scode(map_set) -> aeb_fate_code:map_update(?a, ?a, ?a, ?a); op_to_scode(map_from_list) -> aeb_fate_code:map_from_list(?a, ?a); op_to_scode(map_to_list) -> ?TODO(fate_map_to_list_instruction); op_to_scode(map_delete) -> aeb_fate_code:map_delete(?a, ?a, ?a); -- 2.30.2 From 26b7c5bf1263cf2289cd3d2d0caaeeca2a2bf694 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 13:21:05 +0200 Subject: [PATCH 73/87] Compile lambdas and higher-order functions --- src/aeso_ast_to_fcode.erl | 183 ++++++++++++++++++++++++++++++++++--- src/aeso_fcode_to_fate.erl | 37 ++++---- 2 files changed, 189 insertions(+), 31 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index a47a4c7..958497e 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -42,7 +42,7 @@ | {bool, false | true} | nil | {var, var_name()} - | {def, fun_name()} + | {def, fun_name(), [fexpr()]} | {builtin, builtin(), non_neg_integer() | none} %% Unapplied builtin | {builtin, builtin(), [fexpr()]} | {con, arities(), tag(), [fexpr()]} @@ -51,7 +51,9 @@ | {set_proj, fexpr(), integer(), fexpr()} %% tuple, field, new_value | {op, op(), [fexpr()]} | {'let', var_name(), fexpr(), fexpr()} - | {funcall, 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(), non_neg_integer(), fexpr()} | {switch, fsplit()}. -type fsplit() :: {split, ftype(), var_name(), [fcase()]} @@ -83,6 +85,7 @@ | channel | bits | {variant, [[ftype()]]} + | {function, [ftype()], ftype()} | any. -type fun_def() :: #{ attrs := [attribute()], @@ -127,7 +130,14 @@ %% and produces Fate intermediate code. -spec ast_to_fcode(aeso_syntax:ast(), [option()]) -> fcode(). ast_to_fcode(Code, Options) -> - optimize_fcode(to_fcode(init_env(Options), Code)). + Verbose = lists:member(pp_fcode, Options), + FCode1 = to_fcode(init_env(Options), Code), + [io:format("-- Before lambda lifting --\n~s\n\n", [format_fcode(FCode1)]) || Verbose], + FCode2 = lambda_lift(FCode1), + [ io:format("-- After lambda lifting --\n~s\n\n", [format_fcode(FCode2)]) || Verbose, FCode2 /= FCode1 ], + FCode3 = optimize_fcode(FCode2), + [ io:format("-- After optimization --\n~s\n\n", [format_fcode(FCode3)]) || Verbose, FCode3 /= FCode2 ], + FCode3. %% -- Environment ------------------------------------------------------------ @@ -238,7 +248,6 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R FName = lookup_fun(Env, qname(Env, Name)), FArgs = args_to_fcode(Env, Args), FBody = expr_to_fcode(Env#{ vars => [X || {X, _} <- FArgs] }, Body), - %% io:format("Body of ~s:\n~s\n", [Name, format_fexpr(FBody)]), Def = #{ attrs => Attrs, args => FArgs, return => type_to_fcode(Env, Ret), @@ -295,6 +304,8 @@ type_to_fcode(_Env, _Sub, {bytes_t, _, _N}) -> string; %% TODO: add bytes type to FATE? type_to_fcode(_Env, Sub, {tvar, _, X}) -> maps:get(X, Sub, any); +type_to_fcode(Env, Sub, {fun_t, _, [], Args, Res}) -> + {function, [type_to_fcode(Env, Sub, Arg) || Arg <- Args], type_to_fcode(Env, Sub, Res)}; type_to_fcode(_Env, _Sub, Type) -> error({todo, Type}). @@ -431,7 +442,16 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT, N when N == Ar -> builtin_to_fcode(B, FArgs); N when N < Ar -> error({todo, eta_expand, B, FArgs}) end; - FFun -> {funcall, FFun, FArgs} + {def, F} -> {def, F, FArgs}; + FFun -> + %% FFun is a closure, with first component the function name and + %% second component the environment + Call = fun(X) -> {funcall, {proj, {var, X}, 0}, [{proj, {var, X}, 1} | FArgs]} end, + case FFun of + {var, X} -> Call(X); + _ -> X = fresh_name(), + {'let', X, FFun, Call(X)} + end end; %% Maps @@ -461,6 +481,11 @@ expr_to_fcode(Env, _Type, {map_get, _, Map, Key}) -> expr_to_fcode(Env, _Type, {map_get, _, Map, Key, Def}) -> {op, map_get_d, [expr_to_fcode(Env, Map), expr_to_fcode(Env, Key), expr_to_fcode(Env, Def)]}; +expr_to_fcode(Env, _Type, {lam, _, Args, Body}) -> + GetArg = fun({arg, _, {id, _, X}, _}) -> X end, + Xs = lists:map(GetArg, Args), + {lam, Xs, expr_to_fcode(bind_vars(Env, Xs), Body)}; + expr_to_fcode(_Env, Type, Expr) -> error({todo, {Expr, ':', Type}}). @@ -697,6 +722,79 @@ builtin_to_fcode(Builtin, Args) -> false -> {builtin, Builtin, Args} end. +%% -- Lambda lifting --------------------------------------------------------- +%% The expr_to_fcode compiler lambda expressions to {lam, Xs, Body}, but in +%% FATE we can only call top-level functions, so we need to lift the lambda to +%% the top-level and replace it with a closure. + +-spec lambda_lift(fcode()) -> fcode(). +lambda_lift(FCode = #{ functions := Funs }) -> + init_fresh_names(), + init_lambda_funs(), + Funs1 = maps:map(fun lambda_lift_fun/2, Funs), + NewFuns = get_lambda_funs(), + clear_fresh_names(), + FCode#{ functions := maps:merge(Funs1, NewFuns) }. + +-define(lambda_key, '%lambdalifted'). +init_lambda_funs() -> put(?lambda_key, #{}). +get_lambda_funs() -> erase(?lambda_key). + +add_lambda_fun(Name, Def) -> + Funs = get(?lambda_key), + put(?lambda_key, Funs#{ Name => Def }). + +lambda_lift_fun(_, Def = #{ body := Body }) -> + Def#{ body := lambda_lift_expr(Body) }. + +lambda_lift_expr({lam, Xs, Body}) -> + Fun = fresh_fun(), + FVs = free_vars({lam, Xs, Body}), + Body1 = lambda_lift_expr(Body), + add_lambda_fun(Fun, lifted_fun(FVs, Xs, Body1)), + {closure, Fun, length(Xs), {tuple, [{var, Y} || Y <- FVs]}}; +lambda_lift_expr(Expr) -> + case Expr of + {int, _} -> Expr; + {string, _} -> Expr; + {account_pubkey, _} -> Expr; + {contract_pubkey, _} -> Expr; + {oracle_pubkey, _} -> Expr; + {oracle_query_id, _} -> Expr; + {bool, _} -> Expr; + nil -> 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; + {con, Ar, C, As} -> {con, Ar, C, lambda_lift_exprs(As)}; + {tuple, As} -> {tuple, lambda_lift_exprs(As)}; + {proj, A, I} -> {proj, lambda_lift_expr(A), I}; + {set_proj, A, I, B} -> {set_proj, lambda_lift_expr(A), I, lambda_lift_expr(B)}; + {op, Op, As} -> {op, Op, lambda_lift_exprs(As)}; + {'let', X, A, B} -> {'let', X, lambda_lift_expr(A), lambda_lift_expr(B)}; + {funcall, A, Bs} -> {funcall, lambda_lift_expr(A), lambda_lift_exprs(Bs)}; + {switch, S} -> {switch, lambda_lift_expr(S)}; + {split, Type, X, Alts} -> {split, Type, X, lambda_lift_exprs(Alts)}; + {nosplit, A} -> {nosplit, lambda_lift_expr(A)}; + {'case', P, S} -> {'case', P, lambda_lift_expr(S)} + end. + +lambda_lift_exprs(As) -> [lambda_lift_expr(A) || A <- As]. + +lifted_fun(FVs, Xs, Body) -> + Z = fresh_name(), + Proj = fun({I, Y}, E) -> {'let', Y, {proj, {var, Z}, I - 1}, E} end, + #{ attrs => [private], + args => [{Z, any} | [{X, any} || X <- Xs]], + return => any, + body => lists:foldr(Proj, Body, indexed(FVs)) + }. + + + %% -- Optimisations ---------------------------------------------------------- %% - Deadcode elimination @@ -822,10 +920,16 @@ clear_fresh_names() -> erase('%fresh'). -spec fresh_name() -> var_name(). -fresh_name() -> +fresh_name() -> fresh_name("%"). + +-spec fresh_fun() -> fun_name(). +fresh_fun() -> {local_fun, [fresh_name("^")]}. + +-spec fresh_name(string()) -> var_name(). +fresh_name(Prefix) -> N = get('%fresh'), put('%fresh', N + 1), - lists:concat(["%", N]). + lists:concat([Prefix, N]). -spec pat_vars(fpat()) -> [var_name()]. pat_vars({var, X}) -> [X || X /= "_"]; @@ -838,6 +942,37 @@ pat_vars({tuple, Ps}) -> pat_vars(Ps); pat_vars({con, _, _, Ps}) -> pat_vars(Ps); pat_vars(Ps) when is_list(Ps) -> [X || P <- Ps, X <- pat_vars(P)]. +free_vars(Xs) when is_list(Xs) -> + lists:umerge([ free_vars(X) || X <- Xs ]); +free_vars(Expr) -> + case Expr of + {var, X} -> [X]; + {int, _} -> []; + {string, _} -> []; + {account_pubkey, _} -> []; + {contract_pubkey, _} -> []; + {oracle_pubkey, _} -> []; + {oracle_query_id, _} -> []; + {bool, _} -> []; + nil -> []; + {def, _} -> []; + {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)) + end. + get_named_args(NamedArgsT, Args) -> IsNamed = fun({named_arg, _, _, _}) -> true; (_) -> false end, @@ -865,13 +1000,13 @@ rename(Ren, Expr) -> {oracle_query_id, _} -> Expr; nil -> nil; {var, X} -> {var, rename_var(Ren, X)}; - {def, _} -> Expr; + {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, Fun, [rename(Ren, E) || E <- Es]}; + {funcall, Fun, Es} -> {funcall, rename(Ren, Fun), [rename(Ren, E) || E <- Es]}; {'let', X, E, Body} -> {Z, Ren1} = rename_binding(Ren, X), {'let', Z, rename(Ren, E), rename(Ren1, Body)}; @@ -977,9 +1112,24 @@ fcode_error(Err) -> %% -- Pretty printing -------------------------------------------------------- +format_fcode(#{ functions := Funs }) -> + prettypr:format(pp_above( + [ pp_fun(Name, Def) || {Name, Def} <- maps:to_list(Funs) ])). + format_fexpr(E) -> prettypr:format(pp_fexpr(E)). +pp_fun(Name, #{ args := Args, return := Return, body := Body }) -> + PPArg = fun({X, T}) -> pp_beside([pp_text(X), pp_text(" : "), pp_ftype(T)]) end, + pp_above(pp_beside([pp_text("function "), pp_fun_name(Name), + pp_parens(pp_par(pp_punctuate(pp_text(","), [PPArg(Arg) || Arg <- Args]))), + pp_text(" : "), pp_ftype(Return), pp_text(" =")]), + prettypr:nest(2, pp_fexpr(Body))). + +pp_fun_name(init) -> pp_text("init"); +pp_fun_name({entrypoint, E}) -> pp_text(binary_to_list(E)); +pp_fun_name({local_fun, Q}) -> pp_text(string:join(Q, ".")). + pp_text(<<>>) -> prettypr:text("\"\""); pp_text(Bin) when is_binary(Bin) -> prettypr:text(lists:flatten(io_lib:format("~p", [binary_to_list(Bin)]))); pp_text(S) -> prettypr:text(lists:concat([S])). @@ -1015,9 +1165,10 @@ pp_fexpr({Tag, Lit}) when Tag == int; aeso_pretty:expr({Tag, [], Lit}); pp_fexpr(nil) -> pp_text("[]"); -pp_fexpr({var, X}) -> pp_text(X); -pp_fexpr({def, {entrypoint, E}}) -> pp_text(E); -pp_fexpr({def, {local_fun, Q}}) -> pp_text(string:join(Q, ".")); +pp_fexpr({var, X}) -> pp_text(X); +pp_fexpr({def, Fun}) -> pp_fun_name(Fun); +pp_fexpr({def, Fun, Args}) -> + pp_call(pp_fun_name(Fun), Args); pp_fexpr({con, _, I, []}) -> pp_beside(pp_text("C"), pp_text(I)); pp_fexpr({con, _, I, Es}) -> @@ -1027,6 +1178,11 @@ pp_fexpr({tuple, Es}) -> pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_fexpr(E) || E <- Es]))); pp_fexpr({proj, E, I}) -> pp_beside([pp_fexpr(E), pp_text("."), pp_text(I)]); +pp_fexpr({lam, Xs, A}) -> + pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"), + prettypr:nest(2, pp_fexpr(A))]); +pp_fexpr({closure, Fun, _Ar, {tuple, FVs}}) -> + pp_call(pp_text("__CLOSURE__"), [{def, Fun} | FVs]); pp_fexpr({set_proj, E, I, A}) -> pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_text(I), pp_text(" = "), pp_fexpr(A)]))); pp_fexpr({op, Op, [A, B] = Args}) -> @@ -1057,10 +1213,13 @@ pp_call(Fun, Args) -> pp_beside(Fun, pp_fexpr({tuple, Args})). pp_ftype(T) when is_atom(T) -> pp_text(T); +pp_ftype(any) -> pp_text("_"); pp_ftype({tuple, Ts}) -> pp_parens(pp_par(pp_punctuate(pp_text(","), [pp_ftype(T) || T <- Ts]))); pp_ftype({list, T}) -> pp_beside([pp_text("list("), pp_ftype(T), pp_text(")")]); +pp_ftype({function, Args, Res}) -> + pp_par([pp_ftype({tuple, Args}), pp_text("=>"), pp_ftype(Res)]); pp_ftype({variant, Cons}) -> pp_par( pp_punctuate(pp_text(" |"), diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 9372bff..0e474d3 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -130,17 +130,16 @@ functions_to_scode(ContractName, Functions, Options) -> return := Type}} <- maps:to_list(Functions), Name /= init ]). %% TODO: skip init for now -function_to_scode(ContractName, Functions, Name, Args, Body, ResType, Options) -> - debug(scode, Options, "Compiling ~p ~p : ~p ->\n ~p\n", [Name, Args, ResType, Body]), +function_to_scode(ContractName, Functions, _Name, Args, Body, ResType, _Options) -> ArgTypes = [ type_to_scode(T) || {_, T} <- Args ], SCode = to_scode(init_env(ContractName, Functions, Args), Body), - debug(scode, Options, " scode: ~p\n", [SCode]), {{ArgTypes, type_to_scode(ResType)}, SCode}. type_to_scode({variant, Cons}) -> {variant, lists:map(fun length/1, Cons)}; type_to_scode({list, Type}) -> {list, type_to_scode(Type)}; type_to_scode({tuple, Types}) -> {tuple, lists:map(fun type_to_scode/1, Types)}; type_to_scode({map, Key, Val}) -> {map, type_to_scode(Key), type_to_scode(Val)}; +type_to_scode({function, _Args, _Res}) -> {tuple, [string, any]}; type_to_scode(T) -> T. %% -- Phase I ---------------------------------------------------------------- @@ -235,20 +234,15 @@ to_scode(Env, {'let', X, Expr, Body}) -> aeb_fate_code:store({var, I}, {stack, 0}), to_scode(Env1, Body) ]; +to_scode(Env, {def, Fun, Args}) -> + FName = make_function_name(Fun), + Lbl = aeb_fate_data:make_string(FName), + [ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)], + local_call(Env, ?i(Lbl)) ]; to_scode(Env, {funcall, Fun, Args}) -> - case Fun of - {var, _} -> - ?TODO({funcall, Fun}); - {def, {builtin, _}} -> - ?TODO({funcall, Fun}); - {def, Def} -> - FName = make_function_name(Def), - Lbl = aeb_fate_data:make_string(FName), - 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 ] - end; + [ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)], + to_scode(Env, Fun), + local_call(Env, ?a) ]; to_scode(Env, {switch, Case}) -> split_to_scode(Env, Case); @@ -256,8 +250,15 @@ to_scode(Env, {switch, Case}) -> to_scode(Env, {builtin, B, Args}) -> builtin_to_scode(Env, B, Args); +to_scode(Env, {closure, Fun, _Ar, FVs}) -> + to_scode(Env, {tuple, [{string, make_function_name(Fun)}, FVs]}); + to_scode(_Env, Icode) -> ?TODO(Icode). +local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_code:call_t(Fun); +local_call(_Env, Fun) -> aeb_fate_code:call(Fun). + + split_to_scode(Env, {nosplit, Expr}) -> [switch_body, to_scode(Env, Expr)]; split_to_scode(Env, {split, {tuple, _}, X, Alts}) -> @@ -321,9 +322,7 @@ split_to_scode(Env, {split, {variant, Cons}, X, Alts}) -> %% Skip the switch for single constructor datatypes (with no catchall) {[SAlt], missing} when SAlt /= missing -> SAlt; {SAlts, _} -> [{switch, Arg, SType, SAlts, Def}] - end; -split_to_scode(_, Split = {split, _, _, _}) -> - ?TODO({'case', Split}). + end. literal_split_to_scode(_Env, _Type, Arg, [], Def) -> {switch, Arg, boolean, [missing, missing], Def}; -- 2.30.2 From 4c872c4690d2cb430ccb86a1cbe141f2aa3b8782 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 13:43:18 +0200 Subject: [PATCH 74/87] Optimize single variable closure envs --- src/aeso_ast_to_fcode.erl | 43 +++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 17 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 958497e..9b10afa 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -740,19 +740,35 @@ lambda_lift(FCode = #{ functions := Funs }) -> init_lambda_funs() -> put(?lambda_key, #{}). get_lambda_funs() -> erase(?lambda_key). -add_lambda_fun(Name, Def) -> +add_lambda_fun(Def) -> + Name = fresh_fun(), Funs = get(?lambda_key), - put(?lambda_key, Funs#{ Name => Def }). + put(?lambda_key, Funs#{ Name => Def }), + Name. lambda_lift_fun(_, Def = #{ body := Body }) -> Def#{ body := lambda_lift_expr(Body) }. +lifted_fun([Z], Xs, Body) -> + #{ attrs => [private], + args => [{Z, any} | [{X, any} || X <- Xs]], + return => any, + body => Body }; +lifted_fun(FVs, Xs, Body) -> + Z = "%env", + Proj = fun({I, Y}, E) -> {'let', Y, {proj, {var, Z}, I - 1}, E} end, + #{ attrs => [private], + args => [{Z, any} | [{X, any} || X <- Xs]], + return => any, + body => lists:foldr(Proj, Body, indexed(FVs)) + }. + lambda_lift_expr({lam, Xs, Body}) -> - Fun = fresh_fun(), FVs = free_vars({lam, Xs, Body}), Body1 = lambda_lift_expr(Body), - add_lambda_fun(Fun, lifted_fun(FVs, Xs, Body1)), - {closure, Fun, length(Xs), {tuple, [{var, Y} || Y <- FVs]}}; + Fun = add_lambda_fun(lifted_fun(FVs, Xs, Body1)), + Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end, + {closure, Fun, length(Xs), Tup([{var, Y} || Y <- FVs])}; lambda_lift_expr(Expr) -> case Expr of {int, _} -> Expr; @@ -784,17 +800,6 @@ lambda_lift_expr(Expr) -> lambda_lift_exprs(As) -> [lambda_lift_expr(A) || A <- As]. -lifted_fun(FVs, Xs, Body) -> - Z = fresh_name(), - Proj = fun({I, Y}, E) -> {'let', Y, {proj, {var, Z}, I - 1}, E} end, - #{ attrs => [private], - args => [{Z, any} | [{X, any} || X <- Xs]], - return => any, - body => lists:foldr(Proj, Body, indexed(FVs)) - }. - - - %% -- Optimisations ---------------------------------------------------------- %% - Deadcode elimination @@ -1181,7 +1186,11 @@ pp_fexpr({proj, E, I}) -> pp_fexpr({lam, Xs, A}) -> pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"), prettypr:nest(2, pp_fexpr(A))]); -pp_fexpr({closure, Fun, _Ar, {tuple, FVs}}) -> +pp_fexpr({closure, Fun, _Ar, ClEnv}) -> + FVs = case ClEnv of + {tuple, Xs} -> Xs; + {var, _} -> [ClEnv] + end, pp_call(pp_text("__CLOSURE__"), [{def, Fun} | FVs]); pp_fexpr({set_proj, E, I, A}) -> pp_beside(pp_fexpr(E), pp_braces(pp_beside([pp_text(I), pp_text(" = "), pp_fexpr(A)]))); -- 2.30.2 From 110466b08c6e5027c788aced8c4e2a678cb317c2 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 14:17:41 +0200 Subject: [PATCH 75/87] Handle unapplied builtins and top-level functions --- src/aeso_ast_to_fcode.erl | 85 +++++++++++++++++++++----------------- src/aeso_fcode_to_fate.erl | 2 +- 2 files changed, 47 insertions(+), 40 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 9b10afa..64cf8f2 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -53,7 +53,7 @@ | {'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(), non_neg_integer(), fexpr()} + | {closure, fun_name(), fexpr()} | {switch, fsplit()}. -type fsplit() :: {split, ftype(), var_name(), [fcase()]} @@ -107,7 +107,7 @@ -type con_tag() :: #con_tag{}. -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 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), FArgs = [expr_to_fcode(Env, Arg) || Arg <- Args1], case expr_to_fcode(Env, Fun) of - {builtin, B, Ar} when is_integer(Ar) -> - case length(FArgs) of - 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}; + {builtin, B, Ar} when is_integer(Ar) -> builtin_to_fcode(B, FArgs); + {def, F, Ar} when is_integer(Ar) -> {def, F, FArgs}; FFun -> %% FFun is a closure, with first component the function name and %% second component the environment @@ -768,7 +764,16 @@ lambda_lift_expr({lam, Xs, Body}) -> Body1 = lambda_lift_expr(Body), Fun = add_lambda_fun(lifted_fun(FVs, Xs, Body1)), 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) -> case Expr of {int, _} -> Expr; @@ -780,7 +785,7 @@ lambda_lift_expr(Expr) -> {bool, _} -> Expr; nil -> Expr; {var, _} -> Expr; - {closure, _, _, _} -> 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)}; @@ -852,8 +857,8 @@ bind_constructors(Env = #{ con_env := ConEnv }, NewCons) -> -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env(). add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{}; %% no functions from abstract contracts add_fun_env(Env = #{ fun_env := FunEnv }, Decls) -> - Entry = fun({letfun, Ann, {id, _, Name}, _, _, _}) -> - [{qname(Env, Name), make_fun_name(Env, Ann, Name)}]; + Entry = fun({letfun, Ann, {id, _, Name}, Args, _, _}) -> + [{qname(Env, Name), {make_fun_name(Env, Ann, Name), length(Args)}}]; (_) -> [] end, FunEnv1 = maps:from_list(lists:flatmap(Entry, Decls)), Env#{ fun_env := maps:merge(FunEnv, FunEnv1) }. @@ -886,8 +891,8 @@ qname(Env, Name) -> -spec lookup_fun(env(), sophia_name()) -> fun_name(). lookup_fun(#{ fun_env := FunEnv }, Name) -> case maps:get(Name, FunEnv, false) of - false -> error({unbound_name, Name}); - FName -> FName + false -> error({unbound_name, Name}); + {FName, _} -> FName end. -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 {not_found, not_found} -> fcode_error({unbound_variable, Q}); {_, {B, Ar}} -> {builtin, B, Ar}; - {Fun, _} -> {def, Fun} + {{Fun, Ar}, _} -> {def, Fun, Ar} end. init_fresh_names() -> @@ -951,31 +956,31 @@ free_vars(Xs) when is_list(Xs) -> lists:umerge([ free_vars(X) || X <- Xs ]); free_vars(Expr) -> case Expr of - {var, X} -> [X]; - {int, _} -> []; - {string, _} -> []; - {account_pubkey, _} -> []; + {var, X} -> [X]; + {int, _} -> []; + {string, _} -> []; + {account_pubkey, _} -> []; {contract_pubkey, _} -> []; - {oracle_pubkey, _} -> []; + {oracle_pubkey, _} -> []; {oracle_query_id, _} -> []; - {bool, _} -> []; - nil -> []; - {def, _} -> []; + {bool, _} -> []; + nil -> []; + {def, _} -> []; {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); + {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)) + {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) -> @@ -1170,8 +1175,10 @@ pp_fexpr({Tag, Lit}) when Tag == int; aeso_pretty:expr({Tag, [], Lit}); pp_fexpr(nil) -> pp_text("[]"); -pp_fexpr({var, X}) -> pp_text(X); -pp_fexpr({def, Fun}) -> pp_fun_name(Fun); +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_beside([pp_fun_name(Fun), pp_text("/"), pp_text(Ar)]); pp_fexpr({def, Fun, Args}) -> pp_call(pp_fun_name(Fun), Args); pp_fexpr({con, _, I, []}) -> @@ -1186,7 +1193,7 @@ pp_fexpr({proj, E, I}) -> pp_fexpr({lam, Xs, A}) -> pp_par([pp_fexpr({tuple, [{var, X} || X <- Xs]}), pp_text("=>"), prettypr:nest(2, pp_fexpr(A))]); -pp_fexpr({closure, Fun, _Ar, ClEnv}) -> +pp_fexpr({closure, Fun, ClEnv}) -> FVs = case ClEnv of {tuple, Xs} -> Xs; {var, _} -> [ClEnv] diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 0e474d3..74e2abe 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -250,7 +250,7 @@ to_scode(Env, {switch, Case}) -> to_scode(Env, {builtin, 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, Icode) -> ?TODO(Icode). -- 2.30.2 From 16f00701d7a0c4f0cdb1a6c2206fc2f1169b3401 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 14:19:41 +0200 Subject: [PATCH 76/87] Missing case in fcode pretty printer --- src/aeso_ast_to_fcode.erl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 64cf8f2..9f2b2ea 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -1236,6 +1236,8 @@ pp_ftype({list, T}) -> pp_beside([pp_text("list("), pp_ftype(T), pp_text(")")]); pp_ftype({function, Args, Res}) -> pp_par([pp_ftype({tuple, Args}), pp_text("=>"), pp_ftype(Res)]); +pp_ftype({map, Key, Val}) -> + pp_beside([pp_text("map"), pp_ftype({tuple, [Key, Val]})]); pp_ftype({variant, Cons}) -> pp_par( pp_punctuate(pp_text(" |"), -- 2.30.2 From db48be1805bb77a04849faea6636dfcef46fec9c Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 14:58:25 +0200 Subject: [PATCH 77/87] Fix variable binding bug in fcode compiler --- src/aeso_ast_to_fcode.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 9f2b2ea..56d51ed 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -369,7 +369,7 @@ expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Rec, Fields}) -> Proj = fun(I) -> {proj, {var, X}, I - 1} end, Comp = fun({I, false}) -> Proj(I); ({_, {set, E}}) -> expr_to_fcode(Env, E); - ({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(Env, E)} + ({I, {upd, Z, E}}) -> {'let', Z, Proj(I), expr_to_fcode(bind_var(Env, Z), E)} end, Set = fun({_, false}, R) -> R; ({I, {set, E}}, R) -> {set_proj, R, I - 1, expr_to_fcode(Env, E)}; -- 2.30.2 From fac136bded3f39a76950de590cd9e8415ced4ce5 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 14:58:48 +0200 Subject: [PATCH 78/87] Compiler side of state updates No support in FATE yet though --- src/aeso_ast_to_fcode.erl | 6 +++++- src/aeso_fcode_to_fate.erl | 6 ++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 56d51ed..19ec5f4 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -211,8 +211,12 @@ init_type_env() -> -spec to_fcode(env(), aeso_syntax:ast()) -> fcode(). to_fcode(Env, [{contract, _, {con, _, Main}, Decls}]) -> + #{ builtins := Builtins } = Env, + MainEnv = Env#{ context => {main_contract, Main}, + builtins => Builtins#{[Main, "state"] => {get_state, none}, + [Main, "put"] => {set_state, 1}} }, #{ functions := Funs } = Env1 = - decls_to_fcode(Env#{ context => {main_contract, Main} }, Decls), + decls_to_fcode(MainEnv, Decls), StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}), EventType = lookup_type(Env1, [Main, "event"], [], none), #{ contract_name => Main, diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 74e2abe..5dde168 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -38,6 +38,7 @@ -define(i(X), {immediate, X}). -define(a, {stack, 0}). +-define(s, {var, -1}). %% TODO: until we have state support in FATE -define(IsOp(Op), ( Op =:= 'STORE' orelse @@ -372,6 +373,11 @@ call_to_scode(Env, CallCode, Args) -> [[to_scode(notail(Env), A) || A <- lists:reverse(Args)], CallCode]. +builtin_to_scode(_Env, get_state, none) -> + [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, map_empty, none) -> [aeb_fate_code:map_empty(?a)]; builtin_to_scode(_Env, bits_none, none) -> -- 2.30.2 From b43e8d9f68824236a83ab95b6e29679391752378 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 15:56:19 +0200 Subject: [PATCH 79/87] Compile statements --- src/aeso_ast_to_fcode.erl | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 19ec5f4..1b76c19 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -700,9 +700,10 @@ decision_tree_to_fcode({'if', A, Then, Else}) -> -spec stmts_to_fcode(env(), [aeso_syntax:stmt()]) -> fexpr(). stmts_to_fcode(Env, [{letval, _, {typed, _, {id, _, X}, _}, _, Expr} | Stmts]) -> {'let', X, expr_to_fcode(Env, Expr), stmts_to_fcode(bind_var(Env, X), Stmts)}; - stmts_to_fcode(Env, [Expr]) -> - expr_to_fcode(Env, Expr). + expr_to_fcode(Env, Expr); +stmts_to_fcode(Env, [Expr | Stmts]) -> + {'let', "_", expr_to_fcode(Env, Expr), stmts_to_fcode(Env, Stmts)}. %% -- Builtins -- -- 2.30.2 From 49b00715c5ce4b85b50309f99133d9e4a17a29d7 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 15:56:36 +0200 Subject: [PATCH 80/87] Compile events But no FATE support for events yet --- src/aeso_ast_to_fcode.erl | 5 +++-- src/aeso_fcode_to_fate.erl | 2 ++ 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 1b76c19..29035ca 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -213,8 +213,9 @@ init_type_env() -> to_fcode(Env, [{contract, _, {con, _, Main}, Decls}]) -> #{ builtins := Builtins } = Env, MainEnv = Env#{ context => {main_contract, Main}, - builtins => Builtins#{[Main, "state"] => {get_state, none}, - [Main, "put"] => {set_state, 1}} }, + builtins => Builtins#{[Main, "state"] => {get_state, none}, + [Main, "put"] => {set_state, 1}, + [Main, "Chain", "event"] => {event, 1}} }, #{ functions := Funs } = Env1 = decls_to_fcode(MainEnv, Decls), StateType = lookup_type(Env1, [Main, "state"], [], {tuple, []}), diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 5dde168..de07f26 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -378,6 +378,8 @@ builtin_to_scode(_Env, get_state, none) -> 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) -> [aeb_fate_code:map_empty(?a)]; builtin_to_scode(_Env, bits_none, none) -> -- 2.30.2 From 2ef94b03ec53ba60ff7f798f44698c107432b53b Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Mon, 6 May 2019 17:01:20 +0200 Subject: [PATCH 81/87] Compile remote calls --- src/aeso_ast_to_fcode.erl | 54 +++++++++++++++++++++++++++++--------- src/aeso_fcode_to_fate.erl | 26 ++++++++++-------- 2 files changed, 56 insertions(+), 24 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 29035ca..1fb1d35 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -43,6 +43,7 @@ | nil | {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()]} @@ -296,6 +297,7 @@ type_to_fcode(Env, Type) -> type_to_fcode(Env, #{}, Type). -spec type_to_fcode(env(), #{var_name() => ftype()}, aeso_syntax:type()) -> ftype(). +type_to_fcode(_Env, _Sub, {con, _, _}) -> contract; type_to_fcode(Env, Sub, {app_t, _, T = {Id, _, _}, Types}) when Id == id; Id == qid -> lookup_type(Env, T, [type_to_fcode(Env, Sub, Type) || Type <- Types]); type_to_fcode(Env, _Sub, T = {Id, _, _}) when Id == id; Id == qid -> @@ -309,8 +311,10 @@ type_to_fcode(_Env, _Sub, {bytes_t, _, _N}) -> string; %% TODO: add bytes type to FATE? type_to_fcode(_Env, Sub, {tvar, _, X}) -> maps:get(X, Sub, any); -type_to_fcode(Env, Sub, {fun_t, _, [], Args, Res}) -> - {function, [type_to_fcode(Env, Sub, Arg) || Arg <- Args], type_to_fcode(Env, Sub, Res)}; +type_to_fcode(Env, Sub, {fun_t, _, Named, Args, Res}) -> + FNamed = [type_to_fcode(Env, Sub, Arg) || {named_arg_t, _, _, Arg, _} <- Named], + FArgs = [type_to_fcode(Env, Sub, Arg) || Arg <- Args], + {function, FNamed ++ FArgs, type_to_fcode(Env, Sub, Res)}; type_to_fcode(_Env, _Sub, Type) -> error({todo, Type}). @@ -358,8 +362,15 @@ expr_to_fcode(Env, _Type, {tuple, _, Es}) -> {tuple, [expr_to_fcode(Env, E) || E <- Es]}; %% Records -expr_to_fcode(Env, _Type, {proj, _Ann, Rec, X}) -> - {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)}; +expr_to_fcode(Env, Type, {proj, _Ann, Rec = {typed, _, _, RecType}, {id, _, X}}) -> + case RecType of + {con, _, _} -> + {fun_t, _, Named, Args, _} = Type, + Arity = length(Named) + length(Args), + {remote_u, expr_to_fcode(Env, Rec), {entrypoint, list_to_binary(X)}, Arity}; + {record_t, _} -> + {proj, expr_to_fcode(Env, Rec), field_index(Rec, X)} + end; expr_to_fcode(Env, {record_t, FieldTypes}, {record, _Ann, Fields}) -> FVal = fun(F) -> @@ -444,6 +455,8 @@ expr_to_fcode(Env, _Type, {app, _Ann, Fun = {typed, _, _, {fun_t, _, NamedArgsT, 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}; FFun -> %% FFun is a closure, with first component the function name and %% second component the environment @@ -765,12 +778,14 @@ lifted_fun(FVs, Xs, Body) -> body => lists:foldr(Proj, Body, indexed(FVs)) }. +make_closure(FVs, Xs, Body) -> + Fun = add_lambda_fun(lifted_fun(FVs, Xs, Body)), + Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end, + {closure, Fun, Tup([{var, Y} || Y <- FVs])}. + lambda_lift_expr({lam, Xs, Body}) -> FVs = free_vars({lam, Xs, Body}), - Body1 = lambda_lift_expr(Body), - Fun = add_lambda_fun(lifted_fun(FVs, Xs, Body1)), - Tup = fun([Y]) -> Y; (Ys) -> {tuple, Ys} end, - {closure, Fun, Tup([{var, Y} || Y <- FVs])}; + make_closure(FVs, Xs, lambda_lift_expr(Body)); 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], @@ -778,8 +793,13 @@ lambda_lift_expr({Tag, F, Ar}) when is_integer(Ar), Tag == def orelse Tag == bui builtin -> builtin_to_fcode(F, Args); def -> {def, F, Args} end, - Fun = add_lambda_fun(lifted_fun([], Xs, Body)), - {closure, Fun, {tuple, []}}; + make_closure([], Xs, Body); +lambda_lift_expr({remote_u, Ct, F, Ar}) -> + FVs = free_vars(Ct), + Ct1 = lambda_lift_expr(Ct), + Xs = [ lists:concat(["arg", I]) || I <- lists:seq(1, Ar) ], + Args = [{var, X} || X <- Xs], + make_closure(FVs, Xs, {remote, Ct1, F, Args}); lambda_lift_expr(Expr) -> case Expr of {int, _} -> Expr; @@ -796,6 +816,7 @@ lambda_lift_expr(Expr) -> {builtin, B, As} when is_list(As) -> {builtin, B, lambda_lift_exprs(As)}; {builtin, _, _} -> Expr; + {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)}; {proj, A, I} -> {proj, lambda_lift_expr(A), I}; @@ -861,7 +882,7 @@ bind_constructors(Env = #{ con_env := ConEnv }, NewCons) -> %% -- Names -- -spec add_fun_env(env(), [aeso_syntax:decl()]) -> env(). -add_fun_env(#{ context := {abstract_contract, _} }, _) -> #{}; %% no functions from abstract contracts +add_fun_env(Env = #{ context := {abstract_contract, _} }, _) -> Env; %% no functions from abstract contracts add_fun_env(Env = #{ fun_env := FunEnv }, Decls) -> Entry = fun({letfun, Ann, {id, _, Name}, Args, _, _}) -> [{qname(Env, Name), {make_fun_name(Env, Ann, Name), length(Args)}}]; @@ -971,7 +992,10 @@ free_vars(Expr) -> {oracle_query_id, _} -> []; {bool, _} -> []; nil -> []; - {def, _} -> []; + {def, _, As} when is_list(As) -> []; + {def, _, _} -> []; + {remote_u, Ct, _, _} -> free_vars(Ct); + {remote, Ct, _, As} -> free_vars([Ct | As]); {builtin, _, As} when is_list(As) -> free_vars(As); {builtin, _, _} -> []; {con, _, _, As} -> free_vars(As); @@ -1099,7 +1123,7 @@ rename_case(Ren, {'case', Pat, Split}) -> field_index({typed, _, _, RecTy}, X) -> field_index(RecTy, X); -field_index({record_t, Fields}, {id, _, X}) -> +field_index({record_t, Fields}, X) -> IsX = fun({field_t, _, {id, _, Y}, _}) -> X == Y end, [I] = [ I || {I, Field} <- indexed(Fields), IsX(Field) ], I - 1. %% Tuples are 0-indexed @@ -1227,6 +1251,10 @@ pp_fexpr({builtin, B, N}) when is_integer(N) -> pp_beside([pp_text(B), pp_text("/"), pp_text(N)]); pp_fexpr({builtin, B, As}) when is_list(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, Ct, Fun, As}) -> + pp_call(pp_beside([pp_fexpr(Ct), pp_text("."), pp_fun_name(Fun)]), As); pp_fexpr({funcall, Fun, As}) -> pp_call(pp_fexpr(Fun), As); pp_fexpr({switch, Split}) -> pp_split(Split). diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index de07f26..34bd815 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -141,6 +141,7 @@ type_to_scode({list, Type}) -> {list, type_to_scode(Type)}; type_to_scode({tuple, Types}) -> {tuple, lists:map(fun type_to_scode/1, Types)}; type_to_scode({map, Key, Val}) -> {map, type_to_scode(Key), type_to_scode(Val)}; type_to_scode({function, _Args, _Res}) -> {tuple, [string, any]}; +type_to_scode(contract) -> address; type_to_scode(T) -> T. %% -- Phase I ---------------------------------------------------------------- @@ -189,7 +190,7 @@ to_scode(_Env, {account_pubkey, K}) -> [push(?i(aeb_fate_data:make_address(K)))]; to_scode(_Env, {contract_pubkey, K}) -> - [push(?i(aeb_fate_data:make_contract(K)))]; + [push(?i(aeb_fate_data:make_address(K)))]; to_scode(_Env, {oracle_pubkey, K}) -> [push(?i(aeb_fate_data:make_oracle(K)))]; @@ -238,28 +239,31 @@ to_scode(Env, {'let', X, Expr, Body}) -> to_scode(Env, {def, Fun, Args}) -> FName = make_function_name(Fun), Lbl = aeb_fate_data:make_string(FName), - [ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)], - local_call(Env, ?i(Lbl)) ]; + call_to_scode(Env, local_call(Env, ?i(Lbl)), Args); to_scode(Env, {funcall, Fun, Args}) -> - [ [to_scode(notail(Env), Arg) || Arg <- lists:reverse(Args)], - to_scode(Env, Fun), - local_call(Env, ?a) ]; - -to_scode(Env, {switch, Case}) -> - split_to_scode(Env, Case); + call_to_scode(Env, [to_scode(Env, Fun), local_call(Env, ?a)], Args); to_scode(Env, {builtin, B, Args}) -> builtin_to_scode(Env, B, Args); +to_scode(Env, {remote, Ct, Fun, [_Gas, _Value | Args]}) -> + %% TODO: FATE doesn't support value and gas arguments yet + Lbl = make_function_name(Fun), + Call = if Env#env.tailpos -> aeb_fate_code:call_tr(?a, Lbl); + true -> aeb_fate_code:call_r(?a, Lbl) end, + call_to_scode(Env, [to_scode(Env, Ct), Call], Args); + to_scode(Env, {closure, Fun, FVs}) -> to_scode(Env, {tuple, [{string, make_function_name(Fun)}, FVs]}); +to_scode(Env, {switch, Case}) -> + split_to_scode(Env, Case); + to_scode(_Env, Icode) -> ?TODO(Icode). local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_code:call_t(Fun); local_call(_Env, Fun) -> aeb_fate_code:call(Fun). - split_to_scode(Env, {nosplit, Expr}) -> [switch_body, to_scode(Env, Expr)]; split_to_scode(Env, {split, {tuple, _}, X, Alts}) -> @@ -1346,7 +1350,7 @@ 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(Ref, [I | Code], Acc, Blocks) when element(1, I) == 'CALL'; element(1, I) == '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). -- 2.30.2 From 182f30133b9e391b3559c91228b23e63668517a3 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 7 May 2019 09:39:50 +0200 Subject: [PATCH 82/87] 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}). -- 2.30.2 From 8233c780e40cc95078d1ece7c5c8a54bf1be52c3 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 7 May 2019 10:05:16 +0200 Subject: [PATCH 83/87] Tag for literals in fcode to make code cleaner --- src/aeso_ast_to_fcode.erl | 74 ++++++++++++++------------------------ src/aeso_fcode_to_fate.erl | 33 ++++++----------- 2 files changed, 38 insertions(+), 69 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 270e2dd..91ea6d7 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -33,13 +33,15 @@ string_concat | bits_set | bits_clear | bits_test | bits_sum | bits_intersection | bits_union | bits_difference. --type fexpr() :: {int, integer()} - | {string, binary()} - | {account_pubkey, binary()} - | {contract_pubkey, binary()} - | {oracle_pubkey, binary()} - | {oracle_query_id, binary()} - | {bool, false | true} +-type flit() :: {int, integer()} + | {string, binary()} + | {account_pubkey, binary()} + | {contract_pubkey, binary()} + | {oracle_pubkey, binary()} + | {oracle_query_id, binary()} + | {bool, false | true}. + +-type fexpr() :: {lit, flit()} | nil | {var, var_name()} | {def, fun_name(), [fexpr()]} @@ -336,16 +338,16 @@ expr_to_fcode(Env, Expr) -> -spec expr_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:expr()) -> fexpr(). %% Literals -expr_to_fcode(_Env, _Type, {int, _, N}) -> {int, N}; -expr_to_fcode(_Env, _Type, {char, _, N}) -> {int, N}; -expr_to_fcode(_Env, _Type, {bool, _, B}) -> {bool, B}; -expr_to_fcode(_Env, _Type, {string, _, S}) -> {string, S}; -expr_to_fcode(_Env, _Type, {account_pubkey, _, K}) -> {account_pubkey, K}; -expr_to_fcode(_Env, _Type, {contract_pubkey, _, K}) -> {contract_pubkey, K}; -expr_to_fcode(_Env, _Type, {oracle_pubkey, _, K}) -> {oracle_pubkey, K}; -expr_to_fcode(_Env, _Type, {oracle_query_id, _, K}) -> {oracle_query_id, K}; +expr_to_fcode(_Env, _Type, {int, _, N}) -> {lit, {int, N}}; +expr_to_fcode(_Env, _Type, {char, _, N}) -> {lit, {int, N}}; +expr_to_fcode(_Env, _Type, {bool, _, B}) -> {lit, {bool, B}}; +expr_to_fcode(_Env, _Type, {string, _, S}) -> {lit, {string, S}}; +expr_to_fcode(_Env, _Type, {account_pubkey, _, K}) -> {lit, {account_pubkey, K}}; +expr_to_fcode(_Env, _Type, {contract_pubkey, _, K}) -> {lit, {contract_pubkey, K}}; +expr_to_fcode(_Env, _Type, {oracle_pubkey, _, K}) -> {lit, {oracle_pubkey, K}}; +expr_to_fcode(_Env, _Type, {oracle_query_id, _, K}) -> {lit, {oracle_query_id, K}}; -expr_to_fcode(_Env, _Type, {bytes, _, Bin}) -> {string, Bin}; +expr_to_fcode(_Env, _Type, {bytes, _, Bin}) -> {lit, {string, Bin}}; %% Variables expr_to_fcode(Env, _Type, {id, _, X}) -> resolve_var(Env, [X]); @@ -449,7 +451,7 @@ expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A, B]}) when is_atom(Op) -> {op, Op, [expr_to_fcode(Env, A), expr_to_fcode(Env, B)]}; expr_to_fcode(Env, _Type, {app, _Ann, {Op, _}, [A]}) when is_atom(Op) -> case Op of - '-' -> {op, '-', [{int, 0}, expr_to_fcode(Env, A)]}; + '-' -> {op, '-', [{lit, {int, 0}}, expr_to_fcode(Env, A)]}; '!' -> {op, '!', [expr_to_fcode(Env, A)]} end; @@ -704,8 +706,8 @@ expr_to_decision_tree(Env, {typed, _, Expr, _}) -> expr_to_decision_tree(Env, Ex expr_to_decision_tree(Env, Expr) -> {atom, expr_to_fcode(Env, Expr)}. -decision_tree_to_fcode(false) -> {bool, false}; -decision_tree_to_fcode(true) -> {bool, true}; +decision_tree_to_fcode(false) -> {lit, {bool, false}}; +decision_tree_to_fcode(true) -> {lit, {bool, true}}; decision_tree_to_fcode({atom, B}) -> B; decision_tree_to_fcode({'if', A, Then, Else}) -> X = fresh_name(), @@ -806,13 +808,7 @@ lambda_lift_expr({remote_u, Ct, F, Ar}) -> make_closure(FVs, Xs, {remote, Ct1, F, Args}); lambda_lift_expr(Expr) -> case Expr of - {int, _} -> Expr; - {string, _} -> Expr; - {account_pubkey, _} -> Expr; - {contract_pubkey, _} -> Expr; - {oracle_pubkey, _} -> Expr; - {oracle_query_id, _} -> Expr; - {bool, _} -> Expr; + {lit, _} -> Expr; nil -> Expr; {var, _} -> Expr; {closure, _, _} -> Expr; @@ -987,13 +983,7 @@ free_vars(Xs) when is_list(Xs) -> free_vars(Expr) -> case Expr of {var, X} -> [X]; - {int, _} -> []; - {string, _} -> []; - {account_pubkey, _} -> []; - {contract_pubkey, _} -> []; - {oracle_pubkey, _} -> []; - {oracle_query_id, _} -> []; - {bool, _} -> []; + {lit, _} -> []; nil -> []; {def, _, As} -> free_vars(As); {def_u, _, _} -> []; @@ -1034,13 +1024,7 @@ 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; - {account_pubkey, _} -> Expr; - {contract_pubkey, _} -> Expr; - {oracle_pubkey, _} -> Expr; - {oracle_query_id, _} -> Expr; - {bool, _} -> Expr; + {lit, _} -> Expr; nil -> nil; {var, X} -> {var, rename_var(Ren, X)}; {def, D, Es} -> {def, D, [rename(Ren, E) || E <- Es]}; @@ -1207,13 +1191,7 @@ pp_punctuate(Sep, [X | Xs]) -> [pp_beside(X, Sep) | pp_punctuate(Sep, Xs)]. pp_par([]) -> prettypr:empty(); pp_par(Xs) -> prettypr:par(Xs). -pp_fexpr({Tag, Lit}) when Tag == int; - Tag == string; - Tag == bool; - Tag == account_pubkey; - Tag == contract_pubkey; - Tag == oracle_pubkey; - Tag == oracle_query_id -> +pp_fexpr({lit, {Tag, Lit}}) -> aeso_pretty:expr({Tag, [], Lit}); pp_fexpr(nil) -> pp_text("[]"); @@ -1304,6 +1282,8 @@ pp_pat({tuple, Xs}) -> pp_fexpr({tuple, [{var, X} || X <- Xs]}); pp_pat({'::', X, Xs}) -> pp_fexpr({op, '::', [{var, X}, {var, Xs}]}); pp_pat({con, As, I, Xs}) -> pp_fexpr({con, As, I, [{var, X} || X <- Xs]}); pp_pat({var, X}) -> pp_fexpr({var, X}); +pp_pat(P = {Tag, _}) when Tag == bool; Tag == int; Tag == string + -> pp_fexpr({lit, P}); pp_pat(Pat) -> pp_fexpr(Pat). is_infix(Op) -> diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 03275bc..026ec5f 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -177,27 +177,16 @@ lookup_var(#env{vars = Vars}, X) -> %% -- The compiler -- -to_scode(_Env, {int, N}) -> - [push(?i(N))]; - -to_scode(_Env, {string, S}) -> - [push(?i(aeb_fate_data:make_string(S)))]; - -to_scode(_Env, {bool, B}) -> - [push(?i(B))]; - -to_scode(_Env, {account_pubkey, K}) -> - [push(?i(aeb_fate_data:make_address(K)))]; - -to_scode(_Env, {contract_pubkey, K}) -> - [push(?i(aeb_fate_data:make_address(K)))]; - -to_scode(_Env, {oracle_pubkey, K}) -> - [push(?i(aeb_fate_data:make_oracle(K)))]; - -to_scode(_Env, {oracle_query_id, K}) -> - %% Not actually in FATE yet - [push(?i(aeb_fate_data:make_oracle_query(K)))]; +to_scode(_Env, {lit, L}) -> + case L of + {int, N} -> [push(?i(N))]; + {string, S} -> [push(?i(aeb_fate_data:make_string(S)))]; + {bool, B} -> [push(?i(B))]; + {account_pubkey, K} -> [push(?i(aeb_fate_data:make_address(K)))]; + {contract_pubkey, K} -> [push(?i(aeb_fate_data:make_address(K)))]; + {oracle_pubkey, K} -> [push(?i(aeb_fate_data:make_oracle(K)))]; + {oracle_query_id, K} -> [push(?i(aeb_fate_data:make_oracle_query(K)))] %% TODO: Not actually in FATE yet + end; to_scode(_Env, nil) -> [aeb_fate_code:nil(?a)]; @@ -254,7 +243,7 @@ to_scode(Env, {remote, Ct, Fun, [_Gas, _Value | Args]}) -> call_to_scode(Env, [to_scode(Env, Ct), Call], Args); to_scode(Env, {closure, Fun, FVs}) -> - to_scode(Env, {tuple, [{string, make_function_name(Fun)}, FVs]}); + to_scode(Env, {tuple, [{lit, {string, make_function_name(Fun)}}, FVs]}); to_scode(Env, {switch, Case}) -> split_to_scode(Env, Case); -- 2.30.2 From bd33990786bc50860a653a2e5c7573bda3f0ae5a Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 7 May 2019 11:44:21 +0200 Subject: [PATCH 84/87] We now have block hash at height in FATE --- src/aeso_fcode_to_fate.erl | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 026ec5f..8a63455 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -386,10 +386,8 @@ 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, []}]) -> - [aeb_fate_code:blockhash(?a)]; -builtin_to_scode(_Env, chain_block_hash, [_]) -> - ?TODO(fate_block_hash_at_height_instruction); +builtin_to_scode(Env, chain_block_hash, [_] = Args) -> + call_to_scode(Env, aeb_fate_code:blockhash(?a, ?a), Args); builtin_to_scode(_Env, chain_coinbase, []) -> [aeb_fate_code:beneficiary(?a)]; builtin_to_scode(_Env, chain_timestamp, []) -> -- 2.30.2 From 63332c5cd157eab889ab95ac48e8ba2f94877abf Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 7 May 2019 09:08:33 +0200 Subject: [PATCH 85/87] Update aebytecode commit --- rebar.config | 2 +- rebar.lock | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/rebar.config b/rebar.config index a61cafd..bd0dda0 100644 --- a/rebar.config +++ b/rebar.config @@ -3,7 +3,7 @@ {erl_opts, [debug_info]}. {deps, [ {aebytecode, {git, "https://github.com/aeternity/aebytecode.git", - {ref, "1526ad3"}}} + {ref, "2555868"}}} , {getopt, "1.0.1"} , {jsx, {git, "https://github.com/talentdeficit/jsx.git", {tag, "2.8.0"}}} diff --git a/rebar.lock b/rebar.lock index 75cbf1e..a2d120e 100644 --- a/rebar.lock +++ b/rebar.lock @@ -1,11 +1,11 @@ {"1.1.0", [{<<"aebytecode">>, {git,"https://github.com/aeternity/aebytecode.git", - {ref,"1526ad3bf057e72a1714aea0430b001bd1d576c9"}}, + {ref,"2555868990ac2a08876e86b1b798b4750273591f"}}, 0}, {<<"aeserialization">>, {git,"https://github.com/aeternity/aeserialization.git", - {ref,"6dce265753af4e651f77746e77ea125145c85dd3"}}, + {ref,"816bf994ffb5cee218c3f22dc5fea296c9e0882e"}}, 1}, {<<"base58">>, {git,"https://github.com/aeternity/erl-base58.git", -- 2.30.2 From 519850e1fde5d51a280aac3050746395fffc9734 Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 7 May 2019 13:42:13 +0200 Subject: [PATCH 86/87] Get rid of catchall todos --- src/aeso_fcode_to_fate.erl | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 8a63455..10ab077 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -246,9 +246,7 @@ to_scode(Env, {closure, Fun, FVs}) -> to_scode(Env, {tuple, [{lit, {string, make_function_name(Fun)}}, FVs]}); to_scode(Env, {switch, Case}) -> - split_to_scode(Env, Case); - -to_scode(_Env, Icode) -> ?TODO(Icode). + split_to_scode(Env, Case). local_call( Env, Fun) when Env#env.tailpos -> aeb_fate_code:call_t(Fun); local_call(_Env, Fun) -> aeb_fate_code:call(Fun). @@ -447,9 +445,7 @@ builtin_to_scode(_Env, crypto_sha256, [_] = _Args) -> builtin_to_scode(_Env, crypto_blake2b, [_] = _Args) -> ?TODO(fate_crypto_blake2b_instruction); builtin_to_scode(_Env, auth_tx_hash, []) -> - ?TODO(fate_auth_tx_hash_instruction); -builtin_to_scode(_, B, Args) -> - ?TODO({builtin, B, Args}). + ?TODO(fate_auth_tx_hash_instruction). %% -- Operators -- -- 2.30.2 From a2b762c066ce18858abdc6e0594db6c8f7eeac1a Mon Sep 17 00:00:00 2001 From: Ulf Norell Date: Tue, 7 May 2019 13:58:19 +0200 Subject: [PATCH 87/87] Jump some hoops to please Dialyzer --- src/aeso_ast_to_fcode.erl | 8 +++++--- src/aeso_fcode_to_fate.erl | 13 +++++++------ 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/src/aeso_ast_to_fcode.erl b/src/aeso_ast_to_fcode.erl index 91ea6d7..0e06cac 100644 --- a/src/aeso_ast_to_fcode.erl +++ b/src/aeso_ast_to_fcode.erl @@ -80,6 +80,7 @@ -type ftype() :: integer | boolean + | string | {list, ftype()} | {map, ftype(), ftype()} | {tuple, [ftype()]} @@ -268,7 +269,7 @@ decl_to_fcode(Env = #{ functions := Funs }, {letfun, Ann, {id, _, Name}, Args, R NewFuns = Funs#{ FName => Def }, Env#{ functions := NewFuns }. --spec typedef_to_fcode(env(), aeso_syntax:id(), [aeso_syntax:tvar()], aeso_syntax:type_def()) -> env(). +-spec typedef_to_fcode(env(), aeso_syntax:id(), [aeso_syntax:tvar()], aeso_syntax:typedef()) -> env(). typedef_to_fcode(Env, {id, _, Name}, Xs, Def) -> Q = qname(Env, Name), FDef = fun(Args) -> @@ -659,8 +660,9 @@ pat_to_fcode(Env, Pat) -> -spec pat_to_fcode(env(), aeso_syntax:type() | no_type, aeso_syntax:pat()) -> fpat(). pat_to_fcode(_Env, _Type, {id, _, X}) -> {var, X}; -pat_to_fcode(Env, Type, {C, _, _} = Con) when C == con; C == qcon -> - pat_to_fcode(Env, Type, {app, [], {typed, [], Con, Type}, []}); +pat_to_fcode(Env, _Type, {C, _, _} = Con) when C == con; C == qcon -> + #con_tag{tag = I, arities = As} = lookup_con(Env, Con), + {con, As, I, []}; pat_to_fcode(Env, _Type, {app, _, {typed, _, {C, _, _} = Con, _}, Pats}) when C == con; C == qcon -> #con_tag{tag = I, arities = As} = lookup_con(Env, Con), {con, As, I, [pat_to_fcode(Env, Pat) || Pat <- Pats]}; diff --git a/src/aeso_fcode_to_fate.erl b/src/aeso_fcode_to_fate.erl index 10ab077..d70f2cb 100644 --- a/src/aeso_fcode_to_fate.erl +++ b/src/aeso_fcode_to_fate.erl @@ -18,7 +18,7 @@ | switch_body | tuple(). %% FATE instruction --type arg() :: aeb_fate_code:fate_arg(). +-type arg() :: tuple(). %% Not exported: aeb_fate_code:fate_arg(). %% Annotated scode -type scode_a() :: [sinstr_a()]. @@ -97,7 +97,7 @@ debug(Tag, Options, Fmt, Args) -> Tags = proplists:get_value(debug, Options, []), - case Tags == all orelse lists:member(Tag, Tags) orelse Tag == any andalso Tags /= [] of + case Tags == all orelse lists:member(Tag, Tags) of true -> io:format(Fmt, Args); false -> ok end. @@ -185,7 +185,7 @@ to_scode(_Env, {lit, L}) -> {account_pubkey, K} -> [push(?i(aeb_fate_data:make_address(K)))]; {contract_pubkey, K} -> [push(?i(aeb_fate_data:make_address(K)))]; {oracle_pubkey, K} -> [push(?i(aeb_fate_data:make_oracle(K)))]; - {oracle_query_id, K} -> [push(?i(aeb_fate_data:make_oracle_query(K)))] %% TODO: Not actually in FATE yet + {oracle_query_id, _} -> ?TODO(fate_oracle_query_id_value) end; to_scode(_Env, nil) -> @@ -743,9 +743,10 @@ var_writes(I) -> _ -> [] end. -independent({switch, _, _, _, _}, _) -> false; +-spec independent(sinstr_a(), sinstr_a()) -> boolean(). +%% independent({switch, _, _, _, _}, _) -> false; %% Commented due to Dialyzer whinging independent(_, {switch, _, _, _, _}) -> false; -independent(switch_body, _) -> true; +%% independent(switch_body, _) -> true; independent(_, switch_body) -> true; independent({i, _, I}, {i, _, J}) -> #{ write := WI, read := RI, pure := PureI } = attributes(I), @@ -768,7 +769,7 @@ merge_ann(#{ live_in := LiveIn }, #{ live_out := LiveOut }) -> %% Swap two instructions. Precondition: the instructions are independent/2. swap_instrs(I, switch_body) -> {switch_body, I}; -swap_instrs(switch_body, I) -> {I, switch_body}; +%% swap_instrs(switch_body, I) -> {I, switch_body}; %% Commented due to Dialyzer whinging swap_instrs({i, #{ live_in := Live1 }, I}, {i, #{ live_in := Live2, live_out := Live3 }, J}) -> %% Since I and J are independent the J can't read or write anything in %% that I writes. -- 2.30.2