nomsu/core/operators.nom

#!/usr/bin/env nomsu -V2.5.5.4
#
    This file contains definitions of operators like "+" and "and".

use "core/metaprogramming.nom"
use "core/errors.nom"

test:
    assume (all [1 < 2, 2 > 1, 1 <= 2, 2 >= 1, 1 == 1, 1 != 2])

# Comparison Operators
compile [%x < %y] to (Lua value "(\(%x as lua expr) < \(%y as lua expr))")
compile [%x > %y] to (Lua value "(\(%x as lua expr) > \(%y as lua expr))")
compile [%x <= %y] to (Lua value "(\(%x as lua expr) <= \(%y as lua expr))")
compile [%x >= %y] to (Lua value "(\(%x as lua expr) >= \(%y as lua expr))")
compile [%a is %b, %a == %b] to (..)
    Lua value "(\(%a as lua expr) == \(%b as lua expr))"

compile [%a isn't %b, %a is not %b, %a not= %b, %a != %b] to (..)
    Lua value "(\(%a as lua expr) ~= \(%b as lua expr))"

# For strict identity checking, use (%x's id) is (%y's id)
test:
    assume (([] == []) and (([]'s id) != ([]'s id)))

lua> ".."
    do
        local new_uuid = require('uuid')
        local NaN_surrogate = {}
        local nil_surrogate = {}
        IDS = setmetatable({}, {
            __mode = "k",
            __index = function(self, key)
                if key == nil then return self[nil_surrogate]
                elseif key ~= key then return self[NaN_surrogate] end
                local id = new_uuid()
                self[key] = id
                return id
            end
        })
    end

compile [% 's id, id of %] to (Lua value "IDS[\(% as lua expr)]")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

test:
    %x = 10
    assume (%x == 10)

# Variable assignment operator
compile [%var = %value] to:
    lua> "local \%var_lua = \(%var as lua)"
    assume %var_lua.is_value or barf "Invalid target for assignment: \%var"
    lua> ".."
        \%value = \%value:map(function(t)
            if Action:is_instance(t) and t.stub == "?" then
                return \%var
            end
        end)
        local \%value_lua = \(%value as lua)
    
    assume %value_lua.is_value or barf "Invalid value for assignment: \%value"
    lua> ".."
        local lua = LuaCode(tree.source, \%var_lua, ' = ', \%value_lua, ';')
        if \%var.type == 'Var' then
            lua:add_free_vars({tostring(nomsu:compile(\%var))})
        end
        return lua

test:
    set {%x:10, %y:20}
    assume ((%x == 10) and (%y == 20)) or barf "mutli-assignment failed."
    set {%x:%y, %y:%x}
    assume ((%y == 10) and (%x == 20)) or barf "swapping vars failed."

# Simultaneous mutli-assignments like: x,y,z = 1,x,3;
compile [set %assignments] to:
    assume (%assignments.type is "Dict") or barf ".."
        Expected a Dict for the assignments part of '<- %' statement, not \%assignments
    lua> ".."
        local lhs, rhs = LuaCode(tree.source), LuaCode(tree.source)
        for i, item in ipairs(\%assignments) do
            local \%target, \%value = item[1], item[2]
            \%value = \%value:map(function(t)
                if Action:is_instance(t) and t.stub == "?" then
                    return \%target
                end
            end)
            local target_lua = \(%target as lua)
            if not target_lua.is_value then error("Invalid target for assignment: "..\(..)
            %target as text
        ..) end
            local value_lua = \(%value as lua)
            if not value_lua.is_value then error("Invalid value for assignment: "..\(..)
            %value as text
        ..) end
            if \%target.type == "Var" then
                lhs:add_free_vars({tostring(target_lua)})
            end
            if i > 1 then
                lhs:append(", ")
                rhs:append(", ")
            end
            lhs:append(target_lua)
            rhs:append(value_lua)
        end
        return LuaCode(tree.source, lhs, " = ", rhs, ";")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

test:
    set {%foozle:"outer", %y:"outer"}
    action [set global x local y]:
        external %foozle = "inner"
        %y = "inner"
    
    set global x local y
    assume ((%foozle == "inner") and (%y == "outer")) or barf "external failed."

compile [external %var = %value] to:
    %var_lua = (%var as lua)
    assume %var_lua.is_value or barf "Invalid target for assignment: \%var"
    %value_lua = (%value as lua)
    assume %value_lua.is_value or barf "Invalid value for assignment: \%value"
    return (Lua "\%var_lua = \%value_lua;")

test:
    set {%foozle:"outer", %y:"outer"}
    action [set global x local y] (..)
        with external [%foozle]:
            %foozle = "inner"
            %y = "inner"
    
    set global x local y
    assume ((%foozle == "inner") and (%y == "outer")) or barf ".."
        'with external' failed.

compile [with external %externs %body] to:
    %body_lua = (%body as lua statements)
    lua> ".."
        \%body_lua:remove_free_vars(table.map(\%externs, function(v) return tostring(nomsu:compile(v)) end))
    return %body_lua

test:
    set {%x:1, %y:2}
    with {%z:nil, %x:999}:
        %z = 999
        assume (%z == 999) or barf "'with' failed."
        assume (%x == 999) or barf "'with' assignment failed."
    
    assume (%x == 1) or barf "'with' scoping failed"
    assume (%z == (nil)) or barf "'with' scoping failed"

compile [with %assignments %body] to:
    %lua = (%body as lua statements)
    lua> ".."
        local lhs, rhs = LuaCode(tree.source), LuaCode(tree.source)
        local vars = {}
        for i, item in ipairs(\%assignments) do
            local \%target, \%value = item[1], item[2]
            if not \%target.type == "Var" then
                error("Invalid target for 'with' assignment: "..tostring(\%target))
            end
            local target_lua = \(%target as lua)
            local value_lua = \(%value as lua)
            if not value_lua.is_value then
                error("Invalid value for assignment: "..tostring(\%value))
            end
            if i > 1 then
                lhs:append(", ")
                rhs:append(", ")
            end
            lhs:append(target_lua)
            rhs:append(value_lua)
            if \%target.type == "Var" then
                vars[i] = tostring(target_lua)
            end
        end
        \%lua:remove_free_vars(vars)
        \%lua:prepend("local ", lhs, " = ", rhs, ";\\n")
    
    return (..)
        Lua ".."
            do
                \%lua
            end -- 'with' block

# Math Operators
test:
    assume ((5 wrapped around 2) == 1) or barf "mod not working"

compile [%x wrapped around %y, %x mod %y] to (..)
    Lua value "(\(%x as lua expr) % \(%y as lua expr))"

# 3-part chained comparisons
# (uses a lambda to avoid re-evaluating middle value, while still being an expression)
test:
    %calls = 0
    local action [one]:
        external %calls = (%calls + 1)
        return 1
    
    assume (0 <= (one) <= 2) or barf "Three-way chained comparison failed."
    assume (%calls == 1) or barf ".."
        Three-way comparison evaluated middle value multiple times

parse [%x < %y < %z] as (..)
    call ([%a, %b, %c] -> ((%a < %b) and (%b < %c))) with [%x, %y, %z]

parse [%x <= %y < %z] as (..)
    call ([%a, %b, %c] -> ((%a <= %b) and (%b < %c))) with [%x, %y, %z]

parse [%x < %y <= %z] as (..)
    call ([%a, %b, %c] -> ((%a < %b) and (%b <= %c))) with [%x, %y, %z]

parse [%x <= %y <= %z] as (..)
    call ([%a, %b, %c] -> ((%a <= %b) and (%b <= %c))) with [%x, %y, %z]

parse [%x > %y > %z] as (..)
    call ([%a, %b, %c] -> ((%a > %b) and (%b > %c))) with [%x, %y, %z]

parse [%x >= %y > %z] as (..)
    call ([%a, %b, %c] -> ((%a >= %b) and (%b > %c))) with [%x, %y, %z]

parse [%x > %y >= %z] as (..)
    call ([%a, %b, %c] -> ((%a > %b) and (%b >= %c))) with [%x, %y, %z]

parse [%x >= %y >= %z] as (..)
    call ([%a, %b, %c] -> ((%a >= %b) and (%b >= %c))) with [%x, %y, %z]

# TODO: optimize for common case where x,y,z are all either variables or number literals
# Boolean Operators
test:
    local action [barfer] (barf "short circuiting failed")
    assume (((no) and (barfer)) == (no))
    assume ((no) or (yes))
    assume ((yes) or (barfer))

compile [%x and %y] to (Lua value "(\(%x as lua expr) and \(%y as lua expr))")
compile [%x or %y] to (Lua value "(\(%x as lua expr) or \(%y as lua expr))")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Bitwise Operators
# TODO: implement OR, XOR, AND for multiple operands?
test:
    assume ((1 | 4) == 5)
    assume ((1 ~ 3) == 2)
    assume ((1 & 3) == 1)
    assume ((1 << 2) == 4)
    assume ((4 >> 2) == 1)

# Lua 5.3 introduced bit operators like | and &. Use them when possible, otherwise
    fall back to bit.bor(), bit.band(), etc.
%use_bitops = ((is jit) or ((Lua version) == "Lua 5.2"))
compile [NOT %, ~ %] to (..)
    Lua value (..)
        (%use_bitops and "bit.bnot(\(% as lua expr))") or "~(\(% as lua expr))"

compile [%a OR %b, %a | %b] to (..)
    Lua value (..)
        (%use_bitops and "bit.bor(\(%a as lua expr), \(%b as lua expr))") or ".."
            (\(%a as lua expr) | \(%b as lua expr))

compile [%a XOR %b, %a ~ %b] to (..)
    Lua value (..)
        (%use_bitops and "bit.bxor(\(%a as lua expr), \(%b as lua expr))") or ".."
            (\(%a as lua expr) ~ \(%b as lua expr))

compile [%a AND %b, %a & %b] to (..)
    Lua value (..)
        (%use_bitops and "bit.band(\(%a as lua expr), \(%b as lua expr))") or ".."
            (\(%a as lua expr) & \(%b as lua expr))

compile [%x LSHIFT %shift, %x << %shift] to (..)
    Lua value (..)
        (%use_bitops and "bit.lshift(\(%x as lua expr), \(%shift as lua expr))") or ".."
            (\(%x as lua expr) << \(%shift as lua expr))

compile [%x RSHIFT %shift, %x >>> %shift] to (..)
    Lua value (..)
        (%use_bitops and "bit.rshift(\(%x as lua expr), \(%shift as lua expr))") or ".."
            (\(%x as lua expr) >>> \(%shift as lua expr))

compile [%x ARSHIFT %shift, %x >> %shift] to (..)
    Lua value (..)
        (%use_bitops and "bit.arshift(\(%x as lua expr), \(%shift as lua expr))") or ".."
            (\(%x as lua expr) >> \(%shift as lua expr))

# Unary operators
test:
    assume ((- 5) == -5)
    assume ((not (yes)) == (no))

compile [- %] to (Lua value "(- \(% as lua expr))")
compile [not %] to (Lua value "(not \(% as lua expr))")
test:
    assume ((length of [1, 2, 3]) == 3)

compile [length of %list, len %list, || %list ||] to (..)
    Lua value "(#\(%list as lua expr))"

compile [%list is empty] to (Lua value "(#\(%list as lua expr) == 0)")

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Update operators
test:
    %x = 1
    %x += 1
    assume (%x == 2) or barf "+= failed"
    %x *= 2
    assume (%x == 4) or barf "*= failed"
    wrap %x around 3
    assume (%x == 1) or barf "wrap around failed"

parse [%var += %] as (%var = (%var + %))
parse [%var -= %] as (%var = (%var - %))
parse [%var *= %] as (%var = (%var * %))
parse [%var /= %] as (%var = (%var / %))
parse [%var ^= %] as (%var = (%var ^ %))
parse [%var and= %] as (%var = (%var and %))
parse [%var or= %] as (%var = (%var or %))
parse [wrap %var around %] as (%var = (%var wrapped around %))