Re: Embedding in Erlang

["Robert G. Jakabosky" <bobby@...>]

On Tuesday 23, Henning Diedrich wrote:
> Hi list,
>
> I posted some details on how to efficiently embed Lua in Erlang here:
> http://www.eonblast.com/blog/optimizing-erlualib-calls/
>
> It's about embedding Lua in Erlang as a driver port, discussing in
> detail how to go beyond single step stack manipulation port calls
> towards directly accessing the Lua C API in one go. In the end I thought
> the post might be quite interesting to get a feel for the issue.

About a month ago I create the attached Lua module for encoding/decoding 
Erlang binaries.  It would be interesting to see Erlang style processes 
written in Lua (maybe using ConcurrentLua [1]) and have them send messages 
back and forth with Erlang processes.

Right now it can handle most of the basic types:
integer, float, atom, string, nil, tuple, list

but not these types:
reference id, port id, pid id, binaries, bignums, functions, exports, bit 
binary, new floats

Most of the unimplemented types can be stored in there binary format in-side a 
Lua table (so they can have a type tag like tuples & lists) so that they can 
still be passed around.

For a description of Erlang's binary term format see [2].

Tuples & lists are converted to/from Lua tables with metatables to mark them 
as a tuple or list.

The module depends on LuaSocket & Roberto's struct [3] module.

LuaSocket is only used for the socket.gettime() function for creating Erlang 
Timestamps (See the now() function in erlang.lua).

1. http://concurrentlua.luaforge.net/
2. http://www.erlang.org/doc/apps/erts/erl_ext_dist.html
3. http://www.inf.puc-rio.br/~roberto/struct/

-- 
Robert G. Jakabosky

--[[
BSD-Licensed:
Copyright (c) 2010, Robert G. Jakabosky <bobby@sharedrealm.com>
All rights reserved.

Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
    * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
    * Neither the name of the SharedRealm nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

]]

local print = print
local type = type
local floor = math.floor
local modf = math.modf
local unpack = unpack
local string = string
local getmetatable = getmetatable
local setmetatable = setmetatable
local str_format = string.format
local str_char = string.char
local str_byte = string.byte
local str_rep = string.rep
local concat = table.concat
local assert = assert

local socket = require"socket"
local gettime = socket.gettime

local struct = require"struct"
local spack = struct.pack
local sunpack = struct.unpack

--
-- Erlang term metatables
--
local func_nil = function() end
local atoms = {}
local function atom_to_str(atom)
	return atoms[atom]
end
local atom_mt = {
__call = atom_to_str,
__index = { etype = 'atom' },
__newindex = function() assert(false, "can't change Erlang atoms.") end,
__tostring = atom_to_str,
}
local tuple_mt = {
__index = { etype = 'tuple' },
__newindex = function() assert(false, "can't change Erlang tuples.") end,
}
local list_mt = {
__index = { etype = 'list' },
__newindex = function(tab, key, value)
	assert(type(key) == 'number', "can only index an Erlang list by numbers")
	rawset(tab, key, value)
end,
}

--
-- Erlang terms
--
local function atom(str)
	-- check cache for atom.
	local atom = atoms[str]
	if atom then return atom end
	assert(#str <= 255, "atom too long, max atom length is 255.")
	-- create new atom 
	atom = setmetatable({},atom_mt)
	-- cache new atom
	atoms[str] = atom
	atoms[atom] = str
	return atom
end
local a_true = atom('true')
local a_false = atom('false')

local function is_atom(term)
	return term.etype == 'atom'
end

local function tuple(tab, ...)
	if type(tab) == 'table' then
		return setmetatable(tab,tuple_mt)
	end
	return setmetatable({tab, ...},tuple_mt)
end

local function is_tuple(term)
	return term.etype == 'tuple'
end

local function list(tab, ...)
	if type(tab) == 'table' then
		return setmetatable(tab,list_mt)
	end
	return setmetatable({tab, ...},list_mt)
end

local function is_list(term)
	return term.etype == 'list'
end

local function etype(term)
	local ltype = type(term)
	if ltype == 'table' then
		-- default lua tables to lists.
		return term.etype or 'list'
	elseif ltype == 'number' then
		local whole, fac = modf(term)
		if fac == 0 then return 'integer' end
		return 'float'
	elseif ltype == 'string' then
		return 'string'
	elseif ltype == 'boolean' then
		return 'integer'
	elseif ltype == 'nil' then
		return 'nil'
	end
	return 'unknown'
end

--
-- term serialization code.
--
local function _term_to_binary(term)
	local bin = ''

	local ltype = type(term)
	if ltype == 'table' then
		-- default lua tables to lists.
		local etype = term.etype or 'list'
		if etype == 'list' then
			local len = #term
			-- encode tag & length
			bin = '\108' .. spack('>I4', len)
			-- encode the list's terms.
			local term_bins = {}
			for i = 1, len do
				term_bins[i] = _term_to_binary(term[i])
			end
			bin = bin .. concat(term_bins) .. '\106'
		elseif etype == 'tuple' then
			local len = #term
			-- encode tag & length
			if len < 256 then
				bin = '\104' .. str_char(len)
			else
				bin = '\105' .. spack('>I4', len)
			end
			-- encode the tuple's terms.
			local term_bins = {}
			for i = 1, len do
				term_bins[i] = _term_to_binary(term[i])
			end
			bin = bin .. concat(term_bins)
		elseif etype == 'atom' then
			local atom_name = term()
			local alen = #atom_name
			assert(alen <= 255, "invalid atom, too long")
			bin = '\100' .. spack('>I2', alen) .. atom_name
		else
			assert(false, 'unhandled Erlang term type:' .. etype)
		end
	elseif ltype == 'number' then
		local whole, fac = modf(term)
		if fac == 0 then
			-- encode as an integer
			if whole < 256 then
				-- 8bit unsigned integer
				bin = '\97' .. str_char(term)
			else
				-- 32bit signed integer
				bin = '\98' .. spack('>i4', term)
			end
		else
			-- encode as a float
			local str_float = str_format('%.20e', term)
			local len = #str_float
			local pad = ''
			len = 31 - len
			if len > 0 then
				pad = str_rep('\0', len)
			end
			bin = '\99' .. str_float .. pad
		end
	elseif ltype == 'string' then
		local slen = #term
		if slen <= 65535 then
			-- string encode.
			bin = '\107' .. spack('>I2', slen) .. term
		else
			-- list encode
			bin = '\108' .. spack('>I4', slen) .. '\97' ..
				concat({str_byte(term)}, '\97') .. '\106'
		end
	elseif ltype == 'boolean' then
		if term then
			-- true atom
			bin = '\100\0\4true'
		else
			-- false atom
			bin = '\100\0\5false'
		end
	elseif ltype == 'nil' then
		bin = '\106'
	end
	return bin
end

-- de-serialize
local decoders
local function _binary_to_term(bin, n)
	local term
	local tag = bin:byte(n)
	local f = decoders[tag]

	assert(f,'no decoder function for Erlang term tag: ' .. tag)

	-- call decoder
	return f(bin, n + 1)
end

local function _binary_to_array(len, bin, n)
	local ary = {}

	for i = 1, len do
		ary[i], n = _binary_to_term(bin, n)
	end

	return ary, n
end

decoders = {
-- small integer
[97] = function(bin, n)
	return bin:byte(n), n + 1
end,
-- integer
[98] = function(bin, n)
	return sunpack('>i4', bin, n)
end,
-- float
[99] = function(bin, n)
	local n_end = n + 31
	local num = bin:sub(n, n_end)
	local idx = num:find('\0', 1, true)
	if idx == nil then idx = 0 end
	return loadstring('return ' .. num:sub(1, idx - 1))(), n_end
end,
-- atom
[100] = function(bin, n)
	local atom_name, n = sunpack('>i2c0', bin, n)
	local atom = atom(atom_name)
	-- convert true/false atoms to bools
	if atom == a_true then
		atom = true
	elseif atom == a_false then
		atom = false
	end
	return atom, n
end,
-- small tuple
[104] = function(bin, n)
	local t
	local len = bin:byte(n)

	t, n = _binary_to_array(len, bin, n+1)

	return tuple(t), n
end,
-- large tuple
[105] = function(bin, n)
	local t
	local len

	len, n = sunpack('>I4', bin, n)

	t, n = _binary_to_array(len, bin, n)

	return tuple(t), n
end,
-- nil
[106] = function(bin, n)
	return nil, n
end,
-- string
[107] = function(bin, n)
	return sunpack('>i2c0', bin, n)
end,
-- list
[108] = function(bin, n)
	local l
	local len

	len, n = sunpack('>I4', bin, n)

	l, n = _binary_to_array(len, bin, n)

	return list(l), n
end,
}

module(...)

-- export
_M.atom = atom
_M.is_atom = is_atom
_M.tuple = tuple
_M.is_tuple = is_tuple
_M.list = list
_M.is_list = is_list
_M.etype = etype

--
-- Erlang functions
--

function now(time)
	local t1, t2 = modf(time or gettime())
	return tuple( floor(t1 / 1000000), floor(t1 % 1000000), floor(t2 * 1000000) )
end

function now_to_time(now)
	local mega, sec, micro = now[1], now[2], now[3]
	return (mega * 1000000) + sec + (micro / 1000000)
end

function term_to_binary(term)
	return '\131' .. _term_to_binary(term)
end

function dump_term(term)
	local bin = term_to_binary(term)
	print('<<' .. concat({bin:byte(1,#bin)}, ',') .. '>>')
end

function binary_to_term(bin)
	-- convert table of bytes to string.
	if type(bin) == 'table' then bin = str_char(unpack(bin)) end
	-- validate first byte.
	assert(bin:byte(1) == 131, "invalid Erlang binary.")
	-- decode terms.
	local term, n = _binary_to_term(bin, 2)
	return term, n
end