#define TABLE_SIZE 3

function symbol_value(name);
function print_symbol_table();	// for debug
function symbol_function(name);
function install_subr(name, subr, narg);
function bind_local_symbol(defun_arglist, arglist, narg);
function unbind_local_symbol();

#define MANY            -1      // many arguments
#define UNEVALLED       -2      // don't evaluate the arguments

struct lisp_subr
{
    name;			// function name
    narg;			// MANY or UNEVALLED or number of argument
    func;			// function name
};

struct symbol
{
    name;			// symbol name
    value;			// symbol value
    func;			// Struct: subr, List: expr
};

module symbol
{
    local i;
    global symbol_table;
    global bind_addr_list;

    function search_symbol_entry(name);
    function hash(name);
    function push_new_symbol(name, expr);
    function alloc_symbol(name);
    function alloc_symbol();

    // initialize symbol table
    symbol_table = new[TABLE_SIZE];
    for(i = 0; i < TABLE_SIZE; i++)
	symbol_table[i] = NIL;
    bind_addr_list = NIL;	// Initialize the list of hash address.
				// This is address is used to
				//   unbind the symbol.

    function alloc_symbol()
    {
	local s;

	s = new ::symbol;
	s.name = s.value = s.func = NIL;

	return s;
    }

    function hash(name)
    {
	local addr;
	local i;

	addr = 0;
	for(i = 0; name[i]; i++)
	    addr += name[i];	// Only additional the ascii code for
				// calculation of hash address.

	return abs(addr) % TABLE_SIZE;
    }

    function search_symbol_entry(name)
    {
	local s;

	s = symbol_table[hash(name)];

	while(s != NIL)
	{
	    if(!::strcmp(::car(s).name, name)) // car(s).name == name ?
		return ::car(s);
	    s = ::cdr(s);
	}

	return NIL;
    }

    // binding the new symbol
    function push_new_symbol(name, expr)
    {
	local s;
	local x;
	local addr;

	x = alloc_symbol();
	x.name = ::clone(name);
	x.value = ::clone(expr);
	x.func = NIL;

	addr = hash(name);
	s = symbol_table[addr];
	symbol_table[addr] = ::cons(x, s);

	return x;
    }
}

// for debug
function print_symbol_table()
{
    local i;
    local s;

    for(i = 0; i < TABLE_SIZE; i++)
    {
	write("table[", i, "]:");
	for(s = symbol::symbol_table[i]; s != NIL; s = cdr(s))
	{
	    write(car(s).name, "(");
	    lisp::_write_list1(car(s).value);
	    write(") ");
	}
	writeln();
    }
}

function symbol_value(name)
{
    local s;

    s = symbol::search_symbol_entry(name);

    if(s == NIL || s.value == NIL)
    {
	writeln("Symbol value is void: ", name);
	error_message = True;
	return "nil";
    }

    return s.value;
}

function setq_symbol_value(name, expr)
{
    local s;

    s = symbol::search_symbol_entry(name);

    if(s == NIL)
	symbol::push_new_symbol(name, expr);
    else
	car(s).value = expr;

    return expr;
}

function symbol_function(name)
{
    local s;

    if(typeof(name) != QH_String)
	return NIL;

    s = symbol::search_symbol_entry(name);

    if(s == NIL || s.func == NIL)
	return NIL;

    return s.func;
}

function install_subr(name, subr, narg)
{
    local s;

    s = symbol::search_symbol_entry(name);

    if(s != NULL && s.func != NIL)
	writeln("Warning: Redefined SUBR: `%s'\n", name);

    if(s == NULL)
	s = symbol::push_new_symbol(name, NIL);

    s.func = new lisp_subr;
    s.func.name = s.name;
    s.func.narg = narg;
    s.func.func = subr;
}

function install_new_function(name, body)
{
    local s;

    s = symbol::search_symbol_entry(name);

    if(s == NULL)
	s = symbol::push_new_symbol(name, NIL);

    s.func = clone(body);
}

// If defun_arglist is (x y z), Then x, y, and z is pushd to symbol table.
// And add the list of address to bind_addr_list.
// For example:
// bind_addr_list := ((hash(x) hash(y) hash(z)) ... )
// This address list is used when it's symbol removed from the symbol table.
// See also unbind_local_symbol().
function bind_local_symbol(defun_arglist, arglist, narg)
{
    local addr;
    local i;
    local addr_list = NIL;

    for(i = 0; i < narg; i++)
    {
	addr = symbol::hash(car(defun_arglist));
	addr_list = cons(addr, addr_list);
	symbol::push_new_symbol(car(defun_arglist), arglist[i]);
	defun_arglist = cdr(defun_arglist);
    }

    symbol::bind_addr_list = cons(addr_list, symbol::bind_addr_list);
}

// unbind_local_symbol() removes the binded local symbol.
// car(bind_addr_list) is address list of binded symbol.
// We can unbind the symbol to remove a first element in the symbol table.
function unbind_local_symbol()
{
    local addr_list;
    local addr;

    addr_list = car(symbol::bind_addr_list);
    symbol::bind_addr_list = cdr(symbol::bind_addr_list);

    while(typeof(addr_list) == QH_List)
    {
	addr = car(addr_list);
	symbol::symbol_table[addr] = cdr(symbol::symbol_table[addr]);
	addr_list = cdr(addr_list);
    }
}