mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-18 15:22:03 -08:00
The methods in the hash tables now hide the ecl_hashtable_entry structures. This will allow implementing weak hash tables more easily.
This commit is contained in:
Juan Jose Garcia Ripoll
parent
cb66371cf2
commit
71114c9063
4 changed files with 145 additions and 65 deletions
173
src/c/hash.d
173
src/c/hash.d
|
|
@ -263,6 +263,10 @@ _hash_equalp(int depth, cl_hashkey h, cl_object x)
|
|||
}
|
||||
#endif
|
||||
|
||||
#ifdef ECL_WEAK_HASH
|
||||
#include "weak_hash.d"
|
||||
#endif
|
||||
|
||||
/*
|
||||
* EQ HASHTABLES
|
||||
*/
|
||||
|
|
@ -279,14 +283,30 @@ _ecl_hash_loop_eq(cl_hashkey h, cl_object key, cl_object hashtable)
|
|||
HASH_TABLE_LOOP(hkey, hvalue, h, key == hkey);
|
||||
}
|
||||
|
||||
struct ecl_hashtable_entry *
|
||||
_ecl_gethash_eq(cl_object key, cl_object hashtable)
|
||||
static cl_object
|
||||
_ecl_gethash_eq(cl_object key, cl_object hashtable, cl_object def)
|
||||
{
|
||||
cl_hashkey h = _hash_eq(key);
|
||||
return _ecl_hash_loop_eq(h, key, hashtable);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_eq(h, key, hashtable);
|
||||
return (e->key == OBJNULL)? def : e->value;
|
||||
}
|
||||
|
||||
cl_object
|
||||
static bool
|
||||
_ecl_remhash_eq(cl_object key, cl_object hashtable)
|
||||
{
|
||||
cl_hashkey h = _hash_eq(key);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_eq(h, key, hashtable);
|
||||
if (e->key == OBJNULL) {
|
||||
return 0;
|
||||
} else {
|
||||
e->key = OBJNULL;
|
||||
e->value = Cnil;
|
||||
hashtable->hash.entries--;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
static cl_object
|
||||
_ecl_sethash_eq(cl_object key, cl_object hashtable, cl_object value)
|
||||
{
|
||||
HASH_TABLE_SET(h, _ecl_hash_loop_eq, _hash_eq(key), key);
|
||||
|
|
@ -302,11 +322,12 @@ _ecl_hash_loop_eql(cl_hashkey h, cl_object key, cl_object hashtable)
|
|||
HASH_TABLE_LOOP(hkey, hvalue, h, ecl_eql(key, hkey));
|
||||
}
|
||||
|
||||
static struct ecl_hashtable_entry *
|
||||
_ecl_gethash_eql(cl_object key, cl_object hashtable)
|
||||
static cl_object
|
||||
_ecl_gethash_eql(cl_object key, cl_object hashtable, cl_object def)
|
||||
{
|
||||
cl_hashkey h = _hash_eql(0, key);
|
||||
return _ecl_hash_loop_eql(h, key, hashtable);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_eql(h, key, hashtable);
|
||||
return (e->key == OBJNULL)? def : e->value;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -315,6 +336,21 @@ _ecl_sethash_eql(cl_object key, cl_object hashtable, cl_object value)
|
|||
HASH_TABLE_SET(h, _ecl_hash_loop_eql, _hash_eql(0, key), key);
|
||||
}
|
||||
|
||||
static bool
|
||||
_ecl_remhash_eql(cl_object key, cl_object hashtable)
|
||||
{
|
||||
cl_hashkey h = _hash_eql(0, key);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_eql(h, key, hashtable);
|
||||
if (e->key == OBJNULL) {
|
||||
return 0;
|
||||
} else {
|
||||
e->key = OBJNULL;
|
||||
e->value = Cnil;
|
||||
hashtable->hash.entries--;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* EQUAL HASHTABLES
|
||||
*/
|
||||
|
|
@ -325,11 +361,12 @@ _ecl_hash_loop_equal(cl_hashkey h, cl_object key, cl_object hashtable)
|
|||
HASH_TABLE_LOOP(hkey, hvalue, h, ecl_equal(key, hkey));
|
||||
}
|
||||
|
||||
static struct ecl_hashtable_entry *
|
||||
_ecl_gethash_equal(cl_object key, cl_object hashtable)
|
||||
static cl_object
|
||||
_ecl_gethash_equal(cl_object key, cl_object hashtable, cl_object def)
|
||||
{
|
||||
cl_hashkey h = _hash_equal(3, 0, key);
|
||||
return _ecl_hash_loop_equal(h, key, hashtable);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_equal(h, key, hashtable);
|
||||
return (e->key == OBJNULL)? def : e->value;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -338,6 +375,21 @@ _ecl_sethash_equal(cl_object key, cl_object hashtable, cl_object value)
|
|||
HASH_TABLE_SET(h, _ecl_hash_loop_equal, _hash_equal(3, 0, key), key);
|
||||
}
|
||||
|
||||
static bool
|
||||
_ecl_remhash_equal(cl_object key, cl_object hashtable)
|
||||
{
|
||||
cl_hashkey h = _hash_equal(3, 0, key);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_equal(h, key, hashtable);
|
||||
if (e->key == OBJNULL) {
|
||||
return 0;
|
||||
} else {
|
||||
e->key = OBJNULL;
|
||||
e->value = Cnil;
|
||||
hashtable->hash.entries--;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* EQUALP HASHTABLES
|
||||
*/
|
||||
|
|
@ -348,11 +400,12 @@ _ecl_hash_loop_equalp(cl_hashkey h, cl_object key, cl_object hashtable)
|
|||
HASH_TABLE_LOOP(hkey, hvalue, h, ecl_equalp(key, hkey));
|
||||
}
|
||||
|
||||
static struct ecl_hashtable_entry *
|
||||
_ecl_gethash_equalp(cl_object key, cl_object hashtable)
|
||||
static cl_object
|
||||
_ecl_gethash_equalp(cl_object key, cl_object hashtable, cl_object def)
|
||||
{
|
||||
cl_hashkey h = _hash_equalp(3, 0, key);
|
||||
return _ecl_hash_loop_equalp(h, key, hashtable);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_equalp(h, key, hashtable);
|
||||
return (e->key == OBJNULL)? def : e->value;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -361,6 +414,21 @@ _ecl_sethash_equalp(cl_object key, cl_object hashtable, cl_object value)
|
|||
HASH_TABLE_SET(h, _ecl_hash_loop_equalp, _hash_equalp(3, 0, key), key);
|
||||
}
|
||||
|
||||
static bool
|
||||
_ecl_remhash_equalp(cl_object key, cl_object hashtable)
|
||||
{
|
||||
cl_hashkey h = _hash_equalp(3, 0, key);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_equalp(h, key, hashtable);
|
||||
if (e->key == OBJNULL) {
|
||||
return 0;
|
||||
} else {
|
||||
e->key = OBJNULL;
|
||||
e->value = Cnil;
|
||||
hashtable->hash.entries--;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* PACKAGE HASHTABLES
|
||||
*/
|
||||
|
|
@ -372,11 +440,12 @@ _ecl_hash_loop_pack(cl_hashkey h, cl_object key, cl_object hashtable)
|
|||
HASH_TABLE_LOOP(hkey, hvalue, h, (ho==hkey) && ecl_string_eq(key,SYMBOL_NAME(hvalue)));
|
||||
}
|
||||
|
||||
static struct ecl_hashtable_entry *
|
||||
_ecl_gethash_pack(cl_object key, cl_object hashtable)
|
||||
static cl_object
|
||||
_ecl_gethash_pack(cl_object key, cl_object hashtable, cl_object def)
|
||||
{
|
||||
cl_hashkey h = _hash_equal(3, 0, key);
|
||||
return _ecl_hash_loop_pack(h, key, hashtable);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_pack(h, key, hashtable);
|
||||
return (e->key == OBJNULL)? def : e->value;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -385,36 +454,37 @@ _ecl_sethash_pack(cl_object key, cl_object hashtable, cl_object value)
|
|||
HASH_TABLE_SET(h, _ecl_hash_loop_pack, _hash_equal(3, 0, key), MAKE_FIXNUM(h & 0xFFFFFFF));
|
||||
}
|
||||
|
||||
static bool
|
||||
_ecl_remhash_pack(cl_object key, cl_object hashtable)
|
||||
{
|
||||
cl_hashkey h = _hash_equal(3, 0, key);
|
||||
struct ecl_hashtable_entry *e = _ecl_hash_loop_pack(h, key, hashtable);
|
||||
if (e->key == OBJNULL) {
|
||||
return 0;
|
||||
} else {
|
||||
e->key = OBJNULL;
|
||||
e->value = Cnil;
|
||||
hashtable->hash.entries--;
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* HIGHER LEVEL INTERFACE
|
||||
*/
|
||||
|
||||
struct ecl_hashtable_entry *
|
||||
_ecl_gethash(cl_object key, cl_object hashtable)
|
||||
{
|
||||
return hashtable->hash.get(key, hashtable);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_gethash(cl_object key, cl_object hashtable)
|
||||
{
|
||||
cl_object output;
|
||||
|
||||
assert_type_hash_table(@[gethash], 2, hashtable);
|
||||
output = hashtable->hash.get(key, hashtable)->value;
|
||||
return output;
|
||||
return hashtable->hash.get(key, hashtable, OBJNULL);
|
||||
}
|
||||
|
||||
cl_object
|
||||
ecl_gethash_safe(cl_object key, cl_object hashtable, cl_object def)
|
||||
{
|
||||
struct ecl_hashtable_entry *e;
|
||||
|
||||
assert_type_hash_table(@[gethash], 2, hashtable);
|
||||
e = hashtable->hash.get(key, hashtable);
|
||||
if (e->key != OBJNULL)
|
||||
def = e->value;
|
||||
return def;
|
||||
return hashtable->hash.get(key, hashtable, def);
|
||||
}
|
||||
|
||||
cl_object
|
||||
|
|
@ -516,8 +586,9 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
|
|||
int htt;
|
||||
cl_index hsize;
|
||||
cl_object h;
|
||||
struct ecl_hashtable_entry *(*get)(cl_object, cl_object);
|
||||
cl_object (*get)(cl_object, cl_object, cl_object);
|
||||
cl_object (*set)(cl_object, cl_object, cl_object);
|
||||
bool (*rem)(cl_object, cl_object);
|
||||
/*
|
||||
* Argument checking
|
||||
*/
|
||||
|
|
@ -525,22 +596,27 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
|
|||
htt = htt_eq;
|
||||
get = _ecl_gethash_eq;
|
||||
set = _ecl_sethash_eq;
|
||||
rem = _ecl_remhash_eq;
|
||||
} else if (test == @'eql' || test == SYM_FUN(@'eql')) {
|
||||
htt = htt_eql;
|
||||
get = _ecl_gethash_eql;
|
||||
set = _ecl_sethash_eql;
|
||||
rem = _ecl_remhash_eql;
|
||||
} else if (test == @'equal' || test == SYM_FUN(@'equal')) {
|
||||
htt = htt_equal;
|
||||
get = _ecl_gethash_equal;
|
||||
set = _ecl_sethash_equal;
|
||||
rem = _ecl_remhash_equal;
|
||||
} else if (test == @'equalp' || test == SYM_FUN(@'equalp')) {
|
||||
htt = htt_equalp;
|
||||
get = _ecl_gethash_equalp;
|
||||
set = _ecl_sethash_equalp;
|
||||
rem = _ecl_remhash_equalp;
|
||||
} else if (test == @'package') {
|
||||
htt = htt_pack;
|
||||
get = _ecl_gethash_pack;
|
||||
set = _ecl_sethash_pack;
|
||||
rem = _ecl_remhash_pack;
|
||||
} else {
|
||||
FEerror("~S is an illegal hash-table test function.",
|
||||
1, test);
|
||||
|
|
@ -590,6 +666,7 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
|
|||
h->hash.test = htt;
|
||||
h->hash.get = get;
|
||||
h->hash.set = set;
|
||||
h->hash.rem = rem;
|
||||
h->hash.size = hsize;
|
||||
h->hash.entries = 0;
|
||||
h->hash.rehash_size = rehash_size;
|
||||
|
|
@ -611,14 +688,18 @@ cl_hash_table_p(cl_object ht)
|
|||
}
|
||||
|
||||
@(defun gethash (key ht &optional (no_value Cnil))
|
||||
struct ecl_hashtable_entry e;
|
||||
@
|
||||
{
|
||||
assert_type_hash_table(@[gethash], 2, ht);
|
||||
e = *(ht->hash.get(key, ht));
|
||||
if (e.key != OBJNULL)
|
||||
@(return e.value Ct)
|
||||
else
|
||||
@(return no_value Cnil)
|
||||
{
|
||||
cl_object v = ht->hash.get(key, ht, OBJNULL);
|
||||
if (v != OBJNULL) {
|
||||
@(return v Ct);
|
||||
} else {
|
||||
@(return no_value Cnil);
|
||||
}
|
||||
}
|
||||
}
|
||||
@)
|
||||
|
||||
cl_object
|
||||
|
|
@ -632,20 +713,8 @@ si_hash_set(cl_object key, cl_object ht, cl_object val)
|
|||
bool
|
||||
ecl_remhash(cl_object key, cl_object hashtable)
|
||||
{
|
||||
struct ecl_hashtable_entry *e;
|
||||
bool output;
|
||||
|
||||
assert_type_hash_table(@[remhash], 2, hashtable);
|
||||
e = hashtable->hash.get(key, hashtable);
|
||||
if (e->key == OBJNULL) {
|
||||
output = FALSE;
|
||||
} else {
|
||||
e->key = OBJNULL;
|
||||
e->value = Cnil;
|
||||
hashtable->hash.entries--;
|
||||
output = TRUE;
|
||||
}
|
||||
return output;
|
||||
return hashtable->hash.rem(key, hashtable);
|
||||
}
|
||||
|
||||
cl_object
|
||||
|
|
|
|||
|
|
@ -495,21 +495,25 @@ BEGIN:
|
|||
case t_pathname:
|
||||
return (tx == ty) && ecl_equal(x, y);
|
||||
case t_hashtable: {
|
||||
cl_index i;
|
||||
struct ecl_hashtable_entry *ex, *ey;
|
||||
if (tx != ty ||
|
||||
x->hash.entries != y->hash.entries ||
|
||||
x->hash.test != y->hash.test)
|
||||
return(FALSE);
|
||||
ex = x->hash.data;
|
||||
for (i = 0; i < x->hash.size; i++) {
|
||||
if (ex[i].key != OBJNULL) {
|
||||
ey = _ecl_gethash(ex[i].key, y);
|
||||
if (ey->key == OBJNULL || !ecl_equalp(ex[i].value, ey->value))
|
||||
return(FALSE);
|
||||
}
|
||||
{
|
||||
cl_env_ptr env = ecl_process_env();
|
||||
cl_object iterator = si_hash_table_iterator(x);
|
||||
do {
|
||||
cl_object ndx = cl_funcall(1, iterator);
|
||||
if (Null(ndx)) {
|
||||
return TRUE;
|
||||
} else {
|
||||
cl_object key = env->values[1];
|
||||
cl_object value = env->values[2];
|
||||
if (ecl_gethash_safe(key, y, OBJNULL) == OBJNULL)
|
||||
return FALSE;
|
||||
}
|
||||
} while (1);
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
case t_random:
|
||||
return (tx == ty) && ecl_equalp(x->random.value, y->random.value);
|
||||
|
|
|
|||
|
|
@ -809,7 +809,6 @@ extern ECL_API cl_object ecl_sethash(cl_object key, cl_object hashtable, cl_obje
|
|||
extern ECL_API cl_object ecl_gethash(cl_object key, cl_object hash);
|
||||
extern ECL_API cl_object ecl_gethash_safe(cl_object key, cl_object hash, cl_object def);
|
||||
extern ECL_API bool ecl_remhash(cl_object key, cl_object hash);
|
||||
extern ECL_API struct ecl_hashtable_entry *_ecl_gethash(cl_object key, cl_object hashtable);
|
||||
extern ECL_API cl_object _ecl_sethash(cl_object key, cl_object hashtable, cl_object value);
|
||||
|
||||
/* instance.c */
|
||||
|
|
|
|||
|
|
@ -366,13 +366,20 @@ enum ecl_httest { /* hash table key test function */
|
|||
htt_pack /* symbol hash */
|
||||
};
|
||||
|
||||
enum ecl_htweak {
|
||||
htt_not_weak = 0,
|
||||
htt_weak_key,
|
||||
htt_weak_value,
|
||||
htt_weak_key_and_value
|
||||
};
|
||||
|
||||
struct ecl_hashtable_entry { /* hash table entry */
|
||||
cl_object key; /* key */
|
||||
cl_object value; /* value */
|
||||
};
|
||||
|
||||
struct ecl_hashtable { /* hash table header */
|
||||
HEADER1(test);
|
||||
HEADER2(test,weak);
|
||||
struct ecl_hashtable_entry *data; /* pointer to the hash table */
|
||||
cl_index entries; /* number of entries */
|
||||
cl_index size; /* hash table size */
|
||||
|
|
@ -380,8 +387,9 @@ struct ecl_hashtable { /* hash table header */
|
|||
cl_object rehash_size; /* rehash size */
|
||||
cl_object threshold; /* rehash threshold */
|
||||
double factor; /* cached value of threshold */
|
||||
struct ecl_hashtable_entry *(*get)(cl_object, cl_object);
|
||||
cl_object (*get)(cl_object, cl_object, cl_object);
|
||||
cl_object (*set)(cl_object, cl_object, cl_object);
|
||||
bool (*rem)(cl_object, cl_object);
|
||||
};
|
||||
|
||||
typedef enum { /* array element type */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue