nomsu/lib/operators.nom

require "lib/metaprogramming.nom"

# Literals
compile [true, yes] to: "true"
compile [false, no] to: "false"
compile [nil, null] to: "nil"
compile [inf, infinity] to: "math.huge"
compile [nan, NaN, not a number] to: "(0/0)"
compile [pi, PI] to: "math.pi"
compile [tau, TAU] to: "(2*math.pi)"
compile [phi, PHI, golden ratio] to: "((1+math.sqrt(5))/2)"
compile [nop, pass] to code: ""

# Ternary operator
#.. Note: this uses a function instead of (condition and if_expr or else_expr)
    because that breaks if %if_expr is falsey.
compile [..]
    %when_true_expr if %condition else %when_false_expr
    %when_true_expr if %condition otherwise %when_false_expr
    %when_false_expr unless %condition else %when_true_expr
    %when_false_expr unless %condition then %when_true_expr
..to: ".."
    (function(nomsu, vars)
        if \(%condition as lua) then
            return \(%when_true_expr as lua);
        else
            return \(%when_false_expr as lua);
        end
    end)(nomsu, vars)

# Indexing:
compile [%obj'%key, %obj's %key, %obj -> %key] to: "(\(%obj as lua))[\(%key as lua)]"

# Variable assignment operator, and += type versions
compile [%var = %val] to code:
    lua> ".."
        if \%var.type == 'List' and \%val.type == 'List' then
            local lhs = {};
            for i,x in ipairs(\%var.value) do lhs[i] = nomsu:tree_to_lua(x); end
            local rhs = {};
            for i,x in ipairs(\%val.value) do rhs[i] = nomsu:tree_to_lua(x); end
            return table.concat(lhs, ", ").." = "..table.concat(rhs, ", ")..";";
        else
            return \(%var as lua).." = "..\(%val as lua)..";";
        end
compile [%var += %val] to code: "\(%var as lua) = \(%var as lua) + \(%val as lua);"
compile [%var -= %val] to code: "\(%var as lua) = \(%var as lua) - \(%val as lua);"
compile [%var *= %val] to code: "\(%var as lua) = \(%var as lua) * \(%val as lua);"
compile [%var /= %val] to code: "\(%var as lua) = \(%var as lua) / \(%val as lua);"
compile [%var ^= %val] to code: "\(%var as lua) = \(%var as lua) ^ \(%val as lua);"
compile [%var and= %val] to code: "\(%var as lua) = \(%var as lua) and\(%val as lua);"
compile [%var or= %val] to code: "\(%var as lua) = \(%var as lua) or \(%val as lua);"
compile [%var join= %val] to code: "\(%var as lua) = \(%var as lua) .. \(%val as lua);"
compile [%var mod= %val] to code: "\(%var as lua) = \(%var as lua) % \(%val as lua);"

# Binary Operators
lua do> ".."
    local binops = {"-","/","<","<=",">",">=","^",{"===","=="},{"!==","~="},{"mod","%"}};
    for _,op in ipairs(binops) do
        local nomsu_alias = op;
        if type(op) == 'table' then;
            nomsu_alias, op = unpack(op);
        end
        nomsu:defmacro("%a "..nomsu_alias.." %b", (function(nomsu, vars)
            return "("..nomsu:tree_to_lua(\%a).." "..op.." "..nomsu:tree_to_lua(\%b)..")";
        end), [["(\\%a ]]..op..[[ \\%b)"]]);
    end

# TODO: implement OR, XOR, AND for multiple operands
compile [%a OR %b, %a | %b] to: "bit32.bor(\(%a as lua), \(%b as lua))"
compile [%a XOR %b] to: "bit32.bxor(\(%a as lua), \(%b as lua))"
compile [%a AND %b, %a & %b] to: "bit32.band(\(%a as lua), \(%b as lua))"
compile [NOT %, ~ %] to: "bit32.bnot(\(% as lua))"
compile [%x LSHIFT %shift, %x << %shift] to: "bit32.lshift(\(%x as lua), \(%shift as lua))"
compile [%x RSHIFT %shift] to: "bit32.rshift(\(%x as lua), \(%shift as lua))"
compile [%x ARSHIFT %shift, %x >> %shift] to: "bit32.arshift(\(%x as lua), \(%shift as lua))"
# == and != do equivalence checking, rather than identity checking
compile [%a == %b] to: "nomsu.utils.equivalent(\(%a as lua), \(%b as lua))"
compile [%a != %b] to: "(not nomsu.utils.equivalent(\(%a as lua), \(%b as lua)))"

# Commutative Operators defined for up to 8 operands
# TODO: work out solution for commutative operators using more clever macros
lua do> ".."
    local max_operands = 8;
    local comops = {"+","*","and","or"};
    for _,_op in ipairs(comops) do
        local op = _op;
        local spec = "%1 ";
        for n=2,max_operands do
            spec = spec .." "..op.." %"..tostring(n);
            nomsu:defmacro(spec, (function(nomsu, vars)
                local bits = {};
                for i=1,n do
                    table.insert(bits, (nomsu:tree_to_lua(vars[tostring(i)])));
                end
                return "("..table.concat(bits, " "..op.." ")..")";
            end));
        end
    end

# Chained compairsions (e.g. x < y <= z) are defined up to 3 operands
lua do> ".."
    local max_operands = 3;
    for _,chainers in ipairs({{"<","<="},{">",">="}}) do
        local function recurse(chainers, chain)
        -- The 1-op versions are already more efficiently defined, and a 0-op version doesnt make sense
            if #chain >= 2 then;
                local spec = "%1";
                for i,op in ipairs(chain) do
                    spec = spec .. " "..op.." %"..tostring(i+1);
                end
                -- Chained comparisons need to be functions to avoid re-evaluating their arguments :
                nomsu:def(spec, function(nomsu, vars)
                    for i,op in ipairs(chain) do
                        local a, b, result = vars[tostring(i)], vars[tostring(i+1)];
                        if     op == "<"  then; result = a < b;
                        elseif op == "<=" then; result = a <= b;
                        elseif op == ">"  then; result = a > b;
                        elseif op == ">=" then; result = a >= b; end
                -- Short circuit
                        if not result then; return false; end
                    end
                end);
            end
            if #chain + 1 >= max_operands then; return; end
            for _,c in ipairs(chainers) do
                table.insert(chain, c);
                recurse(chainers, chain);
                table.remove(chain);
            end
        end
        recurse(chainers, {});
    end

# Unary operators
compile [- %] to: "-(\(% as lua))"
compile [not %] to: "not (\(% as lua))"