/* Copyright 1989-93 GROUPE BULL -- See license conditions in file COPYRIGHT */
/************************\
* 			 *
*  KlO  Hash	  	 *
*  BODY			 *
* 			 *
\************************/

#include "EXTERN.h"
#include "klone.h"
#include "kl_number.h"
#include "kl_atom.h"
#include "kl_list.h"
#include "kl_func.h"
#include "INTERN.h"
#include "kl_hash.h"

KlHash KlErrorUnRecoverableTable;

#define KlHashFunc(table, key) (((UInt) key) % table->limit)
#define KlHashCellCreate(cell, obj, key, Next) \
    cell = (KlHashCell) Malloc(sizeof(struct _KlHashCell));\
    cell->object = obj;\
    cell->next = Next;\
    cell->key = key

/* KlHashMake
 * creates a hash table from a plist (which may be nil)
 * default is to manage the ref count of the objects & keys
 * KLONE_CALLABLE
 */

KlHash
KlHashAlloc(size)
    int size;
{
    KlHash obj = (KlHash) KlOMake(KlHashType);
    KlOZero(obj, (size_t) sizeof(struct _KlHash));

    if (size > KlHashInitialSize) {
	obj->limit = KlHashFixSize(size);
    } else {
	obj->limit = KlHashInitialSize;
    }
    obj->table = (KlHashCell *) Calloc((size_t) obj->limit,
				       (size_t) sizeof(KlHashCell));
    obj->ref_counted = KlHashRefK | KlHashRefV;
    obj->curcell = 0;
    return obj;
}

KlHash
KlHashMake(list)
    KlList list;
{
    KlHash obj = KlHashAlloc(list->size);
    int i;

    for (i = 1; i < list->size; i += 2) {
	if (KlIsASymbol(list->list[i - 1])) {
	    KlHashPut(obj, list->list[i - 1], list->list[i]);
	} else {
	    KlHashPutEqual(obj, list->list[i - 1], list->list[i]);
	}
    }
    return obj;
}

/* KlHashRestore
 * called when existing violently from a KlDoHash
 */
KlO
KlHashRestore(table, i)
    KlHash table;
    int i;
{
    table->ref_counted &= ~KlHashFrozen; /* unfreeze */
    table->curcell = 0;
    return (KlO) table;
}

KlO
KlHashCopy(table)
    KlHash table;
{
    KlHash obj = KlHashAlloc(table->size);
    int i;

    KlHashFORBEGIN(table, cell) {
	KlHashPutEqual(obj, cell->key, cell->object);
    } KlHashFOREND;
    return (KlO) obj;
}

KlO
KlHashLength(table)
    KlHash table;
{
    return (KlO) KlNumberMake(table->size);
}

/*ARGSUSED*/
KlO
KlHashCoerceListToHash(ht, obj)
    KlType ht;
    KlO obj;
{

    return (KlO)  KlHashMake(obj);
}

/* KlHashFixSize
 * takes a desired size, and returns smallest optimal size
 */

int
KlHashFixSize(size)
    int size;
{
    int valid_size = KlHashInitialSize;

    while (valid_size < size)
	valid_size = (valid_size << 1) + 1;
    return valid_size;
}

/* KlHashFree
 */

KlO
KlHashFree(table)
    KlHash table;
{
    int i;
    KlHashCell old_cell, cell;

    for (i = 0; i < table->limit; i++) {
	if (table->table[i]) {
	    cell = table->table[i];
	    do {
		if (table->ref_counted & KlHashRefV)
		    KlDecRef(cell->object);
		if (table->ref_counted & KlHashRefK)
		    KlDecRef(cell->key);
		old_cell = cell;
		cell = cell->next;
		Free(old_cell);
	    } while (cell);
	}
    }
    Free(table->table);
    Free(table);
    return (KlO) table;
}

/* KlHashGrows
 * grows table by moving cells from table to table
 */

KlHashGrows(table)
    KlHash table;
{
    KlHashCell *slot, cell, *last_slot, newcell;
    KlHashCell *oldtable = table->table;
    int newslot;

    if (table->limit < 0) {
	KlError1(KlE_NO_MODIFY, table);
    }

    slot = table->table;
    last_slot = slot + table->limit;

    table->limit = KlHashFixSize(table->size);
    table->table = (KlHashCell *) Calloc((size_t) table->limit,
					 sizeof(KlHashCell));

    if (table->ref_counted & KlHashRefK) {
	while (slot < last_slot) {
	    if (*slot) {
		for (cell = *slot; cell; cell = newcell) {
		    newslot = KlHashFunc(table, KlSend_hash(cell->key));
		    newcell = cell->next;
		    cell->next = table->table[newslot];
		    table->table[newslot] = cell;
		}
	    }
	    slot++;
	}
    } else {
	while (slot < last_slot) {
	    if (*slot) {
		for (cell = *slot; cell; cell = newcell) {
		    newslot = KlHashFunc(table, KlHashFunc(table, cell->key));
		    newcell = cell->next;
		    cell->next = table->table[newslot];
		    table->table[newslot] = cell;
		}
	    }
	    slot++;
	}
    }

    Free(oldtable);
}

KlHashDohash(table, var, val, argc, argv)
    KlHash table;
    KlO var;
    KlO val;
    int argc;
    KlO *argv;
{
    KlGCMark();
    KlHashProtectedFORBEGIN(table, cell) {
	KlSend_setq(var, cell->key);
	KlSend_setq(val, cell->object);
	KlProgn(argc, argv);
	KlGC();
    } KlHashProtectedFOREND(table, cell);
}

/*****************************************************************************\
* 			 primitive fast routines (EQ)                         *
\*****************************************************************************/
/* these routines are fast ones working by EQ, to be used (from C) only
 * when dealing with symbols as keys
 */

/* KlHashPut
 */

KlO
KlHashPut(table, key, obj)
    KlHash table;
    KlO key;
    KlO obj;
{
    int slot = KlHashFunc(table, key);
    KlHashCell newcell, cell = table->table[slot];

    while (cell) {
	if (key == cell->key) {		/* update existing cell */
	    if (table->ref_counted & KlHashRefV) {
		KlDecRef(cell->object);
		KlIncRef(cell->object = obj);
	    } else {
		cell->object = obj;
	    }
	    return (KlO) table;
	}
	cell = cell->next;
    }

    /* add new cell */
    if (table->ref_counted & KlHashFrozen)
	KlError1(KlE_NO_MODIFY, table);

    KlHashCellCreate(newcell, obj, key, table->table[slot]);
    table->table[slot] = newcell;
    if (table->ref_counted & KlHashRefV)
	KlIncRef(obj);
    if (table->ref_counted & KlHashRefK)
	KlIncRef(key);

    if (table->size++ > table->limit)	/* realloc */
	KlHashGrows(table);
    return (KlO) table;
}

/* KlHashGet
 * primitive (from C) fast get with EQ semantics only
 */

KlO
KlHashGet(table, key, obj)
    KlHash table;
    KlO key;
    KlO obj;				/* default, can be 0 */
{
    KlHashCell cell = table->table[KlHashFunc(table, key)];

    while (cell) {
	if (key == cell->key) {		/* found */
	    return cell->object;
	}
	cell = cell->next;
    }
    /* not found, returns default */
    if (table->ref_counted & KlHashRefV)
	/* eval default only on klone values */
	return obj ? KlSend_eval(obj) : 0;
    else
	return obj;
}

/* KlHashDelete
 * returns TRU if success, NIL if wasn't there
 */

KlO
KlHashDelete(table, key)
    KlHash table;
    KlO key;
{
    KlHashCell *slot = table->table + KlHashFunc(table, key);
    KlHashCell cell = *slot;

    while (cell) {
	if (key == cell->key) {		/* found */
	    if (table->curcell && cell != table->curcell->cell)
		KlError1(KlE_NO_MODIFY, table);
	    if (table->ref_counted & KlHashRefV)
		KlDecRef(cell->object);
	    if (table->ref_counted & KlHashRefK)
		KlDecRef(cell->key);
	    *slot = cell->next;
	    Free(cell);
	    table->size--;
	    return (KlO) table;
	}
	slot = &((*slot)->next);
	cell = cell->next;
    }
    /* not found */
    return (KlO) table;
}

/******************************************** klone interface to EQ functions */

KlO
KlHashGetEQ(table, key, obj)
    KlHash table;
    KlO key;
    KlO obj;				/* default */
{
    KlMustBeHash(table, 0);
    return KlHashGet(table, key, obj);
}

KlO
KlHashPutEQ(table, key, obj)
    KlHash table;
    KlO key;
    KlO obj;
{
    KlMustBeHash(table, 0);
    return KlHashPut(table, key, obj);
}

KlO
KlHashDeleteEQ(table, key)
    KlHash table;
    KlO key;
{
    KlMustBeHash(table, 0);
    return KlHashDelete(table, key);
}

/*****************************************************************************\
* 			generic Klone routines (EQUAL)                         *
\*****************************************************************************/
/* this is the general way to use them. Only entry point from klone
 */
/* KlHashPutEqual
 */

KlO
KlHashPutEqual(table, key, obj)
    KlHash table;
    KlO key;
    KlO obj;
{
    int slot = KlHashFunc(table, KlSend_hash(key));
    KlHashCell newcell, cell = table->table[slot];

    while (cell) {
	if (KlSend_equal(key, cell->key) != NIL) { /* update existing cell */
	    if (table->ref_counted & KlHashRefV) {
		KlDecRef(cell->object);
		KlIncRef(cell->object = obj);
	    } else {
		cell->object = obj;
	    }
	    return (KlO) table;
	}
	cell = cell->next;
    }

    /* add new cell */
    if (table->ref_counted & KlHashFrozen)
	KlError1(KlE_NO_MODIFY, table);

    KlHashCellCreate(newcell, obj, key, table->table[slot]);
    table->table[slot] = newcell;
    if (table->ref_counted & KlHashRefV)
	KlIncRef(obj);
    if (table->ref_counted & KlHashRefK)
	KlIncRef(key);

    if (table->size++ > table->limit)	/* realloc */
	KlHashGrows(table);
    return (KlO) table;
}

/* KlHashGetEqual
 */

KlO
KlHashGetEqual(table, key, obj)
    KlHash table;
    KlO key;
    KlO obj;				/* default */
{
    KlHashCell cell = table->table[KlHashFunc(table, KlSend_hash(key))];

    while (cell) {
	if (KlSend_equal(key, cell->key) != NIL) {		/* found */
	    return cell->object;
	}
	cell = cell->next;
    }
    /* not found, returns default */
    if (table->ref_counted & KlHashRefV)
	return KlExecuteGetDefault(table, key, obj);	/* eval default only on klone values */
    else
	return obj;
}

/* KlHashDeleteEqual
 * returns TRU if success, NIL if wasn't there
 */

KlO
KlHashDeleteEqual(table, key)
    KlHash table;
    KlO key;
{
    KlHashCell *slot = table->table + KlHashFunc(table, KlSend_hash(key));
    KlHashCell cell = *slot;

    while (cell) {
	if (KlSend_equal(key, cell->key) != NIL) {		/* found */
	    if (table->curcell && cell != table->curcell->cell)
		KlError1(KlE_NO_MODIFY, table);
	    if (table->ref_counted & KlHashRefV)
		KlDecRef(cell->object);
	    if (table->ref_counted & KlHashRefK)
		KlDecRef(cell->key);
	    *slot = cell->next;
	    Free(cell);
	    table->size--;
	    return (KlO) table;
	}
	slot = &(cell->next);
	cell = cell->next;
    }
    /* not found */
    return (KlO) table;
}

/**************************************************************************\
* 				   Methods                                 *
\**************************************************************************/

KlO
KlHashEqual(h1, h2)
    KlHash h1;
    KlHash h2;
{
    KlO val;
    if (!(KlIsAHash(h2) && h2->size == h1->size))
	return NIL;
    KlHashFORBEGIN(h1, cell) {
	if ((val = KlHashGetEqual(h2, cell->key, 0)) == 0
	    || KlFalseP(KlSend_equal(cell->object, val))) {
	    return NIL;
	}
    } KlHashFOREND;
    return (KlO) h1;
}

KlO
KlHashHash(table)
    KlHash table;
{
    UInt result = 0;

    KlHashFORBEGIN(table, cell) {
	result += (UInt) KlSend_hash(cell->object);
    } KlHashFOREND;
    return (KlO) result;
}


/* KlHashLinks
 * used to set the "Refcount" hint of a hashtable
 * (hashtable-links table arg)
 * arg = () return links as a number
 *     key refcounted:   1
 *     value refcounted: 2
 *     both (default):   3
 */

KlO
KlHashLinks(ht, flags)
    KlHash ht;
    KlNumber flags;
{
    KlMustBeHash(ht, 0);
    if (KlTrueP(flags)) {		/* returns current hints */
	KlMustBeNumber(flags, 1);
	ht->ref_counted = (flags->number) & (KlHashRefK | KlHashRefV);
    }
    return (KlO) KlNumberMake(ht->ref_counted);
}    

/*****************************************************************************\
* 				  TYPE INIT                                   *
\*****************************************************************************/

KlHashInit()
{
    KlDeclareType(&KlStructuredType, "Structured", 0);
    KlDeclareSubType(&KlHashType, "Hashtable", KlStructuredType,
		     sizeof(struct _KlHash));
    KlDeclareTrait(KlHashType, KlTrait_table);

    KlDeclareMethod1(KlHashType, KlSelFree, KlHashFree);
    KlDeclareMethod1(KlHashType, KlSelEqual, KlHashEqual);
    KlDeclareMethod1(KlHashType, KlSelHash, KlHashHash);
    KlDeclareMethod1(KlHashType, KlSelGet, KlHashGetEqual);
    KlDeclareMethod1(KlHashType, KlSelPut, KlHashPutEqual);
    KlDeclareMethod1(KlHashType, KlSelDelete, KlHashDeleteEqual);
    KlDeclareMethod1(KlHashType, KlSelCopy, KlHashCopy);
    KlDeclareMethod1(KlHashType, KlSelLength, KlHashLength);
    KlDeclareMethod1(KlHashType, KlSelDohash, (KlMethod) KlHashDohash);

    KlDeclareSubr(KlHashLinks, "*:hashtable-links", 2);
    KlDeclareSubr(KlHashGetEQ, "hash-get-eq", 3);
    KlDeclareSubr(KlHashPutEQ, "hash-put-eq", 3);
    KlDeclareSubr(KlHashDeleteEQ, "hash-delete-eq", 2);

    /* built-in-tables to access klone objects by their names */
    

    KlDeclareAtom("Errors:Unrecoverable",
		  KlErrorUnRecoverableTable = KlHashAlloc(20));
    
}