/******************************************************************

    $Header$

    Module: evaluate.C

    Author: Jeff Lait

    Copyright 1997 Ytinasin.

    Description: Evaluates atoms.

 ******************************************************************/

/******************************************************************

  Revision Record

    Rev Date        Auth    Changes
    === ====        ====    =======

    0.0 12/8/97 jml     start

 ******************************************************************/

/******************************************************************
 * INCLUDES:
 ******************************************************************/
#include "defines.h"
#include "symtable.h"
#include "atom.h"
#include "evaluate.h"
#include "reaper.h"

/******************************************************************
 * CLASSES
 ******************************************************************/
uMonitor UNIQUE_ID
{
    int m_id;
public:
    UNIQUE_ID() { m_id = 0; }
    int getId() { return m_id++; }
};

/******************************************************************
 * LOCAL VARIABLES
 ******************************************************************/
UNIQUE_ID glbUniqueId;          // Thread safe unique id generator

/******************************************************************
 * LOCAL FUNCTION PROTOTYPES
 * NB: All must be thread safe!!
 ******************************************************************/
int IsSkipEvaluation(ATOM *fnc);
// Creates atoms wrt local symbol table
void ResolveAlias(ATOM *atom, SYMTABLE *local);
// Creates atoms wrt global symbol table!!
void ResolveAliases(ATOM *atom, char *fname, ATOM *var, SYMTABLE *local, 
		    SYMTABLE *global);
void ResolveFuture(ATOM *fnc);
void AddSpecialCases(SYMTABLE *global);

/******************************************************************
 * EVALUATE member funcs
 ******************************************************************/
/******************************************************************
 * EVALUATE::EVALUATE
 ******************************************************************/
EVALUATE::EVALUATE(SYMTABLE *global, SYMTABLE *local)
{
    m_glbsym = global;
    m_lclsym = local;
    m_lclsym->addRef();
    m_future = NULL;
    m_done = 0;
    m_atommngr = NULL;
}

/******************************************************************
 * EVALUATE::~EVALUATE
 ******************************************************************/
EVALUATE::~EVALUATE()
{
    if (!m_wait.uEmpty())
    {
        m_done = 1;
        uSignal m_wait;
        uWait m_wait;
    }
    m_lclsym->removeRef();
    if (m_future)
        m_future->removeRef();
//uCerr << "Killing atom manager\n";
    delete m_atommngr;
//uCerr << "Killed atom manager\n";
}

/******************************************************************
 * CreateEvaluator
 ******************************************************************/
EVALUATE *CreateEvaluator()
{
    // Build new global symbol table from scratch....
    SYMTABLE        *table;
    EVALUATE        *evaluator;

    table = new SYMTABLE_HASH(NULL, &glbAtomMgr);     // Create global table...
    // And initialize:
    AddSpecialCases(table);
    evaluator = new EVALUATE(table, table);
    return evaluator;
}

/******************************************************************
 * EVALUATE::evaluateAtom
 * TBD: Is this superflous?
 ******************************************************************/
ATOM *EVALUATE::evaluateAtom(ATOM *atom)
{
    // Do boring old evaluation....
    // Do not need the seperate thread for this....
    return evaluate(atom, m_lclsym);
}

/******************************************************************
 * EVALUATE::evaluateAtomGlobal
 * Returns result on global heap
 * Uses own thread!  (Blocks caller, use evaluateAtomFuture for 
 * non-blocking)
 ******************************************************************/
ATOM *EVALUATE::evaluateAtomGlobal(ATOM *atom)
{
    ATOM *myatom, *result;

    // Do boring old evaluation....
    // Do not need the seperate thread for this....
    m_atom = atom;
    m_future = NULL;
    
    uSignal m_wait;
    uWait m_wait;
    
    result = glbAtomMgr.Duplicate(m_atom);
    m_atommngr->Destroy(m_atom);

    return result;
}

/******************************************************************
 * EVALUATE::evaluateAtom
 ******************************************************************/
ATOM *EVALUATE::evaluateAtom(ATOM *atom, SYMTABLE *local)
{
    // Do boring old evaluation....
    // Do not need the seperate thread for this....
    return evaluate(atom, local);
}

/******************************************************************
 * EVALUATE::evalFuture
 ******************************************************************/
ATOM *EVALUATE::evalFuture(ATOM *atom)
{
    ATOM *result;

    // Now THIS is interesting....
    m_future = new FUTURE;
    m_future->addRef();             // This is our own reference...
    m_future->addRef();             // And this is that of the caller.
    m_atom = m_atommngr->Duplicate(atom);	// MUST duplicate
    result = GLB_GetAtomHeap.Alloc();   // This is from the same place as 
				    // caller!
    result->type = AFUTURE;
    result->data.p = (void *) m_future;

    uSignal m_wait;

    return result;
}

/******************************************************************
 * EVALUATE::main
 * NB: atom heap actually created here!
 ******************************************************************/
void EVALUATE::main()
{
    ATOM_SMALL_HEAP	atomheap;

    // We do not have to worry about people hitting this before creation
    // as they cannot call in until we have blocked...
    m_atommngr = new ATOM_MNGR(&atomheap);

    for (;;)
    {
	uWait m_wait;

	if (m_done) break;		// QUIT...
	   
	if (m_future)
	{
	    // Now, on our own thread, we evaluate the futre & write the
	    // result, then kill ourselves via reaper.
	    ATOM *result;

	    // Note ignores the FLIST qualification that is guaranteed
	    // to be on atom...
	    result = evaluate(m_atom, m_lclsym, 1);
	    m_future->writeData(result);
	    glbReaper.requestKill(this);
//uCerr << "We are awaiting the reaper\n";
	    break;			// QUIT...
	}
	else
	{
	    // We are asked to evaluate normally, and handshake when
	    // done.
	    // Note we do NOT ignore FLIST.
	    m_atom = evaluate(m_atom, m_lclsym);
	    uSignal m_wait;
	}
    }
    uSignal m_wait;
}

/******************************************************************
 * EVALUATE::evaluate
 * This is the workhorse, actual atom evaluation occurs here.
 ******************************************************************/
ATOM *EVALUATE::evaluate(ATOM *atom, SYMTABLE *local, int ignoreFLIST)
{
    if (atom)
    {
        if (atom->quote)
        {
            return (m_atommngr->Duplicate(atom));
        }

        switch (atom->type)
        {
            case FLIST:
                if (!ignoreFLIST)
                {
                    ATOM *result;

                    // Same as list, but must be created on new thread!
                    EVALUATE *evaluate;

                    evaluate = new EVALUATE(m_glbsym, local);

                    result = evaluate->evalFuture(atom);
                    return result;
                    break;
                }
                // FALL THROUGH!

            case LIST:
            {
                ATOM *head, *cur, *hnl, *cnl, *result;

                head = (ATOM *) atom->data.p;
                if (!head) 
                {
                    // Empty list evaluates to self...
                    return(m_atommngr->Duplicate(NULL));
                }
                hnl = NULL;     // Head of new list...
                for (cur = head; cur; cur = cur->next) 
                {
                    if (!hnl) 
                    {
                        // Do something special??
                        hnl = cnl = evaluate(cur, local);
                        if (hnl->type == AFUTURE)
                        {
                            // Duplicate future result and destroy our local
                            // copy, use the result for resolution of aliases,
                            // etc.
                            // As futures are always result of evaluation
                            // do not need to reevaluate
                            hnl = m_atommngr->Duplicate(((FUTURE *)hnl->data.p)->getData());
                            m_atommngr->Destroy(cnl);
                            cnl = hnl;
                        }
                        ResolveAlias(cnl, local);
                        // Handle extra special functions (lambda, cond...)
                        if (IsSkipEvaluation(hnl)) 
                        {
                            for(cur = cur->next; cur; cur = cur->next) 
                            {
                                cnl->next = m_atommngr->Duplicate(cur);
                                cnl = cnl->next;
                            }
                            break;
                        }
                    }
                    else 
                    {
                        cnl->next = evaluate(cur, local);
                        cnl = cnl->next;
                    }
                }
                result = RunFunction(hnl, local);
                // Delete temporary arguement list...
                m_atommngr->Destroy(hnl);
                return(result);
            }

            case SYMBOL:
            {
                SYMENTRY    *entry;

                entry = local->LookupEntry((char *) atom->data.p);

                if (entry)
                {
                    switch (entry->type)
                    {
                        case FUNC:
                        case INTERNAL:
                            return m_atommngr->Duplicate(atom);

                        case ALIAS:
                            // It is an alias, we evaluate the body & return it.
                            return evaluate(entry->body, local);

                        default:
                            assert(FALSE);
                            break;
                    }
                }
                else
                {
                    // Merely duplicate
                    return m_atommngr->Duplicate(atom);
                }
            }   

            case TRUE:
            case FALSE:
            case NUMBER:
            case STRING:
            case AFUTURE: // TBD: Is this right?????
                return m_atommngr->Duplicate(atom);
        }       // End switch atom->type
    }       // End if atom
    else
    {
        // Empty list.
        return m_atommngr->Duplicate(NULL);
    }
}               


/******************************************************************
 * EVALUATE::RunFunction
 *  Takes a list of atoms, all of which have been evaluated.
 * Creates symbol table of parameters & then evaluates the first
 * atom's body, which will give result.
 ******************************************************************/
ATOM *EVALUATE::RunFunction(ATOM *fnc, SYMTABLE *local)
{
    SYMTABLE    *table, *localtable;    // Local definitions go here.
    SYMENTRY    *funcentry, *entry;
    PARAM_LIST  *curs;
    ATOM        *result, *cura;
    
    // Now have an evaluated list, apply all given parameters
    // to specified primary symbol
    if (fnc->type != SYMBOL) 
    {
        // If not a symbol, ie: not a function or a degenerate function,
        // result is first element: NB: Incompatibility!!
        uCerr << uAcquire << "cannot evaluate with fnc:";
        PrintAtom(fnc, uCerr);
        uCerr << endl << uRelease;
        return(m_atommngr->Duplicate(fnc));
    }

    // Add local variables to symbol table...
    funcentry = local->LookupEntry((char *) fnc->data.p);
    if (!funcentry) 
    {
        uCerr << uAcquire << "Symbol " << (char *) fnc->data.p <<
                " not found" << endl << uRelease;
        uCerr << uAcquire << "Current evaluator is " << this << endl << uRelease;
        return(m_atommngr->Duplicate(NULL));
    }
    if (funcentry->type == INTERNAL) 
    {
        if (!IsSkipEvaluation(fnc))
        {
            // Must resolve all futures:
            for (cura = fnc->next; cura; cura = cura->next)
            {
                ResolveFuture(cura);
            }
        }
        // Now invoke fnction pointer:
        assert(funcentry->fnc);
        result = funcentry->fnc(fnc, m_glbsym, local, this);
        assert(result);
        return(result);
    }
    assert(funcentry->type == FUNC);
    // Local tables are linked lists, not hash tables!
    localtable = new SYMTABLE_LIST(local, m_atommngr);
    localtable->addRef();
    cura = fnc->next;
    curs = funcentry->param;
    while (cura && curs) 
    {
        entry = new SYMENTRY;
        entry->name = ourstrdup(curs->name);
        entry->hash = curs->hash;
        entry->body = m_atommngr->Duplicate(cura);
        entry->type = ALIAS;
        localtable->AddEntry(entry);

        cura = cura->next;
        curs = curs->next;
    }

    if (curs) 
    {
        uCerr << uAcquire << "Not enough param" << endl << uRelease;
        printf("Not enough param!\n");
        localtable->removeRef();
        return(m_atommngr->Duplicate(NULL));
    }
    if (cura) 
    {
        uCerr << uAcquire << "Too many param" << endl << uRelease;
        localtable->removeRef();
        return(m_atommngr->Duplicate(NULL));
    }
    
    // Now evaluate the body with the new symbol table...
    result = evaluate(funcentry->body, localtable);

    // Cleanup...
    localtable->removeRef();
    return(result);
}


/******************************************************************
 * IsSkipEvaluation
 * If this is true, only the symbol is evaluated, the parameters are
 * left until the parsing.  req'd form lambda and conditionals.
 * This also does not resolve futures!!!
 * TBD: Use a flag to skip these strcmps!!!
 ******************************************************************/
int IsSkipEvaluation(ATOM *fnc)
{
    if (fnc->type != SYMBOL)
        return FALSE;
    if (!strcmp((char *)fnc->data.p, "lambda"))
        return(TRUE);
    if (!strcmp((char *)fnc->data.p, "cond"))
        return(TRUE);
    if (!strcmp((char *)fnc->data.p, "letrec"))
        return(TRUE);
    if (!strcmp((char *)fnc->data.p, "if"))
        return(TRUE);
    if (!strcmp((char *)fnc->data.p, "define"))
        return(TRUE);
    if (!strcmp((char *)fnc->data.p, "expand~"))
        return(TRUE);
    if (!strcmp((char *)fnc->data.p, "future~"))
        return(TRUE);
    return(FALSE);
}

/******************************************************************
 * Resolves futures, req'd before SCMFNCs called:
 * ACTS IN PLACE!
 ******************************************************************/
void ResolveFuture(ATOM *fnc)
{
    if (fnc->type == AFUTURE)
    {
        ATOM *result;
        ATOM temp;

        temp = *(((FUTURE *)fnc->data.p)->getData());
        temp.next = NULL;
        result = GLB_GetAtomHeap.Duplicate(&temp);
        ((FUTURE *)fnc->data.p)->removeRef();
        temp.next = fnc->next;
        *fnc = *result;
        fnc->next = temp.next;
        result->data.p = NULL;
        result->next = NULL;
        GLB_GetAtomHeap.Destroy(result);
    }
}

/******************************************************************
 * Verification procedures:
 ******************************************************************/
/******************************************************************
 * VERNum
 ******************************************************************/
int VERNum(ATOM *fnc, int num)
{
    if (!fnc)
    {
        uCerr << uAcquire << "too few param\n" << uRelease;
        return 0;
    }
    while (num)
    {
        if (!fnc->next)
        {
            uCerr << uAcquire << "too few param\n" << uRelease;
            return 0;
        }
        fnc = fnc->next;
        num--;
    }
    if (fnc->next)
    {
        uCerr << uAcquire << "too many param\n" << uRelease;
        return 0;
    }
    return 1;
}

/******************************************************************
 * VERType
 ******************************************************************/
int VERType(ATOM *fnc, int type, int offset)
{
    int match = 0;

    while (offset--)
        fnc = fnc->next;

    switch (type)
    {
        case LIST:
            match = (fnc->type == FLIST) | (fnc->type == LIST);
            break;

        case STRING:
        case SYMBOL:
        case NUMBER:
            match = (fnc->type == type);
            break;

        default:
            assert(FALSE);
            match = 0;
            break;
    }
    if (!match)
    {
        uCerr << uAcquire << "Type " << fnc->type << " found where "
                << type << " expected\n" << uRelease;
        return 0;
    }
    return 1;
}


/******************************************************************
 * Here are all our built in functions:
 ******************************************************************/
/******************************************************************
 * SCMFNCMinus
 ******************************************************************/
ATOM *SCMFNCMinus(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 2) || !VERType(fnc, NUMBER, 1) || !VERType(fnc, NUMBER, 2))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = NUMBER;
    result->data.f = fnc->next->data.f - fnc->next->next->data.f;
    return result;
}

/******************************************************************
 * SCMFNCDiv
 ******************************************************************/
ATOM *SCMFNCDiv(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 2) || !VERType(fnc, NUMBER, 1) || !VERType(fnc, NUMBER, 2))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = NUMBER;
    result->data.f = fnc->next->data.f / fnc->next->next->data.f;
    return result;
}

/******************************************************************
 * SCMFNCMul
 ******************************************************************/
ATOM *SCMFNCMul(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 2) || !VERType(fnc, NUMBER, 1) || !VERType(fnc, NUMBER, 2))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = NUMBER;
    result->data.f = fnc->next->data.f * fnc->next->next->data.f;
    return result;
}

/******************************************************************
 * SCMFNCInt
 ******************************************************************/
ATOM *SCMFNCInt(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 1) || !VERType(fnc, NUMBER, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = NUMBER;
    result->data.f = (int)(fnc->next->data.f);
    return result;
}

/******************************************************************
 * SCMFNCSin
 ******************************************************************/
ATOM *SCMFNCSin(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 1) || !VERType(fnc, NUMBER, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = NUMBER;
    result->data.f = sin(fnc->next->data.f);
    return result;
}

/******************************************************************
 * SCMFNCCos
 ******************************************************************/
ATOM *SCMFNCCos(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 1) || !VERType(fnc, NUMBER, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = NUMBER;
    result->data.f = cos(fnc->next->data.f);
    return result;
}

/******************************************************************
 * SCMFNCSrand
 * TBD: Mutex on rand???
 ******************************************************************/
ATOM *SCMFNCSrand(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 1) || !VERType(fnc, NUMBER, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.CreateTrue();
    srand((int)fnc->next->data.f);
    return result;
}

/******************************************************************
 * SCMFNCRand
 * TBD: Mutex on rand??
 ******************************************************************/
ATOM *SCMFNCRand(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 0))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = NUMBER;
    result->data.f = ((float)(rand() & 32767)) / 32767.0;
    return result;
}

/******************************************************************
 * SCMFNCEqual
 ******************************************************************/
ATOM *SCMFNCEqual(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 2) || !VERType(fnc, fnc->next->type, 2))
        return GLB_GetAtomHeap.Duplicate(NULL);

    if (fnc->next->type == SYMBOL ||
        fnc->next->type == STRING)
    {
        result = (!strcmp((char *)fnc->next->data.p, (char *)fnc->next->next->data.p)) ? GLB_GetAtomHeap.CreateTrue() : GLB_GetAtomHeap.CreateFalse();
    }
    else
    {
        result = (fnc->next->data.p == fnc->next->next->data.p) ? GLB_GetAtomHeap.CreateTrue() : GLB_GetAtomHeap.CreateFalse();
    }
    return result;
}

/******************************************************************
 * SCMFNCLess
 ******************************************************************/
ATOM *SCMFNCLess(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 2) || !VERType(fnc, NUMBER, 1) || !VERType(fnc, NUMBER, 2))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = (fnc->next->data.f < fnc->next->next->data.f) ? GLB_GetAtomHeap.CreateTrue() : GLB_GetAtomHeap.CreateFalse();
    return result;
}

/******************************************************************
 * SCMFNCCar
 ******************************************************************/
ATOM *SCMFNCCar(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    if (!VERNum(fnc, 1) || !VERType(fnc, LIST, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    if (!fnc->next->data.p)
    {
        uCerr << uAcquire << "Error: CAR on empty list\n" << uRelease;
        return GLB_GetAtomHeap.Duplicate(NULL);
    }
    result = GLB_GetAtomHeap.Duplicate((ATOM *)fnc->next->data.p);
    if (result->type == LIST || result->type == FLIST)
    {
        // Propogate quote status:
        result->quote |= fnc->next->quote;
    }

    return result;
}

/******************************************************************
 * SCMFNCCdr
 ******************************************************************/
ATOM *SCMFNCCdr(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result, *temp;
    if (!VERNum(fnc, 1) || !VERType(fnc, LIST, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);
    if (!fnc->next->data.p)
    {
        uCerr << uAcquire << "Error: CDR on empty list\n" << uRelease;
        return GLB_GetAtomHeap.Duplicate(NULL);
    }
    result = GLB_GetAtomHeap.Duplicate(fnc->next);
    temp = (ATOM *) result->data.p;
    result->data.p = (void *) temp->next;
    temp->next = NULL;
    GLB_GetAtomHeap.Destroy(temp);

    return result;
}

/******************************************************************
 * SCMFNCList
 ******************************************************************/
ATOM *SCMFNCList(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    ATOM *head, *cur, *src;

    result = GLB_GetAtomHeap.Duplicate(NULL);
    head = NULL;
    for (src = fnc->next; src; src = src->next) {
        if (!head) {
            cur = GLB_GetAtomHeap.Duplicate(src);
            head = cur;
            }
        else {
            cur->next = GLB_GetAtomHeap.Duplicate(src);
            cur = cur->next;
            }
        }
    result->data.p = (void *) head;
    result->quote = TRUE;

    return result;
}

/******************************************************************
 * SCMFNCFlist
 ******************************************************************/
ATOM *SCMFNCFlist(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    ATOM *head, *cur, *src;

    result = GLB_GetAtomHeap.Duplicate(NULL);
    result->type = FLIST;
    head = NULL;
    for (src = fnc->next; src; src = src->next) {
        if (!head) {
            cur = GLB_GetAtomHeap.Duplicate(src);
            head = cur;
            }
        else {
            cur->next = GLB_GetAtomHeap.Duplicate(src);
            cur = cur->next;
            }
        }
    result->data.p = (void *) head;
    result->quote = TRUE;

    return result;
}

/******************************************************************
 * SCMFNCCons
 ******************************************************************/
ATOM *SCMFNCCons(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, 
                    EVALUATE *evaluator)
{
    ATOM *result, *temp;

    if (!VERNum(fnc, 2) || !VERType(fnc, LIST, 2))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Duplicate(fnc->next->next);
    temp = GLB_GetAtomHeap.Duplicate(fnc->next);
    temp->next = (ATOM *) result->data.p;
    result->data.p = (void *) temp;

    return result;
}

/******************************************************************
 * SCMFNCLambda
 ******************************************************************/
ATOM *SCMFNCLambda(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result, *cura;
    char *temp;
    SYMENTRY *entry;
    PARAM_LIST *curs;

    if (!VERNum(fnc, 2) || !VERType(fnc, LIST, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    // Create unique name
    result = GLB_GetAtomHeap.Alloc();
    result->type = SYMBOL;
    temp = GetMem(12);
    sprintf(temp, "~%d", glbUniqueId.getId());
    result->data.p = (void *) temp;

    // Create symbol entry
    entry = new SYMENTRY;
    entry->name = ourstrdup(temp);
    entry->body = global->getAtomMngr()->Duplicate(fnc->next->next);
    entry->body->quote = FALSE;
    entry->type = FUNC;

    // Implicitly ignores global table!
    ResolveAliases(entry->body, entry->name, (ATOM *) fnc->next->data.p, local, global);

    // Build param list
//uCerr << "Building param list of " << entry->name << endl;
    entry->param = NULL;
    curs = NULL;
    for (cura = (ATOM *) fnc->next->data.p; cura; cura = cura->next)
    {
        if (!curs)
        {
            curs = new PARAM_LIST;
            entry->param = curs;
        }
        else
        {
            curs->next = new PARAM_LIST;
            curs = curs->next;
        }
        curs->hash = -1;
        curs->name = ourstrdup((char *)cura->data.p);
        curs->next = NULL;
//uCerr << curs->name << ", ";
    }
//uCerr << "Starts with " << entry->param << endl;
//uCerr << endl;

    global->AddEntry(entry);

    return result;
}

/******************************************************************
 * SCMFNCCond
 ******************************************************************/
ATOM *SCMFNCCond(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, 
                    EVALUATE *evaluator)
{
    ATOM *result = NULL, *src, *test, *testresult;

    src = fnc->next;
    while (src && !result) 
    {
        if (!VERType(src, LIST, 0))
            return(GLB_GetAtomHeap.Duplicate(NULL));

        test = (ATOM *) src->data.p;
        if (!VERNum(test, 1))
            return(GLB_GetAtomHeap.Duplicate(NULL));

        testresult = evaluator->evaluateAtom(test, local);
        ResolveFuture(testresult);
        if (testresult && testresult->type == TRUE) 
        {
            result = evaluator->evaluateAtom(test->next, local);
        }
        GLB_GetAtomHeap.Destroy(testresult);
        src = src->next;
    }
    if (!result) 
    {
        uCerr << uAcquire << "Cond with no true condition!\n" << uRelease;
        return(GLB_GetAtomHeap.Duplicate(NULL));
    }
    
    return result;
}

/******************************************************************
 * SCMFNCIf
 ******************************************************************/
ATOM *SCMFNCIf(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    ATOM *testresult;

    if (!VERNum(fnc, 3))
        return GLB_GetAtomHeap.Duplicate(NULL);

    testresult = evaluator->evaluateAtom(fnc->next, local);
    ResolveFuture(testresult);
    if (testresult && (testresult->type == TRUE)) 
    {
        result = evaluator->evaluateAtom(fnc->next->next, local);
    }
    else if (testresult && (testresult->type == FALSE)) 
    {
        result = evaluator->evaluateAtom(fnc->next->next->next, local);
    }
    else 
    {
        return GLB_GetAtomHeap.Duplicate(NULL);
    }
    GLB_GetAtomHeap.Destroy(testresult);
    return result;
}

/******************************************************************
 * SCMFNCLoad
 ******************************************************************/
ATOM *SCMFNCLoad(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result;
    char *temp;
    int f_len, pos = 0;
    FILE *fp;
    ATOM *head, *cur;

    if (!VERNum(fnc, 1) || !VERType(fnc, STRING, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    fp = ReadOpenFP((char *) fnc->next->data.p);
    f_len = FileSize(fp);
    temp = GetMem(f_len+1);
    fread(temp, f_len, 1, fp);
    temp[f_len] = 0;

    // Recall: Parseline creates on global stack
    head = ParseLine(temp, &pos);

    FreeMem(temp);
    fclose(fp);
    result = NULL;
    for (cur = head; cur; cur = cur->next) {
        if (result) {
            GLB_GetAtomHeap.Destroy(result);
            }
        // TBD: Do we use local?  I guess so (Allows generics :>)
        result = evaluator->evaluateAtom(cur, local);
        }
    glbAtomMgr.Destroy(head);

    return result;
}

/******************************************************************
 * SCMFNCLetrec
 ******************************************************************/
ATOM *SCMFNCLetrec(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM        *result;
    SYMENTRY    *entry;
    SYMTABLE    *table;
    ATOM        *cura, *child;

    if (!VERNum(fnc, 2) || !VERType(fnc, LIST, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    // Local tables are linked lists, not hash tables
    table = new SYMTABLE_LIST(local, &GLB_GetAtomHeap);
    table->addRef();

    // Calculate & build local symbol table.
    for (cura = (ATOM *)fnc->next->data.p; cura; cura = cura->next)
    {
        if (!VERType(cura, LIST, 0))
            return GLB_GetAtomHeap.Duplicate(NULL);

        child = (ATOM *) cura->data.p;

        if (!VERNum(child, 1))
            return GLB_GetAtomHeap.Duplicate(NULL);

        if (!VERType(child, SYMBOL, 0))
            return GLB_GetAtomHeap.Duplicate(NULL);

        entry = new SYMENTRY;
        entry->name = ourstrdup((char *)child->data.p);
        entry->type = ALIAS;
        entry->body = evaluator->evaluateAtom(child->next, local);
        table->AddEntry(entry);
    }
    // Now, evaluate func with this table:
    result = evaluator->evaluateAtom(fnc->next->next, table);
    table->removeRef();

    return result;
}

/******************************************************************
 * SCMFNCDefine
 ******************************************************************/
ATOM *SCMFNCDefine(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result, *temp;
    SYMENTRY *entry;
    ATOM *newbody;

    if (!VERNum(fnc, 2) || !VERType(fnc, SYMBOL, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    result = GLB_GetAtomHeap.Alloc();
    result->type = SYMBOL;
    result->data.p = (void *) ourstrdup((char *)fnc->next->data.p);

    entry = global->LookupEntry((char *)result->data.p);

    if (entry)
    {
        // Ideally, we replace entries body with the new body, changing
        // over to an ALIAS type.  But, as another thread might be using
        // the old body this is not allowed.  Thus, we blame it on
        // the user:
        uCerr << uAcquire << 
                "Only an incompetent Scheme programmer would redefine " <<
                entry->name << endl << uRelease;
    }
    entry = new SYMENTRY();
    entry->name = ourstrdup((char *)fnc->next->data.p);
    entry->type = ALIAS;
    temp = evaluator->evaluateAtom(fnc->next->next);
    entry->body = global->getAtomMngr()->Duplicate(temp);
    GLB_GetAtomHeap.Destroy(temp);
    global->AddEntry(entry);

    return result;
}

/******************************************************************
 * SCMFNCNull
 ******************************************************************/
ATOM *SCMFNCNull(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    if (((fnc->next->type == LIST) || (fnc->next->type == FLIST)) && 
                (!fnc->next->data.p))
        return GLB_GetAtomHeap.CreateTrue();
    else
        return GLB_GetAtomHeap.CreateFalse();
}

/******************************************************************
 * SCMFNCListp
 ******************************************************************/
ATOM *SCMFNCListp(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    if ((fnc->next->type == LIST) || (fnc->next->type == FLIST))
        return GLB_GetAtomHeap.CreateTrue();
    else
        return GLB_GetAtomHeap.CreateFalse();
}

/******************************************************************
 * SCMFNCNumber
 ******************************************************************/
ATOM *SCMFNCNumber(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    if (fnc->next->type == NUMBER)
        return GLB_GetAtomHeap.CreateTrue();
    else
        return GLB_GetAtomHeap.CreateFalse();
}

/******************************************************************
 * SCMFNCAtom
 ******************************************************************/
ATOM *SCMFNCAtom(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    if (((fnc->next->type == LIST) || (fnc->next->type == FLIST)) && 
                (fnc->next->data.p))
        return GLB_GetAtomHeap.CreateFalse();
    else
        return GLB_GetAtomHeap.CreateTrue();
}

/******************************************************************
 * SCMFNCSymbol
 ******************************************************************/
ATOM *SCMFNCSymbol(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    if (fnc->next->type == SYMBOL)
        return GLB_GetAtomHeap.CreateTrue();
    else
        return GLB_GetAtomHeap.CreateFalse();
}

/******************************************************************
 * SCMFNCSymboldump
 ******************************************************************/
ATOM *SCMFNCSymboldump(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 0))
        return GLB_GetAtomHeap.Duplicate(NULL);

    uCout << uAcquire << "Symboldump:\n";
    local->print(uCout);
    uCout << endl << uRelease;

    return GLB_GetAtomHeap.Duplicate(NULL);
}

/******************************************************************
 * SCMFNCDisplay
 ******************************************************************/
ATOM *SCMFNCDisplay(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    uCout << uAcquire;
    PrintAtom(fnc->next, uCout);
    uCout << endl << uRelease;

    return GLB_GetAtomHeap.Duplicate(NULL);;
}

/******************************************************************
 * SCMFNCExpand
 ******************************************************************/
ATOM *SCMFNCExpand(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    uCout << uAcquire;
    PrintExpandAtom(fnc->next, local, uCout);
    uCout << uRelease;

    return GLB_GetAtomHeap.Duplicate(NULL);;
}

/******************************************************************
 * SCMFNCFuture
 ******************************************************************/
ATOM *SCMFNCFuture(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    uCout << uAcquire;
    if (fnc->next->type != AFUTURE)
        uCout << "This is not a future!" << endl;
    else
        PrintAtom(((FUTURE *)fnc->next->data.p)->getData(), uCout);
    uCout << uRelease;

    return GLB_GetAtomHeap.Duplicate(NULL);;
}

/******************************************************************
 * SCMFNCBegin
 ******************************************************************/
ATOM *SCMFNCBegin(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    ATOM *result, *cur;

    if (!fnc->next)
        return GLB_GetAtomHeap.Duplicate(NULL);

    cur = fnc->next;
    while (cur->next)
        cur = cur->next;

    result = GLB_GetAtomHeap.Duplicate(cur);
    return( result );
}

/******************************************************************
 * SCMFNCEval
 ******************************************************************/
ATOM *SCMFNCEval(ATOM *fnc, SYMTABLE *global, SYMTABLE *local, EVALUATE *evaluator)
{
    if (!VERNum(fnc, 1))
        return GLB_GetAtomHeap.Duplicate(NULL);

    fnc->next->quote = FALSE;

    return evaluator->evaluateAtom(fnc->next, local);
}


/******************************************************************
 * AddInternalSymbol
 ******************************************************************/
void AddInternalSymbol(SYMTABLE *global, char *s, ATOM *(*fnc)(ATOM *, SYMTABLE *, SYMTABLE *, EVALUATE *))
{
    SYMENTRY    *sym;

    sym = new SYMENTRY;
    sym->name = ourstrdup(s);
    sym->type = INTERNAL;
    sym->fnc = fnc;
    global->AddEntry(sym);
}

/******************************************************************
 * AddSpecialCases
 ******************************************************************/
void AddSpecialCases(SYMTABLE *global)
{
    AddInternalSymbol(global, "-", SCMFNCMinus);
    AddInternalSymbol(global, "/", SCMFNCDiv);
    AddInternalSymbol(global, "*", SCMFNCMul);
    AddInternalSymbol(global, "int", SCMFNCInt);
    AddInternalSymbol(global, "sin", SCMFNCSin);
    AddInternalSymbol(global, "cos", SCMFNCCos);
    AddInternalSymbol(global, "srand", SCMFNCSrand);
    AddInternalSymbol(global, "rand", SCMFNCRand);
    AddInternalSymbol(global, "=", SCMFNCEqual);
    AddInternalSymbol(global, "<", SCMFNCLess);
    AddInternalSymbol(global, "car", SCMFNCCar);
    AddInternalSymbol(global, "cdr", SCMFNCCdr);
    AddInternalSymbol(global, "list", SCMFNCList);
    AddInternalSymbol(global, "flist", SCMFNCFlist);
    AddInternalSymbol(global, "cons", SCMFNCCons);
    AddInternalSymbol(global, "lambda", SCMFNCLambda);
    AddInternalSymbol(global, "cond", SCMFNCCond);
    AddInternalSymbol(global, "if", SCMFNCIf);
    AddInternalSymbol(global, "load", SCMFNCLoad);
    AddInternalSymbol(global, "letrec", SCMFNCLetrec);
    AddInternalSymbol(global, "define", SCMFNCDefine);
    AddInternalSymbol(global, "null?", SCMFNCNull);
    AddInternalSymbol(global, "list?", SCMFNCListp);
    AddInternalSymbol(global, "number?", SCMFNCNumber);
    AddInternalSymbol(global, "atom?", SCMFNCAtom);
    AddInternalSymbol(global, "symbol", SCMFNCSymbol);
    AddInternalSymbol(global, "symboldump~", SCMFNCSymboldump);
    AddInternalSymbol(global, "display", SCMFNCDisplay);
    AddInternalSymbol(global, "expand~", SCMFNCExpand);
    AddInternalSymbol(global, "begin", SCMFNCBegin);
    AddInternalSymbol(global, "eval", SCMFNCEval);
    AddInternalSymbol(global, "future~", SCMFNCFuture);
}

/******************************************************************
 * ResolveAlias
 * Special case: merely resolves current symbol into bottom most
 * level.
 ******************************************************************/
void ResolveAlias(ATOM *atom, SYMTABLE *local)
{
    SYMENTRY *sym;

    if (!atom)
        return;

    switch (atom->type) 
    {
        case FLIST:
        case LIST:
        case NUMBER:
        case TRUE:
        case FALSE:
        case STRING:
        case AFUTURE:
            break;

        case SYMBOL:
            if (atom->quote)
                return;

            sym = local->LookupEntry((char *)atom->data.p);
            if (!sym)
                return;     // Not present.. Nother variable?
            if (sym->type == ALIAS) 
            {
                ATOM *next;

                // Straight alias, replace & try again...
                // Destroy our data...
                if (atom->data.p) 
                {
                    FreeMem((char *)atom->data.p);
                }
                // Must copy as someone may point to us!!
		next = GLB_GetAtomHeap.Duplicate(sym->body);
#ifdef ATOM_DEBUG
		assert(next->owner == atom->owner);
#endif
                atom->data.p = next->data.p;
                atom->type = next->type;
                atom->quote = next->quote;
                next->data.p = NULL;
                GLB_GetAtomHeap.Destroy(next);
                ResolveAlias(atom, local);
            }
            break;

        default:
            assert(FALSE);
    }
    return;                 // This is why one shouldn't code drunk.
}


/******************************************************************
 * ResolveAliases
 * Expand any aliases not on var list.
 * This ensures lambda expansion is done with current symbol table,
 * not the global one...  The var list ensures no scope problems occur.
 * Atoms are created from the global symbol table's heap
 ******************************************************************/
void ResolveAliases(ATOM *atom, char *fname, ATOM *var, SYMTABLE *local, 
		    SYMTABLE *global)
{
    SYMENTRY *sym;
    ATOM     *cur;

    if (!atom)
        return;

    switch (atom->type) 
    {
        case FLIST:
        case LIST:
            for (cur = (ATOM *) atom->data.p; cur; cur = cur->next) 
            {
                ResolveAliases(cur, fname, var, local, global);
            }
            break;

        case NUMBER:
        case TRUE:
        case FALSE:
        case STRING:
        case AFUTURE:
            break;

        case SYMBOL:
            if (atom->quote)
                return;

            if (!strcmp(fname, (char *)atom->data.p))
                return;

            for (cur = var; cur; cur = cur->next) 
            {
                assert(cur->type == SYMBOL);
                if (!strcmp((char *)cur->data.p, (char *)atom->data.p)) 
                {
                    // On var list, don''t play wiht...
                    return;
                }
            }
            // Does NOT use the global table!!
            sym = local->LookupEntry((char *)atom->data.p, 0);
            if (!sym)
                return;     // Not present.. Nother variable?

            if (sym->type == ALIAS) 
            {
                ATOM *next;

                // Straight alias, replace & try again...
                // Destroy our data...
                if (atom->data.p) 
                {
                    FreeMem((char *)atom->data.p);
                }
                // Must copy as someone may point to us!!
                next = global->getAtomMngr()->Duplicate(sym->body);
#ifdef ATOM_DEBUG
		assert(next->owner == atom->owner);
#endif
                atom->data.p = next->data.p;
                atom->type = next->type;
                atom->quote = next->quote;
                next->data.p = NULL;
                global->getAtomMngr()->Destroy(next);
                ResolveAliases(atom, fname, var, local, global);
            }
            break;

        default:
            assert(FALSE);
    }
}