Attempt to encode Perl6 Junctions in Lua.

junction.lua

-- begin --

local export = { }

local kind = {
  only = 1, all  = 2, any = 3,
  one  = 4, none = 5,
}

local antikind = {
  'only', 'all', 'any', 'one', 'none',
}

local new, metajunction, map
local rel, eq, lt, le
local gt, ge, show
local access, invoke

local function rel (binop, swp)
  return function (self, that)
    local times = 0

    if self.kind == kind.only and that.kind ~= kind.only then
      return rel (swp, binop) (that, self)
    end

    for _, param in ipairs (self.params) do
      local snd  = that.kind == kind.only and
        that.params[ 1 ] or that
      local bool = binop (param, snd)

      if bool then
        if self.kind == kind.one and times > 0 then
          return false
        elseif self.kind == kind.none then
          return false
        else
          times = times + 1
        end
      else
        if self.kind == kind.all then
          return false
        else

        end
      end
    end

    if self.kind == kind.any and times == 0 then
      return false
    else
      return true
    end
  end
end

function eq  (x, y) return x == y end
function le  (x, y) return x <= y end
function lt  (x, y) return x <  y end
function ge  (x, y) return x >= y end
function gt  (x, y) return x >  y end

function show (self)
  return ("%s (%s)"): format (
    antikind[ self.kind ],
    table.concat (self.params, ', ')
  )
end

function map (self, code)
  local result = { }

  for index, param in ipairs (self.params) do
    result[ index ] = code (param)
  end

  return setmetatable ({
    kind   = self.kind,
    params = result,
  }, metajunction)
end

function access (self, slot)
  return map (self, function (param)
    return param[ slot ]
  end)
end

function invoke (self, ...)
  local args = { ... }

  return map (self, function (param)
    return param (unpack (args))
  end)
end

metajunction = {
  __eq       = rel (eq, eq),
  __le       = rel (le, ge),
  __lt       = rel (lt, gt),
  __tostring = show,
  __index    = access,
  __call     = invoke,
}

function new (slot, ...)
  return setmetatable ({
    kind   = slot,
    params = { ... },
  }, metajunction)
end

function export.all (first, ...)
  assert (first)
  return new (kind.all, first, ...)
end

function export.any (first, ...)
  assert (first)
  return new (kind.any, first, ...)
end

function export.none (first, ...)
  assert (first)
  return new (kind.none, first, ...)
end

function export.one (first, ...)
  assert (first)
  return new (kind.one, first, ...)
end

function export.only (scalar)
  assert (scalar)
  return new (kind.only, scalar)
end

function export.import ( )
  _G.only = export.only
  _G.all  = export.all
  _G.any  = export.any
  _G.one  = export.one
  _G.none = export.none
end

return export

-- end --

require ('junction').import ( )

print (only (5) == one  (5, 4, 5)) -- --> false
print (only (5) == all  (5, 4, 5)) -- --> false
print (only (5) == none (5, 4, 5)) -- --> false
print (only (5) == any  (5, 4, 5)) -- --> true

print (one  (5, 4, 5) == only (5)) -- --> false
print (all  (5, 4, 5) == only (5)) -- --> false
print (none (5, 4, 5) == only (5)) -- --> false
print (any  (5, 4, 5) == only (5)) -- --> true

print (one ({ x = 5 }, { x = 7 }).x) -- --> one (5, 7)
print (any (math.max, math.min) (4, 9, 2, 3)) -- --> any (9, 2)

-- end --