#include "lisp.qhl"
function load_file(filename);

#define MAXLOAD 16

module lisp_read
{
    local LISP_FILE;
    local FHD;
    local file_index = 0;
    local token_buff = new string;
    local token_type;
    local char_type = new int[128];
    local i;
    local c = 0;
    local backup_char;
    local parse_nest_level;
    local temp_string;	// for debug

    // token_type:
    //
    // ' ' white-space
    // '(' start of list
    // ')' end of list
    // '\'' quote
    // 'n' number
    // 's' symbol
    // EOF end of file

    for(i = 0; i <= ' '; i++)
	char_type[i] = ' ';
    for(i = ' ' + 1; i < 127; i++)
	char_type[i] = 's';
    for(i = '0'; i <= '9'; i++)
	char_type[i] = 'n';
    char_type['('] = '(';
    char_type[')'] = ')';
    char_type['\''] = '\'';

    LISP_FILE = new int[MAXLOAD];
    backup_char = new int[MAXLOAD];

    FHD = LISP_FILE[0] = STDIN;
    file_index = 1;
    temp_string = new string;

    // for debug
    function outchar(c)
    {
	temp_string[0] = c;
	write(temp_string);
    }

    function readchar()
    {
	c = ::fgetc(FHD);

// for debug  
//	write("##(");outchar(c);writeln(")");

	return c;
    }

    function open(s)
    {
	if(file_index == MAXLOAD)
	{
	    writeln("Too many files opened.");
	    ::exit(1);
	}

	FHD = LISP_FILE[file_index] = ::fopen(s, "r");
	backup_char[file_index] = c;
	readchar();
	file_index++;
    }

    function close()
    {
	file_index--;
	::fclose(LISP_FILE[file_index]);
	c = backup_char[file_index];
	FHD = LISP_FILE[file_index - 1];
    }

    function gettoken()
    {
	local i;

	if(c == 0)
	    readchar();

      next_char:

	if(c == EOF)
	{
	    token_type = EOF;
	    token_buff[0] = '\0';
	    return;
	}

	if(c <= ' ' ||
	   c >= 127)
	{
	    readchar();
	    goto next_char;	// read more
	}

	token_buff[0] = c;
	token_buff[1] = '\0';

	if(c == '(')		// beginning of list
	{
	    parse_nest_level++;
	    token_type = c;
	    readchar();
	    return;
	}

	if(c == ')')		// end of list
	{
	    parse_nest_level--;
	    token_type = c;
	    readchar();
	    return;
	}

	if(c == '\'')		// quote
	{
	    token_type = c;
	    readchar();
	    return;
	}

	i = 1;
	do			// atom
	{
	    readchar();
	    if(c <= ' ' || c >= 127)
		break;
	    if(char_type[c] != 'n' &&
	       char_type[c] != 's')
		break;
	    token_buff[i] = c;
	    i++;
	} while(1);

	token_buff[i] = '\0';

	local j;
	token_type = 'n';

	for(j = 0; j < i; j++)
	    if(char_type[token_buff[j]] != 'n')
	    {
		token_type = 's';
		break;
	    }
    }

    function parse_read_lisp()
    {
	local x;

	if(::error_message)
	{
	    return "nil";
	}

	if(token_type == 's')	// symbol
	{
	    x = ::strdup(token_buff);
	    if(parse_nest_level > 0)
		gettoken();
	    return x;
	}

	if(token_type == 'n')	// number
	{
	    x = ::atoi(token_buff);
	    if(parse_nest_level > 0)
		gettoken();
	    return x;
	}

	if(token_type == '\'')	// quote
	{
	    gettoken();
	    x = list(parse_read_lisp(), "quote");

	    return x;
	}

	if(token_type == '(')
	{
	    local x = NIL;

	    gettoken();
	    while(token_type != ')')
	    {
		if(token_type == EOF)
		{
		    ::error_message = "Parse error.";
		    return "nil";
		}

		x = ::cons(parse_read_lisp(), x);
		if(::error_message)
		{
		    return "nil";
		}

	    };

	    if(parse_nest_level > 0)
		gettoken();

	    if(x == NIL)
		return "nil";

	    return x;
	}

	::error_message = "Syntax error.";
	return "nil";
    }

    function reverse_all(x)
    {
	if(::typeof(x) != ::QH_List)
	    return x;

	return lisp::mapcar("lisp_read::reverse_all", lisp::reverse(x));
    }

    function read_from_file()
    {
	local expr;

	gettoken();

	if(c == EOF)
	{
	    return NIL;
	}

	// parse_read_lisp() makes the reversed list from input
	// Example:
	// input: (a b (c d) e)
	// <= (e (c d) b a)
	expr = parse_read_lisp();

	// reverse the list including nested list
	return reverse_all(expr);
    }
}

function eval_file(s)
{
    lisp_read::open(s);
    local expr;

    while(1)
    {
	expr = lisp_read::read_from_file();

	if(expr == NIL)
	{
	    lisp_read::close();
	    if(error_message)
	    {
		if(typeof(error_message) == QH_String)
		    writeln(error_message);
		return "nil";
	    }
	    return "t";
	}
	eval(expr);
	if(error_message)
	{
	    if(typeof(error_message) == QH_Sring)
		writeln(error_message);

	    lisp_read::close();
	    return "nil";
	}
    }
}