src/marina_compiler.erl

-module(marina_compiler).
-include("marina_internal.hrl").

-export([
    ring_utils/1
]).

%% public
-spec ring_utils(tuple()) -> ok.

ring_utils(Tree) ->
    compile_and_load_forms(forms(Tree)),
    ok.

%% private
compile_and_load_forms(Forms) ->
    {ok, Module, Bin} = compile:forms(Forms, [debug_info]),
    code:soft_purge(Module),
    Filename = atom_to_list(Module) ++ ".erl",
    {module, Module} = code:load_binary(Module, Filename, Bin).

forms(Tree) ->
    Module = erl_syntax:attribute(erl_syntax:atom(module),
        [erl_syntax:atom(marina_ring_utils)]),
    ExportList = [
        erl_syntax:arity_qualifier(erl_syntax:atom(lookup), erl_syntax:integer(1))
    ],
    Export = erl_syntax:attribute(erl_syntax:atom(export),
        [erl_syntax:list(ExportList)]),
    Function = erl_syntax:function(erl_syntax:atom(lookup),
        [tree_lookup_clause(Tree)]),
    Mod = [Module, Export, Function],
    [erl_syntax:revert(X) || X <- Mod].

tree_lookup_clause(Tree) ->
    Var = erl_syntax:variable('Token'),
    Body = [tree_lookup_body(Tree, Var, find_rval(Tree))],
    erl_syntax:clause([Var], none, Body).

find_rval({_M, _L, R}) -> find_rval(R);
find_rval([_L, RVal]) -> RVal;
find_rval([RVal]) -> RVal.

tree_lookup_body(Tree, Var, RVal) ->
    case Tree of
        % intermediate
        {{Bound, _} = LVal, Left, Right} ->
            LGuard = erl_syntax:infix_expr(Var, erl_syntax:operator('<'),
                erl_syntax:integer(Bound)),
            LBody = [tree_lookup_body(Left, Var, LVal)],
            LClause = erl_syntax:clause([Var], LGuard, LBody),

            RBody = [tree_lookup_body(Right, Var, RVal)],
            RClause = erl_syntax:clause([erl_syntax:underscore()], none, RBody),

            erl_syntax:case_expr(Var, [LClause, RClause]);
        % complete leaf
        [{LBound, LAddr}, {RBound, MAddr}] ->
            {_, RAddr} = RVal,
            LGuard = erl_syntax:infix_expr(Var, erl_syntax:operator('<'),
                erl_syntax:integer(LBound)),
            LBody = [erl_syntax:tuple([erl_syntax:atom(ok),
                erl_syntax:atom(marina_pool:node_id(LAddr))])],
            LClause = erl_syntax:clause([Var], LGuard, LBody),

            MGuard = erl_syntax:infix_expr(Var, erl_syntax:operator('<'),
                erl_syntax:integer(RBound)),
            MBody = [erl_syntax:tuple([erl_syntax:atom(ok),
                erl_syntax:atom(marina_pool:node_id(MAddr))])],
            MClause = erl_syntax:clause([Var], MGuard, MBody),

            RBody = [erl_syntax:tuple([erl_syntax:atom(ok),
                erl_syntax:atom(marina_pool:node_id(RAddr))])],
            RClause = erl_syntax:clause([erl_syntax:underscore()], none, RBody),

            erl_syntax:case_expr(Var, [LClause, MClause, RClause]);
        % incomplete leaf
        [{LBound, LAddr}] ->
            {_, RAddr} = RVal,
            LGuard = erl_syntax:infix_expr(Var, erl_syntax:operator('<'),
                erl_syntax:integer(LBound)),
            LBody = [erl_syntax:tuple([erl_syntax:atom(ok),
                erl_syntax:atom(marina_pool:node_id(LAddr))])],
            LClause = erl_syntax:clause([Var], LGuard, LBody),

            RBody = [erl_syntax:tuple([erl_syntax:atom(ok),
                erl_syntax:atom(marina_pool:node_id(RAddr))])],
            RClause = erl_syntax:clause([erl_syntax:underscore()], none, RBody),

            erl_syntax:case_expr(Var, [LClause, RClause])
    end.