/* Symbol and related classes.  This is -*- C++ -*- code.
   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.  */

#ifdef __GNUG__
#pragma implementation
#endif
#include <iostream.h>
#include <symbol.h>
#include "gvars.h"
#include "genmap.h"
#include "gkinds.h"
#include "exceptions.h"
#include <Qcompile.h>
#include <parsefile.h>
#include <aux_format.h>
#include <stdlib.h>
#include <string.h>
#include "gfiles.h"
#include "gassign.h"
#include "reader.h"
#include "modules.h"
#include "builtin-syms.h"
/*#include "listprocs.h"*/
//Character CharTable[256];
extern struct Type Atom;
static SymbolsEntered = 0;
static void EnterSymbols();

#undef CompileToC
#define CompileToC(cf) (!EvalCompile(cf))

Symbol::Symbol(const String *str)
{
    init(str->chars(), str->leng(), CurrentPackage);
}

Symbol::Symbol(const StringC *str)
#ifndef C_SYM
 : _pname(str)
#endif
{
    _property_list = &NilSymbol;
    _package = CurrentPackage; // &KeywordPackage;
    _value = NULL;
    _flags = 0;
#ifdef C_SYM
    _pchars = str->chars();
    _plength = str->leng();
#endif
}

Symbol::Symbol(const StringC *str, Package *pack)
#ifndef C_SYM
 : _pname(str)
#endif
{
    _property_list = &NilSymbol;
    _package = pack;
    _value = NULL;
    _flags = 0;
#ifdef C_SYM
    _pchars = str->chars();
    _plength = str->leng();
#endif
}

#if 0
Symbol* AllocSymbol(register char *s, register length)
    /* s - input string */
    /* l - length in bytes - if <0, strlen is used */
{
    if (length < 0) length = strlen(s);
    return new Symbol(NewString(length, s));
}
#endif

Symbol _EOFmark(NewString(8, "EOF_mark"));
Symbol* EOFmark = &_EOFmark;
Symbol _True(NewString(4, "True"));
Symbol* True = &_True;

#if 0
FreeSymbol(char *s)
  { CheckRelease(s)
      { PrimitiveFree(s); }
  }

_Symbol_dump(register SymbolHdr *s, CFile *cf, struct Label *label)
  { char buf[40];
    CompBlockPrefix(cf, &Symbol);
    sprintf(buf, ".word\t%d,%d", s[-1].length, s[-1].hash);
    CompWW(cf, s[-1].length, s[-1].hash, buf);
    CompPtr(cf, "Symbol", 0, 0);
    if (label)
      {
	CompLab(cf, label);
      }
    return CompileName(cf, s, s[-1].length + 1);
  }
#endif

#if 0
Atom_dump(s, cf, name)
    register SymbolHdr *s; CFile *cf;
  { char buf[40];
    sprintf(buf, ".word\t%d,%d", s[-1].length, s[-1].hash);
    CompWW(cf, s[-1].length, s[-1].hash, buf);
    CompileStdPrefix(cf, name, "Atom");
    return CompileName(cf, s, s[-1].length + 1);
  }
#endif

Package *PackageList = NULL;
/*#define CONSTRUCT_INIT*/
#ifdef CONSTRUCT_INIT
HashTable PackageTable(32, 0);
Package KeywordPackage(&KEYWORD_str, 100);
Package BuiltinPackage(&BUILTIN_str, 100);
Package CLispPackage(&COMMON_LISP_str, 100);
Package SchemePackage(&SCHEME_str, 100);
Package UserPackage(&USER_str, 100);
Package AlphabetPackage(&alphabet_str, 100);
#else
// These are initialized by SymbolTabInit().
HashTable PackageTable;
Package KeywordPackage;
Package BuiltinPackage;
Package CLispPackage;
Package SchemePackage;
Package UserPackage;
Package AlphabetPackage;
#endif
Package *CurrentPackage = &UserPackage;

#define SymbolTab (&KeywordPackage.ext_hash)

static int SymbolTabInited = 0;
#if 0
static AList LispNicknames1(&LISP_str, &NilSymbol);
static AList LispNicknames(&CL_str, &LispNicknames1);
#endif
extern "C" void SymbolTabInit()
{
    if (SymbolTabInited) return;
    SymbolTabInited = 1;
#ifndef CONSTRUCT_INIT
    PackageTable.initialize(32, 8);
    KeywordPackage.initialize(&KEYWORD_str, 100);
    BuiltinPackage.initialize(&BUILTIN_str, 100);
    CLispPackage.initialize(&COMMON_LISP_str, 100);
    SchemePackage.initialize(&SCHEME_str, 100);
    UserPackage.initialize(&USER_str, 100);
    AlphabetPackage.initialize(&alphabet_str, 100);
#endif
    EnterSymbols();
    UserPackage.use(&SchemePackage);
    UserPackage.use(&CLispPackage);
    UserPackage.use(&BuiltinPackage);
#if 1
    CLispPackage.set_nicknames(new AList(&CL_str,
					 new AList(&LISP_str, &NilSymbol)));
#else
    // FIXME:  Doesn't work, sinc LispNicknames might not be initialized yet.
    CLispPackage.set_nicknames(&LispNicknames);
#endif
//    UserPackage.use(&KeywordPackage);
}

#define EQwith(el) ((el)->length() == len && memcmp((el)->string(), s, len) == 0)

/* patterned after SymbolLookup */
Symbol** FindSymbol(SymbolTable *tab, const char *s, int len, unsigned short hash)
{
#define HASH_ELEMENT_TYPE Symbol*
#define HASH_LENGTH_LOG tab->tab_len_log
#define HASH_ELEMENT_LOG tab->element_len_log
#define HASH_EQUAL(element,arg) EQwith(*element)
#define HASH_DATA tab->data
#define HASH_DELETED(element)  (*element == HashDeleted)
#include "hashfunc.h"
#undef HASH_ELEMENT_TYPE
#undef HASH_LENGTH_LOG
#undef HASH_ELEMENT_LOG
#undef HASH_EQUAL
#undef HASH_DELETED
}

StringC **
StringLookup(HashTable *tab, char *s, int len) /* Variant for SymbolLookup */
{
    unsigned short hash = hash_string(s, len);
#define HASH_ELEMENT_TYPE const StringC *
#define HASH_LENGTH_LOG tab->tab_len_log
#define HASH_ELEMENT_LOG 3 /* log2(2*sizeof(void*)) */
#define HASH_EQUAL(element,arg) \
  (element->leng()==len && memcmp((element)->chars(), s, len)==0)
#undef HASH_NULL
#define HASH_NULL(element) (*element==HashNull)
#define HASH_DATA tab->data
#define HASH_DELETED(element)  (*element == HashDeleted)
/* the mask is redundant if masking is done before indexing */
#include "hashfunc.h"
}


void StringInsert(HashTable *tab, const StringC* str, void *value)
{
    const StringC **ptr = StringLookup(tab, str->chars(), str->leng());
    if (HashNone(*ptr)) {
	*ptr = str;
	ptr[1] = (const StringC*)value;
	tab->rehash_if_needed();
    } else {
	ptr[1] = (const StringC*)value;
    }
}

Package *LookupPackage (char *str, int len)
{
    const StringC **ptr =
	StringLookup(&PackageTable, str, len);
    if (HashNone(*ptr))
	return NULL;
    
    return (Package*)ptr[1];    
}

void Package::initialize_only(const StringC *pname)
{ // Only initialize Package fields, not int_hash and ext_hash.
    _pname = pname;
    nick_names = &NilSymbol;
    if (_pname)
	StringInsert(&PackageTable, _pname, this);
    use_list = &NilSymbol;
    used_by_list = &NilSymbol;
    next = PackageList; PackageList = this;
}
void Package::initialize(const StringC *pname, int size)
{
     initialize_only(pname);
     ext_hash.initialize(size);
     int_hash.initialize(32);
}
Package::Package(const StringC *pname, int size)
: ext_hash(size), int_hash(32) { initialize_only(pname); }
Package::Package(const String *pname, int size)
: ext_hash(size), int_hash(32)
{
    initialize_only(NewString(pname->leng(), pname->chars()));
}

#if 0
Package::Package(char *pname, int size)
: ext_hash(size), int_hash(32)
{
    _pname = NewString(strlen(pname));
    strcpy(_pname->chars(), pname);
    nick_names = &NilSymbol;
    if (_pname)
	StringInsert(&PackageTable, _pname, this);
    use_list = &NilSymbol;
    used_by_list = &NilSymbol;
    next = PackageList; PackageList = this;
}
#endif

void Package::printon(ostream& outs) const
{
    if (is_deleted())
	outs.form("<deleted package 0x%x>", this);
    else
	outs << "package \"" << _pname->chars() << "\"";
}

// Get Symbol with print-name (str,len) in this Package.
// Set 'code' to a number indicating where the symbol was found (see reader.h).
// If str==(-1), don't allocate a Symbol; return NULL if not found.
// Otherwise, if str is non-NULL, it must be equal to StringC(len,chars).

Symbol* Package::prim_intern(const char*chars, int len, const StringC *str, int *code)
{ 
    int h;
    register Symbol **p_ext, **p_int;
    if (!SymbolTabInited) SymbolTabInit();
    if (len < 0) len = strlen(chars);
    h = hash_string(chars, len);
    p_ext = FindSymbol(&ext_hash, chars, len, h);
    if (*p_ext != NULL) {
	if (code) *code = InternExternal;
	return *p_ext;
    }
    p_int = FindSymbol(&int_hash, chars, len, h);
    if (*p_int != NULL) {
	if (code) *code = InternInternal;
	return *p_int;
    }

    // Check if there is an inherited symbol.
    Root *list = use_list;
    for (;;) {
	if (list == &NilSymbol)
	    break;
	AList *pair = (AList*)list;
	Package *used_pack = (Package*)pair->car;
	Symbol **p_used = FindSymbol(&used_pack->ext_hash, chars, len, h);
	if (*p_used != NULL) {
	    if (code) *code = InternInherited;
	    return *p_used;
	}
	list = pair->cdr;
    }

    if (code) *code = InternNew;
    if (str == (StringC*)(-1))
	return NULL;
    if (!str)
	str = NewString(len, chars);

    SymbolTable *tab;
    if (this == &KeywordPackage) {
	tab = &ext_hash;
	p_int = p_ext;
    }
    else
	tab = &int_hash;
    Symbol *sym = GC_NEW Symbol(str, this);
    *p_int = sym;
    tab->rehash_if_needed();
    if (this == &KeywordPackage) {
	sym->sym_value(sym);
	sym->_flags |= Symbol::is_constant|Symbol::fixed_binding;
    }
    return sym;
}

Symbol* Package::find_exported(const char*chars, int len)
{ 
    int h;
    if (!SymbolTabInited) SymbolTabInit();
    if (len < 0) len = strlen(chars);
    h = hash_string(chars, len);
    return *FindSymbol(&ext_hash, chars, len, h);
}

#if 0
Symbol* Package::intern(char *str, int len, int *code)
{
    return 
    int _code = 0;
    if (code == NULL) code = &_code;
    Symbol *sym = find_interned(str, len, code);
    if (sym)
	return sym;
    return raw_intern(new Symbol());
}

Symbol* Package::intern(const StringC *str, int *code)
{
    int _code;
    if (code == NULL) code = &_code;
    Symbol *sym = find_interned(str->chars(), str->leng(), code);
    if (sym)
	return sym;
    return raw_intern(new Symbol(str));
}
#endif

int Package::accessible(const Symbol *sym) const
{
    int code = 0;
    if (((Package*)this)->intern(sym->string(), sym->length(), &code) != sym)
	return 0;
    else
	return code;
}

int Package::uses(Package *used_package)
{
    Root *list = use_list;
    for (;;) {
	if (list == &NilSymbol)
	    return 0;
	AList *pair = (AList*)list;
	if (pair->car == used_package)
	    return 1;
	list = pair->cdr;
    }
}

#define FOR_EACH_EXTERNAL(var, package) \
  { register HashTable *__tab__ = &package.ext_hash;		\
    register RootPtr *__element__ = __tab__->data;	\
    register __i__ = 1<<__tab__->tab_len_log;		\
    for (; __i__ > 0; __i__--,				\
       __element__ = (RootPtr*)((char*)__element__+__tab__->element_len))\
        if (HashNone(*__element__)) continue;\
	var = *__element__;
#define END_EACH_EXTERNAL }

int Package::use(Package *used_package)
{
    if (uses(used_package))
	return 1;
    if (used_package == this || used_package == &KeywordPackage) {
	// ERROR!
    }
#if 0
    Symbol *var;
    FOR_EACH_EXTERNAL(var, used_package) {
	Symbol *cur_sym = find_interned(var->string(), var->length(), NULL);
	if (cur_sym != NULL && cur_sym != var && !is_shadowed(cur_sym)) {
	    cerr << "[Shadowing error for symbol " << *cur_sym << "]\n");
	}
    } END_EACH_EXTERNAL
#endif
    use_list = GC_NEW AList(used_package, use_list);
    used_package->used_by_list = GC_NEW AList(this, used_package->used_by_list);
    return 0;
}

int Package::unuse(Package *used_package)
{
    Root **list = &use_list;
    for (;;) {
	if (*list == &NilSymbol)
	    return 0;
	AList *pair = (AList*)*list;
	if (pair->car == used_package) {
	    *list = pair->cdr;
	    // delete pair;
	    break;
	}
	list = &pair->cdr;
    }
    // Now remove from used_package->used_by_list.
    list = &used_package->used_by_list;
    for (;;) {
	if (*list == &NilSymbol)
	    abort();
	AList *pair = (AList*)*list;
	if (pair->car == this) {
	    *list = pair->cdr;
	    // delete pair;
	    return 1;
	}
	list = &pair->cdr;
    }
}

static void DeletePackageName(const StringC *name)
{
    const StringC **hash_ptr =
	StringLookup(&PackageTable, name->chars(), name->leng());
    if (HashNone(*hash_ptr))
	return;
    PackageTable.cur_size--;
    *hash_ptr = (const StringC*)HashDeleted;
}

void Package::set_nicknames(Root *nnames)
     // nnames must be a constant list (AList or nil).
{
    // First delete old nicknames.
    Root *ptr = nick_names;
    for (;;) {
	if (ptr == &NilSymbol)
	    break;
	AList *pair = (AList*)ptr;
	DeletePackageName((const StringC*)pair->car);
	ptr = pair->cdr;
    }
    // Then insert new nicknames.
    nick_names = nnames;
    ptr = nnames;
    for (;;) {
	if (ptr == &NilSymbol)
	    break;
	AList *pair = (AList*)ptr;
	StringInsert(&PackageTable, (StringC*)pair->car, this);
	ptr = pair->cdr;
    }
}

void Package::set_name(const StringC *new_name)
{
    if (_pname)
	DeletePackageName(_pname);
    _pname = new_name;
    if (new_name)
	StringInsert(&PackageTable, new_name, this);
}

void Package::export(Symbol *sym)
{ // Needs work!
    int code;
    Symbol *old_sym = find_interned(sym->string(), sym->length(), &code);
    if (old_sym == sym && code == InternExternal)
	return;
    if (old_sym != sym && old_sym != NULL) {
	// ERROR! (Shadowing)
	return;
    }
#if 0
    for (Root *using = used_by_list; using != &NilSymbol; ) {
	AList *pair = (AList*)using;
	Package *p = (Package*)pair->car;
	Symbol *s = p->find_interned(sym->string(), sym->length(), &code);
	if (s != NULL && s != sym && !p->is_shadowed(s)) {
	    // ERROR! (shadowing)
	}
	using = pair->cdr;
    }
#endif
    int hash = hash_string(sym->string(), sym->length());
    if (old_sym == sym)
	int_hash.remove(sym);
    Symbol **p = FindSymbol(&ext_hash, sym->string(), sym->length(), hash);
    if (*p != NULL) abort(); // Confusion!
    *p = sym;
    ext_hash.rehash_if_needed();
    if (sym->_package == NULL)
	sym->_package = this;
}

void Package::import(Symbol *sym)
{
    int code;
    Symbol *old_sym = find_interned(sym->string(), sym->length(), &code);
    if (old_sym == sym)
	return;
    if (old_sym != NULL) { // ERROR! (Shadowing)
	return;
    }
    int hash = hash_string(sym->string(), sym->length());
    Symbol **p = FindSymbol(&int_hash, sym->string(), sym->length(), hash);
    if (*p != NULL) abort(); // Confusion!
    *p = sym;
    int_hash.rehash_if_needed();
    if (sym->_package == NULL)
	sym->_package = this;
}

Symbol* EnterSymbol(char *str, int len)
{
    return CurrentPackage->intern(str, len);
}

#if 0
/* Symbol2File: Outputs a symbol as a unique legal identifier.
 * We do this by classifying the characters that may appear in a symbol
 * as whether we can output them directly, or as a hex-digit pair.
 */
#define SymHexDelim '.'
#define SymStart "_SYM_"
#define SymEnd "_"
/*I prefer SymStart = "SYM." and SymEnd = "" except for compatilbility*/
#define SymOkChar(ch) (Alphameric(ch)||(ch=='$'))

void Symbol2File(Symbol* sym, register FILE *outFile)
  { register char *sp = SymbolString(sym);
    int hexMode = 0, hexNext;
    register i = SymbolLength(sym);
    fputs(SymStart, outFile);
    for (; --i >= 0;)
      {
	register ch = *sp++;
	hexNext = !SymOkChar(ch);
	if (hexMode != hexNext)
	    putc(SymHexDelim, outFile);
	hexMode = hexNext;
	if (hexMode == 0)
	  {
	    putc(ch, outFile);
	    if (ch == SymHexDelim)
		fputc(SymHexDelim, outFile);
	  }
	else
	    HexPutByte(ch, outFile);
      }
    fputs(SymEnd, outFile);
  }
extern "C" void HexPutByte(int i, register FILE *file)
  { static char HexDigits[16] = "0123456789ABCDEF";
    putc(HexDigits[(i >> 4) & 0xF], file);
    putc(HexDigits[i & 0xF], file);
  }
#endif

int compare(const Symbol& sym1, const Symbol& sym2)
{
    register unsigned char *ptr1, *ptr2;
    register int minLength;
    int len1, len2;
    ptr1 = sym1.ustring();
    ptr2 = sym2.ustring();
    len1 = sym1.length();
    len2 = sym2.length();
    minLength = len1 < len2 ? len1 : len2;
    while ( --minLength >= 0 )
	if (*ptr1++ == *ptr2++) continue;
	else if (ptr1[-1] < ptr2[-1]) return -1;
	else return 1;
    if (len1 == len2) return 0;
    else if (len1 < len2) return -1;
    else return 1;
}

int Symbol::hash() const
{
    return IntToHash(Hash());
}

int Symbol::compare(const Root& other) const
{
    LVariable* lvar = ((Root*)&other)->lvariable();
    const Root* val = lvar ? (const Root*)lvar->value() : &other;
    if (!val) RaiseDomainError(NULL);
    if (!val->isKindOf(*Symbol::desc())) RaiseDomainError(NULL);
    const Symbol* other_sym = (const Symbol*)val;
    if (other_sym->package() != package()) RaiseDomainError(NULL);
    return ::compare(*this, *other_sym);
}

extern "C" int encode_string_to_label(char *str, int length, char *buf);
extern "C" int encode_label_for_symbol_max(const Symbol* sym);
extern "C" void encode_label_for_symbol(const Symbol *sym, char *buf);
void Symbol::dumpPtr(CFile *cf) const
{
    char buf[encode_label_for_symbol_max(this)];
    static int sym_no = 0;
    sym_no++;
#if 1
    char name[12];
    sprintf(name, "__sym%d", sym_no);
    int name_length = strlen(name);
    PrevDumped *dump = (PrevDumped*)
	malloc(PrevDumpedLabelOffset + name_length + 1);
    strcpy((char*)dump + PrevDumpedLabelOffset, name);
    dump->next = cf->pendingSymbols;
    cf->pendingSymbols = dump;
    dump->addr() = (void*)this;
    InsertAlreadyDumped(&dump->lab);
    dump->dumpProc = 0;
    if (_package == NULL)
	abort();
    else {
	encode_label_for_symbol(this, buf);
	cf->aux_stream() << "extern Symbol " << name
	    << " asm(\"" << buf << "\");\n";
	// Thi second definition is to force a "common" definition.
	cf->aux_stream() << "char __" << name << "[" << sizeof(Symbol)
	    << "] asm(\"" << buf << "\");\n";
    }
    cf->asm_stream() << "&" << dump->name();
#else
    if (_package == NULL) {
	encode_string_to_label(string(), length(), buf);
	cf->aux_stream() << "extern StringC __str" << sym_no
	    << " asm(\"_$ST" << buf << "\");\n";
	cf->asm_stream() << "new Symbol(&__str" << sym_no << ", NULL)";
	return;
	
    }
    else {
	encode_label_for_symbol(this, buf);
	cf->aux_stream() << "extern Symbol __sym" << sym_no
	    << " asm(\"" << buf << "\");\n";
	cf->asm_stream() << "&__sym" << sym_no;
    }
#endif
}

void EnterSymbolRange(Symbol* sym_0, Symbol* sym_n)
{
  register Symbol **p, *cur_sym = sym_0;
  if (cur_sym != sym_n)
    {
      for (;;)
	{
	  int align = sizeof(int);
	  int len = cur_sym->length();
	  p = FindSymbol(&cur_sym->_package->ext_hash,
			 cur_sym->string(), len, cur_sym->Hash());
	  if (p == NULL || *p != NULL)
	    fprintf(stderr, "EnterSymbolRange failed for %s\n",
		    SymbolString(cur_sym));
	  else
	    *p = cur_sym;
	  cur_sym->_package->ext_hash.rehash_if_needed();
	  if (cur_sym >= sym_n)
	    {
	      if (cur_sym != sym_n)
		abort();
	      break;
	    }
	  cur_sym++;
	}
    }
}

static void EnterSymbols()
{
//  static int SymbolsEntered = 0;
    extern struct Symbol *__START_SYM;
    extern struct Symbol *__END_SYM;
    if (SymbolsEntered) return;
    EnterSymbolRange(__START_SYM, __END_SYM);
    SymbolsEntered = 1;
}

#if 0
long GenSymCounter = 1;

Symbol * GenSym(Root *prefix)// CLtL:2. p. 245
{
    StringC *name;
    if (prefix == NULL) {
	char buf[20];
	sprintf(buf, "G%d", GenSymCounter++);
	name = NewString(strlen(buf), buf);
    }
    else if (prefix is an integer) {
    }
    return MakeSymbol(name);
}
#endif

long Symbol::magic() const { return SymbolKind; }
Root * Symbol::package() const { return _package ? _package : &NilSymbol; };

int Symbol::is_external(Package*pack /*=NULL*/) const
{
    if (pack == NULL) {
	pack = _package;
	if (pack == NULL) return 0;
    }
    int hash = hash_string(string(), length());
    return *FindSymbol(&pack->ext_hash, string(), length(), hash) == this;
}

extern void LispPrintSymbol(register char *str, int len, ostream& outs);
void Symbol::printon(ostream& outs) const
{
    if (print_lisp) {
	if (!_package) outs << "#:";
	else if (_package == &KeywordPackage) outs << ':';
	else if (!CurrentPackage->accessible(this)) {
	    if (_package->is_deleted()) {
		// ERROR!
	    }
	    outs.form("%s:", _package->_pname->chars()); // Case???
	    int code = 0;
	    if (!is_external(_package))
		outs << ':';
	}
	LispPrintSymbol(string(), length(), outs);
	return;
    }
    if (print_readable)
	outs << '\'';
    register unsigned char *str = ustring();
    
    for (int count = length(); --count >= 0; ) {
	register unsigned char c = *str++;
	if (Alphameric(c) || !print_readable) outs << c;
	else if (c < ' ' || c >= 127) {
	    char buf[8];
	    sprintf(buf, "\\%03o", c);
	    outs << buf;
	}
	else outs << '\\' << c;
    }
}

const StringC * Symbol::asString(int format = 0) const
{
    return Str();
}

void Symbol::coerceTo(Type *cl, void *dest)
{
}

#define svalue_when_both(sym) ((AList*)(sym)->_value)->car
#define fvalue_when_both(sym) ((AList*)(sym)->_value)->cdr

Root * Symbol::sym_value()
{
    if (!(_flags & has_value)) return NULL;
    if (!(_flags & has_both)) return _value;
    return svalue_when_both(this);
}

Root * Symbol::value()
{
    Root *val = sym_value();
    if (val == NULL)
	Signal(new UnboundVariable(this));
    return val;
}

Root * Symbol::sym_function()
{
    if (!(_flags & has_function)) return NULL;
    if (!(_flags & has_both)) return _value;
    return fvalue_when_both(this);
}

void Symbol::assign(Root *new_val) // Set value binding only.
{
    if (_flags & is_constant) {
	Root *old_val = sym_value();
	if (old_val != new_val)
	    SignalBadAssignment(this, new_val);
	return;
    }
    if (new_val == NULL) {
	if (_flags & (has_value+fixed_binding) == (has_value+fixed_binding))
	    SignalBadAssignment(this, new_val);
	if (_flags & has_both)  _value = fvalue_when_both(this);
	_flags &= ~(has_value|has_both);
    }
    else if (!(_flags & has_function)) {
	_value = new_val;
	_flags |= has_value;
    }
    else if (_flags & has_both)
	svalue_when_both(this) = new_val;
    else {
	_value = new ConsPair(new_val, _value);
	_flags |= has_value+has_both;
    }
}

void Symbol::sym_function(Root *new_val) // Set function binding.
{
    if (new_val == NULL) {
	if (_flags & has_both)  _value = svalue_when_both(this);
	_flags &= ~(has_function|has_both);
    }
    else if (!(_flags & has_value)) {
	_value = new_val;
	_flags |= has_function;
    }
    else if (_flags & has_both)
	fvalue_when_both(this) = new_val;
    else {
	_value = new ConsPair(_value, new_val);
	_flags |= has_function+has_both;
    }
}

void Symbol::set_value(Root *new_val)
{
    _value = new_val;
    _flags &= ~(has_both+has_function+has_value);
    if (new_val)
	_flags |= has_function+has_value;
}

void Symbol::xapply(void*dst, Type* dstType, ArgDesc& args)
{
  Root *fun = ((Symbol*)this)->sym_function();
  if (!fun)
    fun = ((Symbol*)this)->sym_value();
  if (fun == NULL || fun == (Root*)this)
    Root::xapply(dst, dstType, args);
  else
    fun->xapply(dst, dstType, args);
}

NilClass::NilClass()
  : Symbol(&NilString)
{
    _property_list = &NilSymbol;
    _flags = is_constant+has_value+fixed_binding; 
    _package = NULL;
    _value = this;
    CLispPackage.export(this);
}

GenSeq *NilClass::sequence() const { return &NullSequence; }

void NilClass::xapply(void* dst, Type* dstType, ArgDesc& args)
{
    return Root::xapply(dst, dstType, args);
}

void NilClass::printon(ostream& outs) const
{
    if (print_lisp)
	Symbol::printon(outs);
    else
	outs << "NIL";
}

NilClass NilSymbol;

Root *DoLookupPackage(Root *arg)
{
    if (arg->isKindOf(*Package::desc()))
	return arg;
    const StringC *str = Coerce2String(arg);
    Package *pack = LookupPackage(str->chars(), str->leng());
    if (pack == NULL) RaiseDomainError(NULL);
    return pack;
}

void Environment::xapply(void* dst, Type* dstType, ArgDesc& args)
{
  int totalCount = args.lCount + args.rCount + args.nCount;
  Root* result;
  if (args.rCount > 0)
    {
      Assignable *sym = binding_at(Coerce2String(args.rArgs[0]));
      if (sym == NULL)
	result = Missing;
      if (totalCount == 1)
	result = sym;
      else
	{
	  ArgDesc xargs(args, 0, 1);
	  sym->xapply(dst, dstType, xargs);
	  return;
	}
    }
  else
    {
      if (totalCount != 0)
	RaiseDomainError(NULL);
      result = this;
    }
  dstType->coerceFromRoot(dst, result);
}

Assignable *Environment::binding_at(const StringC *name)
{
    return new EnvElementLocative(this, name);
}

Root *Package::lookup_at(const char *name, int nlen)
{
    Symbol *sym = find_exported(name, nlen);
    if (sym == NULL)
	return NULL;
    return sym->value();
}

void Environment::set_at(Root *new_val, const char *name, int nlen)
{
    SignalBadAssignment(this, new_val);
}

#define COERCE_FUNCTION DefaultCoerceTo
extern const Class * (RootTypeList[2]);
DEFINE_CLASS(Package,RootTypeList)


SymbolTable::SymbolTable(int init_size)
: HashArray(init_size, sizeof(Symbol*))
{
}

void SymbolTable::initialize(int init_size)
{
    HashArray::initialize(init_size, sizeof(Symbol*));
}

#if C_SYM > 1
int InitSymbols(register SymbolInitElement *sym_info,
		register char *sym_names)
{
    int count = 0;
    SymbolTabInit();
    for (; sym_info->symbol != NULL; sym_info++) {
	Symbol *sym = sym_info->symbol;
	if (sym->_pchars == NULL) { // Not yet initialized.
	    Package *package;
	    switch (sym_info->flags) {
	      case KeywordPackageCode: package = &KeywordPackage; break;
	      case BuiltinPackageCode: package = &BuiltinPackage; break;
	      case CLispPackageCode: package = &CLispPackage; break;
	      case SchemePackageCode: package = &SchemePackage; break;
	      default:
	      case UserPackageCode: package = &UserPackage; break;
	    }
	    sym->Symbol::Symbol(sym_names, sym_info->length, package);
	    Symbol **p = FindSymbol(&package->ext_hash,
				    sym_names, sym->leng(), sym->Hash());
	    if (p == NULL || *p != NULL)
		fprintf(stderr, "[Failed to properly initialize symbols!]\n");
	    else {
		*p = sym;
		count++;
		package->ext_hash.rehash_if_needed();
	    }
	}
	sym_names += sym_info->length + 1;
    }
    return count;
}
#endif

static SymbolInitElement el_dummy = {0};
static int __sym_init_dummy = InitSymbols(&el_dummy, NULL);

struct Module *DefaultModule = LookupModule(&QMain_sym);
