Mercurial > hg > xemacs-beta
diff src/elhash.c @ 231:557eaa0339bf r20-5b14
Import from CVS: tag r20-5b14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:13:48 +0200 |
parents | 2c611d1463a6 |
children | f955c73f5258 |
line wrap: on
line diff
--- a/src/elhash.c Mon Aug 13 10:13:03 2007 +0200 +++ b/src/elhash.c Mon Aug 13 10:13:48 2007 +0200 @@ -50,9 +50,10 @@ static Lisp_Object mark_hashtable (Lisp_Object, void (*) (Lisp_Object)); static void print_hashtable (Lisp_Object, Lisp_Object, int); +static int hashtable_equal (Lisp_Object t1, Lisp_Object t2, int depth); DEFINE_LRECORD_IMPLEMENTATION ("hashtable", hashtable, - mark_hashtable, print_hashtable, 0, 0, 0, - struct hashtable); + mark_hashtable, print_hashtable, 0, + hashtable_equal, 0, struct hashtable); static Lisp_Object mark_hashtable (Lisp_Object obj, void (*markobj) (Lisp_Object)) @@ -72,6 +73,72 @@ return table->harray; } +/* Equality of hashtables. Two hashtables are equal when they are of + the same type and test function, they have the same number of + elements, and for each key in hashtable, the values are `equal'. + + This is similar to Common Lisp `equalp' of hashtables, with the + difference that CL requires the keys to be compared using the + `:test' function, which we don't do. Doing that would require + consing, and consing is bad idea in `equal'. Anyway, our method + should provide the same result -- if the keys are not equal + according to `:test', then Fgethash() in hashtable_equal_mapper() + will fail. */ +struct hashtable_equal_closure +{ + int depth; + int equal_so_far; + Lisp_Object other_table; +}; + +static void +hashtable_equal_mapper (void *key, void *contents, void *arg) +{ + struct hashtable_equal_closure *closure = + (struct hashtable_equal_closure *)arg; + Lisp_Object keytem, valuetem; + + /* It would be beautiful if maphash() allowed us to bail out when C + function returns non-zero, a la map_extents() et al. #### Make + it so! */ + if (closure->equal_so_far) + { + Lisp_Object value_in_other; + CVOID_TO_LISP (keytem, key); + CVOID_TO_LISP (valuetem, contents); + /* Look up the key in the other hashtable, and compare the + values. */ + value_in_other = Fgethash (keytem, closure->other_table, Qunbound); + if (UNBOUNDP (value_in_other) + || !internal_equal (valuetem, value_in_other, closure->depth)) + closure->equal_so_far = 0; + /* return 1; */ + } + /* return 0; */ +} + +static int +hashtable_equal (Lisp_Object t1, Lisp_Object t2, int depth) +{ + struct hashtable_equal_closure closure; + struct hashtable *table1 = XHASHTABLE (t1); + struct hashtable *table2 = XHASHTABLE (t2); + + /* The objects are `equal' if they are of the same type, so return 0 + if types or test functions are not the same. Obviously, the + number of elements must be equal, too. */ + if ((table1->test_function != table2->test_function) + || (table1->type != table2->type) + || (table1->fullness != table2->fullness)) + return 0; + + closure.depth = depth + 1; + closure.equal_so_far = 1; + closure.other_table = t2; + elisp_maphash (hashtable_equal_mapper, t1, &closure); + return closure.equal_so_far; +} + /* Printing hashtables. This is non-trivial, because we use a readable structure-style @@ -92,11 +159,12 @@ The data is truncated to four pairs, and the rest is shown with `...'. The actual printer is non-consing. */ -struct print_mapper_arg { - EMACS_INT count; /* Used to implement the truncation - for non-readable printing, as well - as to avoid the unnecessary space - at the beginning. */ +struct print_hashtable_data_closure +{ + EMACS_INT count; /* Used to implement truncation for + non-readable printing, as well as + to avoid the unnecessary space at + the beginning. */ Lisp_Object printcharfun; }; @@ -104,7 +172,8 @@ print_hashtable_data_mapper (void *key, void *contents, void *arg) { Lisp_Object keytem, valuetem; - struct print_mapper_arg *closure = (struct print_mapper_arg *)arg; + struct print_hashtable_data_closure *closure = + (struct print_hashtable_data_closure *)arg; if (closure->count < 4 || print_readably) { @@ -126,7 +195,7 @@ static void print_hashtable_data (Lisp_Object hashtable, Lisp_Object printcharfun) { - struct print_mapper_arg closure; + struct print_hashtable_data_closure closure; closure.count = 0; closure.printcharfun = printcharfun; @@ -163,13 +232,13 @@ else if (table->test_function == lisp_object_equal_equal) write_c_string (" test equal", printcharfun); else if (table->test_function == lisp_object_eql_equal) - ; + DO_NOTHING; else abort (); if (table->fullness || !print_readably) { if (print_readably) - sprintf (buf, " size %d", table->fullness); + sprintf (buf, " size %u", table->fullness); else sprintf (buf, " size %u/%ld", table->fullness, XVECTOR_LENGTH (table->harray) / LISP_OBJECTS_PER_HENTRY); @@ -559,7 +628,7 @@ if (EQ (sym, Qequal)) return HASHTABLE_EQUAL; if (EQ (sym, Qeql)) return HASHTABLE_EQL; - signal_simple_error ("Invalid hashtable test fun", sym); + signal_simple_error ("Invalid hashtable test function", sym); return HASHTABLE_EQ; /* not reached */ }