Mercurial > hg > xemacs-beta
diff src/elhash.c @ 5125:b5df3737028a ben-lisp-object
merge
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Wed, 24 Feb 2010 01:58:04 -0600 |
parents | 623d57b7fbe8 16112448d484 |
children | a9c41067dd88 |
line wrap: on
line diff
--- a/src/elhash.c Wed Jan 20 07:05:57 2010 -0600 +++ b/src/elhash.c Wed Feb 24 01:58:04 2010 -0600 @@ -92,7 +92,7 @@ /* obsolete as of 19990901 in xemacs-21.2 */ static Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qkey_or_value_weak; -static Lisp_Object Qnon_weak, Q_type; +static Lisp_Object Qnon_weak, Q_type, Q_data; struct Lisp_Hash_Table { @@ -184,36 +184,18 @@ } -#if 0 /* I don't think these are needed any more. - If using the general lisp_object_equal_*() functions - causes efficiency problems, these can be resurrected. --ben */ -/* equality and hash functions for Lisp strings */ -int -lisp_string_equal (Lisp_Object str1, Lisp_Object str2) -{ - /* This is wrong anyway. You can't use strcmp() on Lisp strings, - because they can contain zero characters. */ - return !strcmp ((char *) XSTRING_DATA (str1), (char *) XSTRING_DATA (str2)); -} - -static Hashcode -lisp_string_hash (Lisp_Object obj) -{ - return hash_string (XSTRING_DATA (str), XSTRING_LENGTH (str)); -} - -#endif /* 0 */ static int lisp_object_eql_equal (Lisp_Object obj1, Lisp_Object obj2) { - return EQ (obj1, obj2) || (FLOATP (obj1) && internal_equal (obj1, obj2, 0)); + return EQ (obj1, obj2) || + (NON_FIXNUM_NUMBER_P (obj1) && internal_equal (obj1, obj2, 0)); } static Hashcode lisp_object_eql_hash (Lisp_Object obj) { - return FLOATP (obj) ? internal_hash (obj, 0) : LISP_HASH (obj); + return NON_FIXNUM_NUMBER_P (obj) ? internal_hash (obj, 0) : LISP_HASH (obj); } static int @@ -262,7 +244,8 @@ the same result -- if the keys are not equal according to the test function, then Fgethash() in hash_table_equal_mapper() will fail. */ static int -hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth) +hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth, + int foldcase) { Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1); Lisp_Hash_Table *ht2 = XHASH_TABLE (hash_table2); @@ -281,7 +264,7 @@ { Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound); if (UNBOUNDP (value_in_other) || - !internal_equal (e->value, value_in_other, depth)) + !internal_equal_0 (e->value, value_in_other, depth, foldcase)) return 0; /* Give up */ } @@ -304,15 +287,15 @@ syntax for hash tables. This means that a typical hash table will be readably printed in the form of: - #s(hash-table size 2 data (key1 value1 key2 value2)) + #s(hash-table :size 2 :data (key1 value1 key2 value2)) The supported hash table structure keywords and their values are: - `test' (eql (or nil), eq or equal) - `size' (a natnum or nil) - `rehash-size' (a float) - `rehash-threshold' (a float) - `weakness' (nil, key, value, key-and-value, or key-or-value) - `data' (a list) + `:test' (eql (or nil), eq or equal) + `:size' (a natnum or nil) + `:rehash-size' (a float) + `:rehash-threshold' (a float) + `:weakness' (nil, key, value, key-and-value, or key-or-value) + `:data' (a list) If `print-readably' is nil, then a simpler syntax is used, for example @@ -330,16 +313,16 @@ int count = 0; htentry *e, *sentinel; - write_c_string (printcharfun, " data ("); + write_ascstring (printcharfun, " :data ("); for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) if (!HTENTRY_CLEAR_P (e)) { if (count > 0) - write_c_string (printcharfun, " "); + write_ascstring (printcharfun, " "); if (!print_readably && count > 3) { - write_c_string (printcharfun, "..."); + write_ascstring (printcharfun, "..."); break; } print_internal (e->key, printcharfun, 1); @@ -347,7 +330,7 @@ count++; } - write_c_string (printcharfun, ")"); + write_ascstring (printcharfun, ")"); } static void @@ -357,16 +340,16 @@ Lisp_Hash_Table *ht = XHASH_TABLE (obj); Ascbyte pigbuf[350]; - write_c_string (printcharfun, + write_ascstring (printcharfun, print_readably ? "#s(hash-table" : "#<hash-table"); /* These checks have a kludgy look to them, but they are safe. Due to nature of hashing, you cannot use arbitrary test functions anyway. */ if (!ht->test_function) - write_c_string (printcharfun, " test eq"); + write_ascstring (printcharfun, " :test eq"); else if (ht->test_function == lisp_object_equal_equal) - write_c_string (printcharfun, " test equal"); + write_ascstring (printcharfun, " :test equal"); else if (ht->test_function == lisp_object_eql_equal) DO_NOTHING; else @@ -375,16 +358,16 @@ if (ht->count || !print_readably) { if (print_readably) - write_fmt_string (printcharfun, " size %ld", (long) ht->count); + write_fmt_string (printcharfun, " :size %ld", (long) ht->count); else - write_fmt_string (printcharfun, " size %ld/%ld", (long) ht->count, + write_fmt_string (printcharfun, " :size %ld/%ld", (long) ht->count, (long) ht->size); } if (ht->weakness != HASH_TABLE_NON_WEAK) { write_fmt_string - (printcharfun, " weakness %s", + (printcharfun, " :weakness %s", (ht->weakness == HASH_TABLE_WEAK ? "key-and-value" : ht->weakness == HASH_TABLE_KEY_WEAK ? "key" : ht->weakness == HASH_TABLE_VALUE_WEAK ? "value" : @@ -395,7 +378,7 @@ if (ht->rehash_size != HASH_TABLE_DEFAULT_REHASH_SIZE) { float_to_string (pigbuf, ht->rehash_size); - write_fmt_string (printcharfun, " rehash-size %s", pigbuf); + write_fmt_string (printcharfun, " :rehash-size %s", pigbuf); } if (ht->rehash_threshold @@ -403,14 +386,14 @@ ht->test_function)) { float_to_string (pigbuf, ht->rehash_threshold); - write_fmt_string (printcharfun, " rehash-threshold %s", pigbuf); + write_fmt_string (printcharfun, " :rehash-threshold %s", pigbuf); } if (ht->count) print_hash_table_data (ht, printcharfun); if (print_readably) - write_c_string (printcharfun, ")"); + write_ascstring (printcharfun, ")"); else write_fmt_string (printcharfun, " 0x%x>", ht->header.uid); } @@ -434,7 +417,7 @@ #endif if (!DUMPEDP (hentries)) - xfree (hentries, htentry *); + xfree (hentries); } static void @@ -841,17 +824,40 @@ Lisp_Object weakness = Qnil; Lisp_Object data = Qnil; - PROPERTY_LIST_LOOP_3 (key, value, plist) + if (KEYWORDP (Fcar (plist))) { - if (EQ (key, Qtest)) test = value; - else if (EQ (key, Qsize)) size = value; - else if (EQ (key, Qrehash_size)) rehash_size = value; - else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; - else if (EQ (key, Qweakness)) weakness = value; - else if (EQ (key, Qdata)) data = value; - else if (EQ (key, Qtype))/*obsolete*/ weakness = value; - else - ABORT (); + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Q_test)) test = value; + else if (EQ (key, Q_size)) size = value; + else if (EQ (key, Q_rehash_size)) rehash_size = value; + else if (EQ (key, Q_rehash_threshold)) rehash_threshold = value; + else if (EQ (key, Q_weakness)) weakness = value; + else if (EQ (key, Q_data)) data = value; + else if (!KEYWORDP (key)) + signal_error (Qinvalid_read_syntax, + "can't mix keyword and non-keyword hash table syntax", + key); + else ABORT(); + } + } + else + { + PROPERTY_LIST_LOOP_3 (key, value, plist) + { + if (EQ (key, Qtest)) test = value; + else if (EQ (key, Qsize)) size = value; + else if (EQ (key, Qrehash_size)) rehash_size = value; + else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; + else if (EQ (key, Qweakness)) weakness = value; + else if (EQ (key, Qdata)) data = value; + else if (EQ (key, Qtype))/*obsolete*/ weakness = value; + else if (KEYWORDP (key)) + signal_error (Qinvalid_read_syntax, + "can't mix keyword and non-keyword hash table syntax", + key); + else ABORT(); + } } /* Create the hash table. */ @@ -887,6 +893,16 @@ struct structure_type *st; st = define_structure_type (structure_name, 0, hash_table_instantiate); + + /* First the keyword syntax: */ + define_structure_type_keyword (st, Q_test, hash_table_test_validate); + define_structure_type_keyword (st, Q_size, hash_table_size_validate); + define_structure_type_keyword (st, Q_rehash_size, hash_table_rehash_size_validate); + define_structure_type_keyword (st, Q_rehash_threshold, hash_table_rehash_threshold_validate); + define_structure_type_keyword (st, Q_weakness, hash_table_weakness_validate); + define_structure_type_keyword (st, Q_data, hash_table_data_validate); + + /* Next the mutually exclusive, older, non-keyword syntax: */ define_structure_type_keyword (st, Qtest, hash_table_test_validate); define_structure_type_keyword (st, Qsize, hash_table_size_validate); define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate); @@ -1092,7 +1108,7 @@ memcpy (ht->hentries, new_entries, ht->size * sizeof (htentry)); #ifndef NEW_GC - xfree (new_entries, htentry *); + xfree (new_entries); #endif /* not NEW_GC */ } @@ -1387,7 +1403,7 @@ maphash_unwind (Lisp_Object unwind_obj) { void *ptr = (void *) get_opaque_ptr (unwind_obj); - xfree (ptr, void *); + xfree (ptr); free_opaque_ptr (unwind_obj); return Qnil; } @@ -1831,6 +1847,7 @@ DEFSYMBOL (Qvalue_weak); /* obsolete */ DEFSYMBOL (Qnon_weak); /* obsolete */ + DEFKEYWORD (Q_data); DEFKEYWORD (Q_test); DEFKEYWORD (Q_size); DEFKEYWORD (Q_rehash_size);