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().