/* Lisp/Scheme reader.  This is -*- C++ -*-.
   Copyright (C) 1992 Per Bothner.

This file is part of Q.

Q is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

Q is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU CC; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

#include <strstream.h>
#include "symbol.h"
#include "gfunc.h"
#include "genmap.h"
#include "genfiles.h"
#include "gassign.h"
#include "tempbuf.h"
#include "exceptions.h"
#include "expression.h"
#include "gfiles.h"
#include <ctype.h>
#include <string.h>
#include <stdlib.h>
#include "builtin-syms.h"
#include "reader.h"
//#include "gvars.h"
//#include "parsefile.h"
//#include "Qcompile.h"
//#include "prop-list.h"
//#include "lispread.h"

// Imports (incomplete)

// LispEval(FORM) evaluates FORM, and returns its value.
extern Root* LispEval(Root* form);

// ---

static char LispDotDummy[1];
#define NO_VALUES NULL

static Root *DoReadLParen(InStream*, char);
static Root *DoReadQuote(InStream* stream, char);
static Root *DoReadString(InStream* stream, char);
static Root *DoReadSemiColon(InStream* stream, char);
static Root * DoReadDispatching(InStream* stream, char init);
static const Root * CheckActualNumber(char *string, int base);

int LispReadBase = 10;
char LispReadTableCase = 'U'; // One of 'U' 'D' 'P' 'I'
extern ReadDispatchingFunction DefaultLispDispatchEntries[256];

int CheckPotentialNumber(char *string, int base)
{
    char ch;
    int len = strlen(string);
    int prev_letter = 0, cur_letter;
    int seen_digit = 0;
    int seen_dot = 0;
    if (len <= 0) return 0;
    if ((string[0] < '0' || string[0] > '9')
	&& string[0] != '+' && string[0] != '-'
	&& string[0] != '.' && string[0] != '^' && string[0] != '_')
	return 0;
    if (string[len-1] == '+' || string[len-1] == '-') return 0;
    for (int i = 0; i < len; i++) {
	prev_letter = cur_letter;
	ch = string[i];
	cur_letter = 0;
	if (ch >= '0' && ch <= '9') seen_digit = 2;
	else if (ch == '.') seen_dot = 1;
	else if (ch == '+' || ch == '-' || ch == '/' || ch == '_' || ch == '^')
	    continue;
	else if (ch >= 'a' && ch <= 'z') {
	    if (ch - 'a' + 10 < LispReadBase) {
		if (!seen_digit) seen_digit = 1;
		continue;
	    }
	    if (prev_letter) return 0;
	    cur_letter = 1;
	}
	else if (ch >= 'A' && ch <= 'Z') {
	    if (ch - 'A' + 10 < LispReadBase) {
		if (!seen_digit) seen_digit = 1;
		continue;
	    }
	    if (prev_letter) return 0;
	    cur_letter = 1;
	}
	else
	    return 0;
    }
    if (seen_digit - seen_dot == 0) return 0;
    return 1;
}

// ----- Readtables -----

ReadEntry R_MEscape = { ReadMEscape};
LReadEntry R_LParen( ReadTMacro, DoReadLParen);
static LReadEntry R_SemiColon(ReadTMacro, DoReadSemiColon);
LReadEntry R_Quote(ReadTMacro, DoReadQuote);
LReadEntry R_String(ReadTMacro, DoReadString);
ReadEntry Bad_TMacro = {ReadTMacro};
LReadEntry R_Dispatch(ReadNMacro, DoReadDispatching);

ReadEntry* (DefaultLispReadEntries[256]) = {
  Rep8(&R_Illegal),
  &R_Word,&R_HSpace, &R_VSpace,&R_VSpace,&R_VSpace,&R_VSpace, Rep2(&R_Illegal),
  Rep8(&R_Illegal),
  Rep8(&R_Illegal),
  &R_HSpace,&R_Word, &R_String,&R_Dispatch, &R_Word,&R_Word, &R_Word,&R_Quote,
  &R_LParen,&Bad_TMacro, &R_Word,&R_Word, &Bad_TMacro,&R_Word, &R_Word,&R_Word,
  Rep8(&R_Digit),
  Rep2(&R_Digit), &R_Word, &R_SemiColon, Rep4(&R_Word),
  &R_Word, &R_Letter, Rep2(&R_Letter), Rep4(&R_Letter),
  Rep8(&R_Letter),
  Rep8(&R_Letter),
  &R_Letter,&R_Letter, &R_Letter, &R_Word, &R_SEscape,&R_Word, &R_Word,&R_Word,
  &Bad_TMacro, &R_Letter, Rep2(&R_Letter), Rep4(&R_Letter),
  Rep8(&R_Letter),
  Rep8(&R_Letter),
  &R_Letter,&R_Letter, &R_Letter, &R_Word, &R_MEscape,&R_Word, &R_Word,&R_Word,

  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
  Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal), Rep8(&R_Illegal),
};

class ReadTable {
    ReadEntry** table;
    ReadDispatchingFunction* dispatcher; // Handles # forms
  public:
    ReadTable(ReadEntry **tab, ReadDispatchingFunction*disp)
	{ table = tab; dispatcher = disp; }
    ReadEntry * entry(unsigned char ch) { return table[ch]; }
    ReadEntry * entry(char ch) { return table[(unsigned char)ch]; }
    ReadDispatchingFunction dispatch(unsigned char c) {return dispatcher[c];}
    ReadDispatchingFunction dispatch(char c)
	{return dispatcher[(unsigned char)c];}
};


ReadTable DefaultLispReadTable(DefaultLispReadEntries,
			       DefaultLispDispatchEntries);

ReadTable * CurrentReadTable = &DefaultLispReadTable;

char ConvertSymbolChar(char x)
{
    if (LispReadTableCase == 'P') ; // preserse
    else if (LispReadTableCase != 'D' && islower(x))
	x = toupper(x);
    else if (LispReadTableCase != 'U' && isupper(x))
	x = tolower(x);
    return x;
}

Root* LispRead(InStream * stream, int options)
{
    TempBuf buffer;
    char * package_marker, *symbol_part;
    Package *package;
    int x, buf_size;
    ReadEntry *entry;
    int potential_number = 1;
    if (options & LispReadForceSymbol)
	goto step5;
    // Labels follow "Common Lisp: The Language. 2nd. edition", p 511-515.
  step1:
    x = stream->get();
    if (x == EOF)
	return EOF_mark;
    entry = CurrentReadTable->entry(x);
    switch (entry->code) {
      step2:
      case ReadIllegal:
      default: // ERROR!
	fprintf(stderr, "Illegal character \\%03o in input.\n", x);
	return NULL;
      case ReadHSpace: case ReadVSpace: /*step3:*/
	goto step1;
      case ReadTMacro: case ReadNMacro: /*step4:*/
	if (((LReadEntry*)entry)->func == NULL) {
	    fprintf(stderr,
		    "Unimplemented macro character \\%03o in input.\n", x);
	    return NULL;
	}
	else {
	    Root *value = (*((LReadEntry*)entry)->func)(stream, x);
	    if (value != NO_VALUES) return value;
	}
	goto step1;
      step5:
      case ReadSEscape:
	x = stream->get();
	if (x == EOF) goto bad_eof;
	potential_number = 0;
	buffer.put(x);
	goto step8;
      case ReadMEscape: /*step6:*/
	goto step9;
      case ReadDigit: case ReadLetter: case ReadWord:
	goto step7;
    }
  step7: // Insert a replacable character
    x = ConvertSymbolChar(x);
    buffer.put(x);
    goto step8;
  step8:
    x = stream->get();
    if (x == EOF) goto bad_eof;
    entry = CurrentReadTable->entry(x);
    switch (entry->code) {
      case ReadDigit: case ReadLetter: case ReadWord:
      case ReadNMacro:
	goto step7;
      case ReadSEscape:
	goto step5;
      case ReadMEscape:
	goto step9;
      case ReadTMacro:
	stream->putback(x);
	goto step10;
      case ReadIllegal:
      default: // ERROR!
	goto step2;
      case ReadHSpace:
      case ReadVSpace:
	if (options & LispReadPreservingWhitespace) stream->putback(x);
	goto step10;
    }
  step9:
    x = stream->get();
    if (x == EOF) goto bad_eof;
    entry = CurrentReadTable->entry(x);
    switch (entry->code) {
      case ReadSEscape:
	x = stream->get();
	if (x == EOF) goto bad_eof;
	// ... else fall through to ...
      case ReadDigit: case ReadLetter: case ReadWord:
      case ReadNMacro: case ReadTMacro:
      case ReadHSpace: case ReadVSpace:
	potential_number = 0;
	buffer.put(x);
	goto step9;
      case ReadMEscape:
	goto step8;
      case ReadIllegal:
      default: // ERROR!
	goto step2;
    }
  step10:
    buf_size = buffer.size();
    buffer.put(0);
    if (potential_number) {
	if (buf_size == 1 && buffer.string()[0] == '.')
	    if (LispReadDotOk) return (Root*)LispDotDummy;
	    else { // ERROR!
		fprintf(stderr, "Invalid use of '.' token\n");
		return NULL;
	    }
	if (CheckPotentialNumber(buffer.string(), LispReadBase)) {
	    Root *value = (Root*)CheckActualNumber(buffer.string(),
						   LispReadBase);
	    if (value) return value;
	    // ERROR!
	    fprintf(stderr, "[Potential number %s is not an actual number]\n",
		    buffer.string());
	}
    }
    package_marker = strchr(buffer.string(), ':');
    if (package_marker) {
	*package_marker = 0;
	int pack_name_len = package_marker - buffer.string();
	if (pack_name_len == 0)
	    package = &KeywordPackage;
	else
	    package = LookupPackage(buffer.string(), pack_name_len);
	if (package == NULL) {
	    fprintf(stderr, "No such package: %s\n", buffer.string());
	    return NULL;
	}
	pack_name_len++; package_marker++; // Skip ':'
	buf_size -= pack_name_len;
	if (buf_size && *package_marker == ':') {
	    // Internal symbol.
	    buf_size--;
	    symbol_part = package_marker+1;
	    package_marker = 0;
	}
	else
	    symbol_part = package_marker;
	if (buf_size <= 0) {
	    fprintf(stderr, "Empty symbol part following package name.\n");
	    return &NilSymbol;
	}
    }
    else {
	symbol_part = buffer.string();
	package = CurrentPackage;
    }
    if (package_marker && package != &KeywordPackage) {
	// The form "package:name"
	Symbol *sym = package->find_exported(symbol_part, buf_size);
	if (sym == NULL) {
	    fprintf(stderr, "No such external symbol: %s:%s\n",
		    buffer.string(), symbol_part);
	    return &NilSymbol;
	}
	return sym;
    }
    else // The forms "package::name" or ":name" or just plain "name"
	return package->intern(symbol_part, buf_size);
  bad_eof:
    fprintf(stderr, "Illegal end of file after in middle of token\n");
    return &NilSymbol;
}

#define RPAR ')'
static Root *DoReadLParen(InStream* stream, char)
{
    Root *list = &NilSymbol;
    int dot_seen = 0;
    Root **ptr = &list;
    for (;;) {
	int ch = stream->get();
	if (ch == EOF) goto bad_eof;
	if (ch == RPAR) {
	    return list;
        }
	if (ch == ';') {
	    if (DoReadSemiColon(stream, ch) == EOF_mark)
		goto bad_eof;
	    continue;
	}
	enum ReadCode code = DefaultLispReadTable.entry(ch)->code;
	if (code == ReadHSpace || code == ReadVSpace)
	    continue;
	stream->putback(ch);
	Root *element = LispRead(stream, LispReadRecursive|LispReadDotOk);
	if (element == EOF_mark) goto bad_eof;
	if (element == NULL) return NULL;
	if (element == (Root*)LispDotDummy) {
	    if (dot_seen) { // ERROR!
		fprintf(stderr, "One than one '.' in a list\n");
		list = NULL;
	    }
	    dot_seen = 1;
	}
	else if (dot_seen) {
	    if (ptr == NULL) // ERROR!
		fprintf(stderr, "More than one tail after '.' in a list\n");
	    else
		*ptr = element, ptr = NULL;
	}
	else {
	    AList *cons = new AList(element, &NilSymbol);
	    *ptr = cons;
	    ptr = &cons->cdr;
	}
    }
  bad_eof:
    fprintf(stderr, "Illegal end of file in middle of list.\n");
    return NULL;
}

Root *DoReadSemiColon(InStream* stream, char)
{
    for (;;) {
	int ch = stream->get();
	if (ch == EOF) return EOF_mark;
	enum ReadCode code = DefaultLispReadTable.entry(ch)->code;
	if (code == ReadVSpace)
	    return NO_VALUES;
    }
}

static Root *DoReadQuote(InStream* stream, char)
{
    Root *body = LispRead(stream, LispReadRecursive);
    if (body == EOF_mark || body == NO_VALUES) // ERROR!
	return body;
    return new AList(&QUOTE_sym, new AList(body, &NilSymbol));
}

static Root *DoReadString(InStream* stream, char init)
{
    TempBuf buffer;
    for (;;) {
	int ch = stream->get();
	if (ch == EOF) // ERROR!
	    return EOF_mark;
	if (ch == init) {
	    return (Root*)NewString(buffer.size(), buffer.string());
	}
	if (CurrentReadTable->entry(ch)->code == ReadSEscape) {
	    ch = stream->get();
	    if (ch == EOF) // ERROR!
		return EOF_mark;
	}
	buffer.put(ch);
    }
}

static Root * DoReadDispatching(InStream* stream, char init)
{
    int count = -1;
    int ch;
    for (;;) {
	ch = stream->get();
	if (ch == EOF) // ERROR!
	    return EOF_mark;
	ReadDispatchingFunction dispatcher = CurrentReadTable->dispatch(ch);
	if (dispatcher == NULL) {
	    if (ch >= '0' && ch <= '9') {
		if (count == -1) count = ch - '0';
		else count = 10*count + ch - '0';
		continue;
	    }
	    fprintf(stderr, "Unimplemented dispatching '%c%c'\n", init, ch);
	    return NULL; // ERROR!
	}
	return (*dispatcher)(stream, ch, count);
    }
}

static Root * DoDispatchTrue(InStream *stream, char ch, int count)
{
    if (count != -1) { } // ERROR!
    return &TSymbol;
}

static Root * DoDispatchFalse(InStream *stream, char ch, int count)
{
    if (count != -1) { } // ERROR!
    return &NilSymbol;
}

static Root *DoDispatchRadix(InStream *stream, char ch, int count)
{
    if (count < 2 || count > 36) { } // ERROR!
    int saveLispReadBase = LispReadBase;
    LispReadBase = count;
    Root* val = LispRead(stream,
			 LispReadPreservingWhitespace|LispReadRecursive);
    LispReadBase = saveLispReadBase;
    return val;
}

Root* MakeLispComplex(Root* real, Root* imag)
{
    const Real *re = ConvertReal(real);
    const Real *im = ConvertReal(imag);
    if (re == NULL || im == NULL)
	RaiseDomainError(0);
    if (im == Zero)
	return (Root*)re;
    return new ComplexPair(*re, *im);
}

Root * DoDispatchComplex(InStream *stream, char, int count)
{
    int ch = stream->get();
    if (ch == '(') {
	Root *list = DoReadLParen(stream, ch);
	if (list == NULL)
	    return NULL;
	if (list->isA() == AList::desc()) {
	    Root *real_part = ((AList*)list)->car;
	    list = ((AList*)list)->cdr;
	    if (list->isA() == AList::desc()) {
		Root *imag_part = ((AList*)list)->car;
		list = ((AList*)list)->cdr;
		if (list == &NilSymbol)
		    return MakeLispComplex(real_part, imag_part);
	    }
	}
    }
    cerr << "Bad list following #C\n";
    return NULL;
}

static Root * DoDispatchBinary(InStream *stream, char ch, int count)
{
    if (count != -1) { } // ERROR!
    return DoDispatchRadix(stream, ch, 2);
}

static Root * DoDispatchOctal(InStream *stream, char ch, int count)
{
    if (count != -1) { } // ERROR!
    return DoDispatchRadix(stream, ch, 8);
}

static Root * DoDispatchHex(InStream *stream, char ch, int count)
{
    if (count != -1) { } // ERROR!
    return DoDispatchRadix(stream, ch, 16);
}

// Parse #.EXPRESSION

Root* DoReadDispatchEval(InStream *stream, char ch, int count)
{
    Root* form =
	LispRead(stream, LispReadRecursive|LispReadPreservingWhitespace);
    return LispEval(form);
}

const Root * CheckActualNumber(char *string, int base)
{
    int i = 0;
    register char *str = string;
    int neg = 0;
    int seen_dot = 0;
    int alpha_digits = 0;
    int seen_digits = 0;
    if (*str == '+') str++;
    else if (*str == '-') str++, neg = 1;
    char *dig0 = str;
    for (;;) {
	if (*str >= '0' && *str <= '9' && *str-'0' < base)
	    str++, seen_digits++;
	else if (*str >= 'A' && *str <= 'Z' && *str-'A'+10 < base)
	    str++, alpha_digits++;
	else if (*str >= 'a' && *str <= 'z' && *str-'a'+10 < base)
	    str++, alpha_digits++;
	else
	    break;
    }
    if (*str == '/') {
	if (seen_digits + alpha_digits == 0)
	    return NULL;
	seen_digits = 0;
	alpha_digits = 0;
	str++;
	char *den_start = str;
	for (;;) {
	    if (*str >= '0' && *str <= '9' && *str-'0' < base)
		str++, seen_digits++;
	    else if (*str >= 'A' && *str <= 'Z' && *str-'A'+10 < base)
		str++, alpha_digits++;
	    else if (*str >= 'a' && *str <= 'z' && *str-'a'+10 < base)
		str++, alpha_digits++;
	    else
		break;
	}
	if (seen_digits + alpha_digits == 0)
	    return NULL;
	return MakeRational(*StrToInt(string, base, den_start-1-string),
			    *StrToInt(den_start, base));
    }
    if (*str == 0 && (seen_digits+alpha_digits))
	return StrToInt(string, base);
    if (*str == '.') {
	if (alpha_digits)
	    return 0;
	seen_dot++;
	str++;
	if (*str == 0)
	    return StrToInt(string, 10, str-string-1);
	if (dig0 == str && !(*str >= '0' && *str < '9'))
	    return NULL;
	while (*str >= '0' && *str < '9') str++;
    } else if (str == dig0)
	return NULL;
    if (*str == 'e' || *str == 's' || *str == 'f' || *str == 'l'
	|| *str == 'E' || *str == 'S' || *str == 'F' || *str == 'L')
	*str = 'e';
    else if (!seen_dot)
	return NULL;
    return new Double(atof(string));
}

char *(LispCharNames[]) = {
    " SPACE",
    "\nNEWLINE",
    "\fPAGE",
    "\tTAB",
    "\bBACKSPACE",
    "\rRETURN",
    "\177RUBOUT",
    "\000NUL",
    NULL
};

static int FindNamedLispChar(char *name)
{
    int base = 0;
    char **ptr;
  again:
    for (ptr = LispCharNames; *ptr; ptr++) {
	if (strcmp(name, (*ptr)+1) == 0)
	    return base + (*ptr)[0];
    }
    if (strncmp(name, "META-", 5) == 0) {
	base += 128;
	name += 5;
	goto again;
    }
    if (strncmp(name, "CONTROL-", 8) == 0) {
	base -= 64;
	name += 8;
	goto again;
    }
    return -1;
}

static Root * DoDispatchChar(InStream *stream, char ch, int count)
{
    char save_LispReadTableCase = LispReadTableCase;
    LispReadTableCase = 'U';
    Root *name = LispRead(stream,
			  LispReadForceSymbol | LispReadRecursive 
			  | LispReadPreservingWhitespace);
    LispReadTableCase = save_LispReadTableCase;
    Symbol *sym = PTR_CAST(Symbol, name);
    if (sym == NULL)  // ERROR
	return NULL;
    char *cname = sym->string();
    if (sym->length() == 1)
	return CCharToChar(cname[0]);
    char **ptr;
    int c = FindNamedLispChar(cname);
    if (c < 0) // ERROR
	return NULL;
    return CCharToChar(c);
}

Root *DoDispatchFuncQuote(InStream* stream, char, int)
{
    Root *body = LispRead(stream, LispReadRecursive);
    if (body == EOF_mark || body == NO_VALUES) // ERROR!
	return body;
    return new AList(&FUNCTION_sym, new AList(body, &NilSymbol));
}

static Root * DoDispatchVector(InStream *stream, char ch, int count)
{
    Root *list = DoReadLParen(stream, ch);
    if (list == NULL)
	return NULL;
    Root *cur;
    if (count < 0) {
	for (count = 0, cur = list; ; ) {
	    if (cur->isA() != AList::desc())
		break;
	    count++;
	    cur = (AList::castdown(cur))->cdr;
	}
    }
    Vector *vec = NewVector(count);
    Root **ptr = vec->start_addr();
    Root *cur_el = NULL;
    for (cur = list; ; ) {
	if (cur->isA() != AList::desc())
	    break;
	AList *cons = AList::castdown(cur);
	cur_el = cons->car;
	*ptr++ = cur_el;
	count--;
	cur = cons->cdr;
    }
    if (cur != &NullSequence && cur != &NilSymbol) // ERROR!
	return NULL;
    if (count) {
	if (cur_el == NULL) // ERROR!
	    return NULL;
	while (--count >= 0) *ptr++ = cur_el;
    }
    return vec;
}

Root * DoDispatchBitVector(InStream *stream, char ch, int count)
{
    TempBuf buffer;
    for (;;) {
	int x = stream->get();
	if (x != '0' && x != '1') {
	    if (x != EOF) stream->putback(x);
	    break;
	}
	buffer.put(x);
    }
    register int bsize = buffer.size();
    fix_unsigned pad;
    register char *in_ptr = buffer.string();
    if (count == -1)
	count = bsize;
    else if (count < bsize) { //ERROR! Too many bits given
	return NULL;
    }
    if (bsize == count)
	pad = 0;
    else if (bsize == 0) { // ERROR!
	return NULL;
    }
    else
	pad = in_ptr[bsize-1] == '1' ? ~0 : 0;
    BitVector *bv = BitVector::New(count);
    register fix_unsigned *ptr = bv->start_addr();
    register more = bv->nwords();
    while (--more >= 0) *ptr++ = pad;
    register fix_unsigned mask = 1;
    ptr = bv->start_addr();
    more = bsize;
    if (pad) // All bits are initially ones
	while (--more >= 0) {
	    if (*in_ptr++ == '0')
		*ptr &= ~mask;
	    mask <<= 1;
	    if (mask == 0) { mask = 1; ptr++; }
	}
    else // All bits are initially zeros
	while (--more >= 0) {
	    if (*in_ptr++ == '1')
		*ptr |= mask;
	    mask <<= 1;
	    if (mask == 0) { mask = 1; ptr++; }
	}
    return bv;
}

// Parse #:NAME

Root * DoDispatchUnintern(InStream *stream, char ch, int count)
{
    TempBuf buffer;
    Symbol *sym;
    ReadEntry *entry;
  next:
    int x = stream->get();
    if (x == EOF)
	goto done;
    entry = CurrentReadTable->entry(x);
    switch (entry->code) {
      case ReadDigit: case ReadLetter: case ReadWord: case ReadNMacro:
	x = ConvertSymbolChar(x);
	/* .. fall through to .. */
      case ReadSEscape:
	buffer.put(x);
	goto next;
      case ReadHSpace: case ReadVSpace: case ReadTMacro:
	stream->putback(x);
	goto done;
      case ReadMEscape:
	for (;;) {
	    x = stream->get();
	    if (x == EOF) goto error;
	    entry = CurrentReadTable->entry(x);
	    if (entry->code == ReadMEscape) goto next;
	    buffer.put(x);
	}
      default:
	goto error;
    }
  error:
    fprintf(stderr, "Bad syntax after #:\n"); // ERROR!
    return NULL;
  done:
    if (buffer.size() == 0)
	goto error;
    sym = new Symbol(NewString(buffer.size(), buffer.string()));
    sym->_package = 0;
    return sym;
}

ReadDispatchingFunction DefaultLispDispatchEntries[256] = {
    Rep8(0), Rep8(0), Rep8(0), Rep8(0),
    Rep4(0), Rep2(0), 0, &DoDispatchFuncQuote, // SP .. squote
    &DoDispatchVector, 0, DoDispatchBitVector, 0, 0,0, DoReadDispatchEval,0,
    Rep8(0), // 0 .. 7
    Rep2(0), &DoDispatchUnintern, 0, Rep4(0), // 9 .. ?
    0, 0, &DoDispatchBinary, &DoDispatchComplex, 0, 0, &DoDispatchFalse, 0,
    Rep4(0), 0, 0, 0, DoDispatchOctal, // H .. O
    0, DoDispatchRadix, 0, 0, &DoDispatchTrue, 0, 0, 0, // P .. W
    DoDispatchHex, 0, 0, 0, DoDispatchChar, 0, 0, 0, // X .. _
    0, 0, &DoDispatchBinary, &DoDispatchComplex, 0, 0, &DoDispatchFalse, 0,
    Rep4(0), 0, 0, 0, DoDispatchOctal, // h .. o
    0, DoDispatchRadix, 0, 0, &DoDispatchTrue, 0, 0, 0, // p .. w
    DoDispatchHex, 0, 0, 0, Rep4(0), // x .. DEL
    Rep8(0), Rep8(0), Rep8(0), Rep8(0),
    Rep8(0), Rep8(0), Rep8(0), Rep8(0),
    Rep8(0), Rep8(0), Rep8(0), Rep8(0),
    Rep8(0), Rep8(0), Rep8(0), Rep8(0),
};
