retex-lua 1.3.0-rc.3

-- Lua 5.1/5.2 compatibility functions present in LuaTeX's Lua 5.3:
-- unpack, loadstring, module, package.loaders, package.seeall, bit32,
-- math.pow, math.ldexp, math.frexp, math.atan2, math.cosh, math.sinh,
-- math.tanh and math.log10.
--
-- Written for retex from the Lua 5.1 and 5.2 reference manuals; the set
-- of functions is the one texlua exposes (table.maxn, table.getn, setfenv
-- and friends are absent there too).
local floor, huge, tointeger = math.floor, math.huge, math.tointeger
local type, error, select, rawget, setmetatable = type, error, select, rawget, setmetatable

unpack = table.unpack
loadstring = load
package.loaders = package.searchers

function math.pow(x, y) return x ^ y end
function math.ldexp(m, e) return m * 2.0 ^ e end
function math.cosh(x) return (math.exp(x) + math.exp(-x)) / 2 end
function math.sinh(x) return (math.exp(x) - math.exp(-x)) / 2 end
function math.tanh(x)
  if x > 20 then return 1.0 elseif x < -20 then return -1.0 end
  local a, b = math.exp(x), math.exp(-x)
  return (a - b) / (a + b)
end
function math.atan2(y, x) return math.atan(y, x) end
function math.log10(x) return math.log(x, 10) end
function math.frexp(x)
  if x == 0 or x ~= x or x == huge or x == -huge then return x * 1.0, 0 end
  local m, e = x < 0 and -x or x, 0
  while m >= 1.0 do m, e = m / 2.0, e + 1 end
  while m < 0.5 do m, e = m * 2.0, e - 1 end
  return x < 0 and -m or m, e
end

-- module(name [, ...]) (Lua 5.1 manual §5.3).
function package.seeall(m)
  local mt = getmetatable(m)
  if not mt then
    mt = {}
    setmetatable(m, mt)
  end
  mt.__index = _G
end

local function findtable(root, name)
  local t = root
  for part in name:gmatch("[^.]+") do
    local v = rawget(t, part)
    if v == nil then
      v = {}
      t[part] = v
    elseif type(v) ~= "table" then
      return nil
    end
    t = v
  end
  return t
end

function module(name, ...)
  if type(name) ~= "string" then
    error("bad argument #1 to 'module' (string expected, got " ..
      (name == nil and "no value" or type(name)) .. ")", 2)
  end
  local loaded = package.loaded
  local m = loaded[name]
  if type(m) ~= "table" then
    m = findtable(_G, name)
    if not m then error("name conflict for module '" .. name .. "'", 2) end
    loaded[name] = m
  end
  if m._NAME == nil then
    m._M = m
    m._NAME = name
    m._PACKAGE = name:match("^(.*%.)[^.]*$") or ""
  end
  -- Make m the environment of the calling chunk.
  local f = debug.getinfo(2, "f").func
  local i = 1
  while true do
    local n = debug.getupvalue(f, i)
    if n == nil then break end
    if n == "_ENV" then
      debug.setupvalue(f, i, m)
      break
    end
    i = i + 1
  end
  for k = 1, select("#", ...) do
    (select(k, ...))(m)
  end
end

-- bit32 (Lua 5.2 manual §6.7): numbers are taken modulo 2^32.
local MASK = 0xFFFFFFFF

local function u32(x)
  local i = tointeger(x)
  if not i then
    if type(x) ~= "number" then x = tonumber(x) or error("number expected", 3) end
    i = tointeger(floor(x)) or 0
  end
  return i & MASK
end

local bit32 = {}

function bit32.band(...)
  local r = MASK
  for k = 1, select("#", ...) do r = r & u32((select(k, ...))) end
  return r
end
function bit32.bor(...)
  local r = 0
  for k = 1, select("#", ...) do r = r | u32((select(k, ...))) end
  return r
end
function bit32.bxor(...)
  local r = 0
  for k = 1, select("#", ...) do r = r ~ u32((select(k, ...))) end
  return r
end
function bit32.btest(...) return bit32.band(...) ~= 0 end
function bit32.bnot(x) return ~u32(x) & MASK end

local function shift(x, n)
  x = u32(x)
  if n <= -32 or n >= 32 then return 0 end
  if n >= 0 then return (x << n) & MASK end
  return x >> -n
end
function bit32.lshift(x, n) return shift(x, tointeger(n) or floor(n)) end
function bit32.rshift(x, n) return shift(x, -(tointeger(n) or floor(n))) end
function bit32.arshift(x, n)
  x = u32(x)
  n = tointeger(n) or floor(n)
  if n < 0 or (x & 0x80000000) == 0 then return shift(x, -n) end
  if n >= 32 then return MASK end
  return ((x >> n) | ~(MASK >> n)) & MASK
end
local function rotate(x, n)
  x = u32(x)
  n = n % 32
  return ((x << n) | (x >> (32 - n))) & MASK
end
function bit32.lrotate(x, n) return rotate(x, tointeger(n) or floor(n)) end
function bit32.rrotate(x, n) return rotate(x, -(tointeger(n) or floor(n))) end

local function fieldargs(f, w)
  f = tointeger(f) or floor(f)
  w = w == nil and 1 or (tointeger(w) or floor(w))
  if f < 0 then error("bad argument #2 to 'extract' (field cannot be negative)", 0) end
  if w <= 0 then error("bad argument #3 to 'extract' (width must be positive)", 0) end
  if f + w > 32 then error("trying to access non-existent bits", 0) end
  return f, w
end
function bit32.extract(x, f, w)
  f, w = fieldargs(f, w)
  return (u32(x) >> f) & ((1 << w) - 1)
end
function bit32.replace(x, v, f, w)
  f, w = fieldargs(f, w)
  local m = ((1 << w) - 1) << f
  return (u32(x) & ~m | (u32(v) << f) & m) & MASK
end

_G.bit32 = bit32
package.loaded.bit32 = bit32