/* Copyright 1995-1996,1998-2001,2003-2004,2006,2008-2013,2018,2025 Free Software Foundation, Inc. This file is part of Guile. Guile is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Guile is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with Guile. If not, see . */ #ifdef HAVE_CONFIG_H # include #endif #include #include #include #include "alist.h" #include "boolean.h" #include "deprecation.h" #include "eq.h" #include "eval.h" #include "gsubr.h" #include "hash.h" #include "list.h" #include "modules.h" #include "numbers.h" #include "pairs.h" #include "ports.h" #include "procs.h" #include "threads.h" #include "variable.h" #include "vectors.h" #include "hashtab.h" #if (SCM_ENABLE_DEPRECATED == 1) /* In versions 3.0 and prior, the hash table interface could also access weak tables. This is now deprecated. */ static SCM make_weak_key_hash_table_var; static SCM weak_key_hash_table_p_var; static SCM weak_key_hash_table_ref_var; static SCM weak_key_hash_table_set_x_var; static SCM weak_key_hash_table_remove_x_var; static SCM weak_key_hash_table_clear_x_var; static SCM weak_key_hash_table_fold_var; static SCM weak_key_hash_table_for_each_var; static SCM weak_key_hash_table_map_to_list_var; static SCM make_weak_value_hash_table_var; static SCM weak_value_hash_table_p_var; static SCM weak_value_hash_table_ref_var; static SCM weak_value_hash_table_set_x_var; static SCM weak_value_hash_table_remove_x_var; static SCM weak_value_hash_table_clear_x_var; static SCM weak_value_hash_table_fold_var; static SCM weak_value_hash_table_for_each_var; static SCM weak_value_hash_table_map_to_list_var; static SCM make_doubly_weak_hash_table_var; static SCM doubly_weak_hash_table_p_var; static SCM doubly_weak_hash_table_ref_var; static SCM doubly_weak_hash_table_set_x_var; static SCM doubly_weak_hash_table_remove_x_var; static SCM doubly_weak_hash_table_clear_x_var; static SCM doubly_weak_hash_table_fold_var; static SCM doubly_weak_hash_table_for_each_var; static SCM doubly_weak_hash_table_map_to_list_var; static void init_weak_hash_table_constructor_vars (void) { make_weak_key_hash_table_var = scm_c_public_lookup ("ice-9 weak-tables", "make-weak-key-hash-table"); make_weak_value_hash_table_var = scm_c_public_lookup ("ice-9 weak-tables", "make-weak-value-hash-table"); make_doubly_weak_hash_table_var = scm_c_public_lookup ("ice-9 weak-tables", "make-doubly-weak-hash-table"); } static void init_weak_hash_table_predicate_vars (void) { weak_key_hash_table_p_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table?"); weak_value_hash_table_p_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table?"); doubly_weak_hash_table_p_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table?"); } static void init_weak_hash_table_accessor_vars (void) { weak_key_hash_table_ref_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table-ref"); weak_key_hash_table_set_x_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table-set!"); weak_key_hash_table_remove_x_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table-remove!"); weak_key_hash_table_clear_x_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table-clear!"); weak_value_hash_table_ref_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table-ref"); weak_value_hash_table_set_x_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table-set!"); weak_value_hash_table_remove_x_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table-remove!"); weak_value_hash_table_clear_x_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table-clear!"); doubly_weak_hash_table_ref_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table-ref"); doubly_weak_hash_table_set_x_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table-set!"); doubly_weak_hash_table_remove_x_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table-remove!"); doubly_weak_hash_table_clear_x_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table-clear!"); } static void init_weak_hash_table_iteration_vars (void) { weak_key_hash_table_fold_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table-fold"); weak_key_hash_table_for_each_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table-for-each"); weak_key_hash_table_map_to_list_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-key-hash-table-map->list"); weak_value_hash_table_fold_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table-fold"); weak_value_hash_table_for_each_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table-for-each"); weak_value_hash_table_map_to_list_var = scm_c_public_lookup ("ice-9 weak-tables", "weak-value-hash-table-map->list"); doubly_weak_hash_table_fold_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table-fold"); doubly_weak_hash_table_for_each_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table-for-each"); doubly_weak_hash_table_map_to_list_var = scm_c_public_lookup ("ice-9 weak-tables", "doubly-weak-hash-table-map->list"); } static void init_weak_table_constructors (void) { static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; scm_c_issue_deprecation_warning ("Creating weak hash tables from C is deprecated. Invoke " "make-weak-key-hash-table, etc. from (ice-9 weak-tables) instead."); scm_i_pthread_once (&once, init_weak_hash_table_constructor_vars); } static void init_weak_table_predicates (void) { static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; scm_i_pthread_once (&once, init_weak_hash_table_predicate_vars); } static void init_weak_table_accessors (void) { static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; scm_c_issue_deprecation_warning ("Accessing weak hash tables via hashq-ref, hashq-set!, and so on is " "deprecated. Invoke the weak-table-specific procedures from (ice-9 " "weak-tables) instead."); scm_i_pthread_once (&once, init_weak_hash_table_accessor_vars); } static void init_weak_table_iterators (void) { static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; scm_c_issue_deprecation_warning ("Iterating weak hash tables via hash-fold, hash-for-each, and so on is " "deprecated. Invoke the weak-table-specific procedures from (ice-9 " "weak-tables) instead."); scm_i_pthread_once (&once, init_weak_hash_table_iteration_vars); } static int is_weak_key_hash_table (SCM x) { init_weak_table_predicates (); return scm_is_true (scm_call_1 (scm_variable_ref (weak_key_hash_table_p_var), x)); } static int is_weak_value_hash_table (SCM x) { init_weak_table_predicates (); return scm_is_true (scm_call_1 (scm_variable_ref (weak_value_hash_table_p_var), x)); } static int is_doubly_weak_hash_table (SCM x) { init_weak_table_predicates (); return scm_is_true (scm_call_1 (scm_variable_ref (doubly_weak_hash_table_p_var), x)); } static SCM weak_key_hash_table_ref (SCM table, SCM key, SCM dflt) { init_weak_table_accessors (); // FIXME: #:default-value SCM ret = scm_call_2 (scm_variable_ref (weak_key_hash_table_ref_var), table, key); return scm_is_false (ret) ? dflt : ret; } static SCM weak_key_hash_table_set_x (SCM table, SCM key, SCM value) { init_weak_table_accessors (); scm_call_3 (scm_variable_ref (weak_key_hash_table_set_x_var), table, key, value); return value; } static SCM weak_key_hash_table_remove_x (SCM table, SCM key) { init_weak_table_accessors (); scm_call_2 (scm_variable_ref (weak_key_hash_table_remove_x_var), table, key); return SCM_BOOL_F; } static SCM weak_key_hash_table_clear_x (SCM table) { init_weak_table_accessors (); scm_call_1 (scm_variable_ref (weak_key_hash_table_clear_x_var), table); return SCM_UNSPECIFIED; } static SCM weak_key_hash_table_fold (SCM proc, SCM init, SCM table) { init_weak_table_iterators (); return scm_call_3 (scm_variable_ref (weak_key_hash_table_fold_var), proc, init, table); } static SCM weak_key_hash_table_for_each (SCM proc, SCM table) { init_weak_table_iterators (); scm_call_2 (scm_variable_ref (weak_key_hash_table_for_each_var), proc, table); return SCM_UNSPECIFIED; } static SCM weak_key_hash_table_map_to_list (SCM proc, SCM table) { init_weak_table_iterators (); return scm_call_2 (scm_variable_ref (weak_key_hash_table_map_to_list_var), proc, table); } static SCM weak_value_hash_table_ref (SCM table, SCM key, SCM dflt) { init_weak_table_accessors (); // FIXME: #:default-value SCM ret = scm_call_2 (scm_variable_ref (weak_value_hash_table_ref_var), table, key); return scm_is_false (ret) ? dflt : ret; } static SCM weak_value_hash_table_set_x (SCM table, SCM key, SCM value) { init_weak_table_accessors (); scm_call_3 (scm_variable_ref (weak_value_hash_table_set_x_var), table, key, value); return value; } static SCM weak_value_hash_table_remove_x (SCM table, SCM key) { init_weak_table_accessors (); scm_call_2 (scm_variable_ref (weak_value_hash_table_remove_x_var), table, key); return SCM_BOOL_F; } static SCM weak_value_hash_table_clear_x (SCM table) { init_weak_table_accessors (); scm_call_1 (scm_variable_ref (weak_value_hash_table_clear_x_var), table); return SCM_UNSPECIFIED; } static SCM weak_value_hash_table_fold (SCM proc, SCM init, SCM table) { init_weak_table_iterators (); return scm_call_3 (scm_variable_ref (weak_value_hash_table_fold_var), proc, init, table); } static SCM weak_value_hash_table_for_each (SCM proc, SCM table) { init_weak_table_iterators (); scm_call_2 (scm_variable_ref (weak_value_hash_table_for_each_var), proc, table); return SCM_UNSPECIFIED; } static SCM weak_value_hash_table_map_to_list (SCM proc, SCM table) { init_weak_table_iterators (); return scm_call_2 (scm_variable_ref (weak_value_hash_table_map_to_list_var), proc, table); } static SCM doubly_weak_hash_table_ref (SCM table, SCM key, SCM dflt) { init_weak_table_accessors (); // FIXME: #:default-value SCM ret = scm_call_2 (scm_variable_ref (doubly_weak_hash_table_ref_var), table, key); return scm_is_false (ret) ? dflt : ret; } static SCM doubly_weak_hash_table_set_x (SCM table, SCM key, SCM value) { init_weak_table_accessors (); scm_call_3 (scm_variable_ref (doubly_weak_hash_table_set_x_var), table, key, value); return value; } static SCM doubly_weak_hash_table_remove_x (SCM table, SCM key) { init_weak_table_accessors (); scm_call_2 (scm_variable_ref (doubly_weak_hash_table_remove_x_var), table, key); return SCM_BOOL_F; } static SCM doubly_weak_hash_table_clear_x (SCM table) { init_weak_table_accessors (); scm_call_1 (scm_variable_ref (doubly_weak_hash_table_clear_x_var), table); return SCM_UNSPECIFIED; } static SCM doubly_weak_hash_table_fold (SCM proc, SCM init, SCM table) { init_weak_table_iterators (); return scm_call_3 (scm_variable_ref (doubly_weak_hash_table_fold_var), proc, init, table); } static SCM doubly_weak_hash_table_for_each (SCM proc, SCM table) { init_weak_table_iterators (); scm_call_2 (scm_variable_ref (doubly_weak_hash_table_for_each_var), proc, table); return SCM_UNSPECIFIED; } static SCM doubly_weak_hash_table_map_to_list (SCM proc, SCM table) { init_weak_table_iterators (); return scm_call_2 (scm_variable_ref (doubly_weak_hash_table_map_to_list_var), proc, table); } SCM scm_make_weak_key_hash_table (SCM unused) { init_weak_table_constructors (); return scm_call_0 (scm_variable_ref (make_weak_key_hash_table_var)); } SCM scm_make_weak_value_hash_table (SCM unused) { init_weak_table_constructors (); return scm_call_0 (scm_variable_ref (make_weak_value_hash_table_var)); } SCM scm_make_doubly_weak_hash_table (SCM unused) { init_weak_table_constructors (); return scm_call_0 (scm_variable_ref (make_doubly_weak_hash_table_var)); } SCM scm_weak_key_hash_table_p (SCM x) { init_weak_table_predicates (); scm_c_issue_deprecation_warning ("scm_weak_key_hash_table_p is deprecated. Use weak-key-hash-table? " "from (ice-9 weak-tables) instead."); return scm_from_bool (is_weak_key_hash_table (x)); } SCM scm_weak_value_hash_table_p (SCM x) { init_weak_table_predicates (); scm_c_issue_deprecation_warning ("scm_weak_value_hash_table_p is deprecated. Use weak-value-hash-table? " "from (ice-9 weak-tables) instead."); return scm_from_bool (is_weak_value_hash_table (x)); } SCM scm_doubly_weak_hash_table_p (SCM x) { init_weak_table_predicates (); scm_c_issue_deprecation_warning ("scm_doubly_weak_hash_table_p is deprecated. Use doubly-weak-hash-table? " "from (ice-9 weak-tables) instead."); return scm_from_bool (is_doubly_weak_hash_table (x)); } #endif // SCM_ENABLE_DEPRECATED == 1 /* A hash table is a cell containing a vector of association lists. * * Growing or shrinking, with following rehashing, is triggered when * the load factor * * L = N / S (N: number of items in table, S: bucket vector length) * * passes an upper limit of 0.9 or a lower limit of 0.25. * * The implementation stores the upper and lower number of items which * trigger a resize in the hashtable object. * * Possible hash table sizes (primes) are stored in the array * hashtable_size. */ static unsigned long hashtable_size[] = { 31, 61, 113, 223, 443, 883, 1759, 3517, 7027, 14051, 28099, 56197, 112363, 224717, 449419, 898823, 1797641, 3595271, 7190537, 14381041 #if SIZEOF_UINTPTR_T > 4 /* vector lengths are stored in the first word of vectors, shifted by 8 bits for the tc8, so for 32-bit we only get 2^24-1 = 16777215 elements. But we allow a few more sizes for 64-bit. */ , 28762081, 57524111, 115048217, 230096423, 460192829 #endif }; #define HASHTABLE_SIZE_N (sizeof(hashtable_size)/sizeof(unsigned long)) static char *s_hashtable = "hashtable"; static SCM make_hash_table (unsigned long k, const char *func_name) { SCM vector; scm_t_hashtable *t; int i = 0, n = k ? k : 31; while (i + 1 < HASHTABLE_SIZE_N && n > hashtable_size[i]) ++i; n = hashtable_size[i]; vector = scm_c_make_vector (n, SCM_EOL); t = scm_gc_malloc_pointerless (sizeof (*t), s_hashtable); t->min_size_index = t->size_index = i; t->n_items = 0; t->lower = 0; t->upper = 9 * n / 10; /* FIXME: we just need two words of storage, not three */ return scm_double_cell (scm_tc7_hashtable, SCM_UNPACK (vector), (scm_t_bits)t, 0); } void scm_i_rehash (SCM table, scm_t_hash_fn hash_fn, void *closure, const char* func_name) { SCM buckets, new_buckets; int i; unsigned long old_size; unsigned long new_size; if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)) { /* rehashing is not triggered when i <= min_size */ i = SCM_HASHTABLE (table)->size_index; do --i; while (i > SCM_HASHTABLE (table)->min_size_index && SCM_HASHTABLE_N_ITEMS (table) < hashtable_size[i] / 4); } else { i = SCM_HASHTABLE (table)->size_index + 1; if (i >= HASHTABLE_SIZE_N) /* don't rehash */ return; } SCM_HASHTABLE (table)->size_index = i; new_size = hashtable_size[i]; if (i <= SCM_HASHTABLE (table)->min_size_index) SCM_HASHTABLE (table)->lower = 0; else SCM_HASHTABLE (table)->lower = new_size / 4; SCM_HASHTABLE (table)->upper = 9 * new_size / 10; buckets = SCM_HASHTABLE_VECTOR (table); new_buckets = scm_c_make_vector (new_size, SCM_EOL); SCM_SET_HASHTABLE_VECTOR (table, new_buckets); SCM_SET_HASHTABLE_N_ITEMS (table, 0); old_size = SCM_SIMPLE_VECTOR_LENGTH (buckets); for (i = 0; i < old_size; ++i) { SCM ls, cell, handle; ls = SCM_SIMPLE_VECTOR_REF (buckets, i); SCM_SIMPLE_VECTOR_SET (buckets, i, SCM_EOL); while (scm_is_pair (ls)) { unsigned long h; cell = ls; handle = SCM_CAR (cell); ls = SCM_CDR (ls); h = hash_fn (SCM_CAR (handle), new_size, closure); if (h >= new_size) scm_out_of_range (func_name, scm_from_ulong (h)); SCM_SETCDR (cell, SCM_SIMPLE_VECTOR_REF (new_buckets, h)); SCM_SIMPLE_VECTOR_SET (new_buckets, h, cell); SCM_HASHTABLE_INCREMENT (table); } } } void scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate) { scm_puts ("#", port); } SCM scm_c_make_hash_table (unsigned long k) { return make_hash_table (k, "scm_c_make_hash_table"); } SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1, 0, (SCM n), "Make a new abstract hash table object with minimum number of buckets @var{n}\n") #define FUNC_NAME s_scm_make_hash_table { return make_hash_table (SCM_UNBNDP (n) ? 0 : scm_to_ulong (n), FUNC_NAME); } #undef FUNC_NAME SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0, (SCM obj), "Return @code{#t} if @var{obj} is an hash table.") #define FUNC_NAME s_scm_hash_table_p { return scm_from_bool (SCM_HASHTABLE_P (obj) #if (SCM_ENABLE_DEPRECATED == 1) || is_weak_key_hash_table (obj) || is_weak_value_hash_table (obj) || is_doubly_weak_hash_table (obj) #endif ); } #undef FUNC_NAME /* Accessing hash table entries. */ SCM scm_hash_fn_get_handle (SCM table, SCM obj, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, void * closure) #define FUNC_NAME "scm_hash_fn_get_handle" { unsigned long k; SCM buckets, h; SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); buckets = SCM_HASHTABLE_VECTOR (table); if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0) return SCM_BOOL_F; k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure); if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets)) scm_out_of_range (FUNC_NAME, scm_from_ulong (k)); h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure); return h; } #undef FUNC_NAME SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, void * closure) #define FUNC_NAME "scm_hash_fn_create_handle_x" { unsigned long k; SCM buckets, it; SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); buckets = SCM_HASHTABLE_VECTOR (table); if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0) SCM_MISC_ERROR ("void hashtable", SCM_EOL); k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure); if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets)) scm_out_of_range ("hash_fn_create_handle_x", scm_from_ulong (k)); it = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure); if (scm_is_pair (it)) return it; else if (scm_is_true (it)) scm_wrong_type_arg_msg (NULL, 0, it, "a pair"); else { SCM handle, new_bucket; handle = scm_cons (obj, init); new_bucket = scm_cons (handle, SCM_EOL); if (!scm_is_eq (SCM_HASHTABLE_VECTOR (table), buckets)) { buckets = SCM_HASHTABLE_VECTOR (table); k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure); if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets)) scm_out_of_range ("hash_fn_create_handle_x", scm_from_ulong (k)); } SCM_SETCDR (new_bucket, SCM_SIMPLE_VECTOR_REF (buckets, k)); SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket); SCM_HASHTABLE_INCREMENT (table); /* Maybe rehash the table. */ if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table) || SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table)) scm_i_rehash (table, hash_fn, closure, FUNC_NAME); return SCM_CAR (new_bucket); } } #undef FUNC_NAME SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, void *closure) { SCM it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure); if (scm_is_pair (it)) return SCM_CDR (it); else return dflt; } SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, void *closure) { SCM pair; pair = scm_hash_fn_create_handle_x (table, obj, val, hash_fn, assoc_fn, closure); if (!scm_is_eq (SCM_CDR (pair), val)) SCM_SETCDR (pair, val); return val; } SCM scm_hash_fn_remove_x (SCM table, SCM obj, scm_t_hash_fn hash_fn, scm_t_assoc_fn assoc_fn, void *closure) #define FUNC_NAME "hash_fn_remove_x" { unsigned long k; SCM buckets, h; SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); buckets = SCM_HASHTABLE_VECTOR (table); if (SCM_SIMPLE_VECTOR_LENGTH (buckets) == 0) return SCM_EOL; k = hash_fn (obj, SCM_SIMPLE_VECTOR_LENGTH (buckets), closure); if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets)) scm_out_of_range (FUNC_NAME, scm_from_ulong (k)); h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure); if (scm_is_true (h)) { SCM_SIMPLE_VECTOR_SET (buckets, k, scm_delq_x (h, SCM_SIMPLE_VECTOR_REF (buckets, k))); SCM_HASHTABLE_DECREMENT (table); if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)) scm_i_rehash (table, hash_fn, closure, FUNC_NAME); } return h; } #undef FUNC_NAME SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0, (SCM table), "Remove all items from @var{table} (without triggering a resize).") #define FUNC_NAME s_scm_hash_clear_x { #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_clear_x (table); if (is_weak_value_hash_table (table)) return weak_value_hash_table_clear_x (table); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_clear_x (table); } #endif SCM_VALIDATE_HASHTABLE (SCM_ARG1, table); scm_vector_fill_x (SCM_HASHTABLE_VECTOR (table), SCM_EOL); SCM_SET_HASHTABLE_N_ITEMS (table, 0); return SCM_UNSPECIFIED; } #undef FUNC_NAME SCM_DEFINE (scm_hashq_get_handle, "hashq-get-handle", 2, 0, 0, (SCM table, SCM key), "This procedure returns the @code{(key . value)} pair from the\n" "hash table @var{table}. If @var{table} does not hold an\n" "associated value for @var{key}, @code{#f} is returned.\n" "Uses @code{eq?} for equality testing.") #define FUNC_NAME s_scm_hashq_get_handle { return scm_hash_fn_get_handle (table, key, (scm_t_hash_fn) scm_ihashq, (scm_t_assoc_fn) scm_sloppy_assq, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0, (SCM table, SCM key, SCM init), "This function looks up @var{key} in @var{table} and returns its handle.\n" "If @var{key} is not already present, a new handle is created which\n" "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hashq_create_handle_x { return scm_hash_fn_create_handle_x (table, key, init, (scm_t_hash_fn) scm_ihashq, (scm_t_assoc_fn) scm_sloppy_assq, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashq_ref, "hashq-ref", 2, 1, 0, (SCM table, SCM key, SCM dflt), "Look up @var{key} in the hash table @var{table}, and return the\n" "value (if any) associated with it. If @var{key} is not found,\n" "return @var{dflt} (or @code{#f} if no @var{dflt} argument\n" "is supplied). Uses @code{eq?} for equality testing.") #define FUNC_NAME s_scm_hashq_ref { if (SCM_UNBNDP (dflt)) dflt = SCM_BOOL_F; #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_ref (table, key, dflt); if (is_weak_value_hash_table (table)) return weak_value_hash_table_ref (table, key, dflt); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_ref (table, key, dflt); } #endif return scm_hash_fn_ref (table, key, dflt, (scm_t_hash_fn) scm_ihashq, (scm_t_assoc_fn) scm_sloppy_assq, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0, (SCM table, SCM key, SCM val), "Find the entry in @var{table} associated with @var{key}, and\n" "store @var{val} there. Uses @code{eq?} for equality testing.") #define FUNC_NAME s_scm_hashq_set_x { #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_set_x (table, key, val); if (is_weak_value_hash_table (table)) return weak_value_hash_table_set_x (table, key, val); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_set_x (table, key, val); } #endif return scm_hash_fn_set_x (table, key, val, (scm_t_hash_fn) scm_ihashq, (scm_t_assoc_fn) scm_sloppy_assq, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0, (SCM table, SCM key), "Remove @var{key} (and any value associated with it) from\n" "@var{table}. Uses @code{eq?} for equality tests.") #define FUNC_NAME s_scm_hashq_remove_x { #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_remove_x (table, key); if (is_weak_value_hash_table (table)) return weak_value_hash_table_remove_x (table, key); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_remove_x (table, key); } #endif return scm_hash_fn_remove_x (table, key, (scm_t_hash_fn) scm_ihashq, (scm_t_assoc_fn) scm_sloppy_assq, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashv_get_handle, "hashv-get-handle", 2, 0, 0, (SCM table, SCM key), "This procedure returns the @code{(key . value)} pair from the\n" "hash table @var{table}. If @var{table} does not hold an\n" "associated value for @var{key}, @code{#f} is returned.\n" "Uses @code{eqv?} for equality testing.") #define FUNC_NAME s_scm_hashv_get_handle { return scm_hash_fn_get_handle (table, key, (scm_t_hash_fn) scm_ihashv, (scm_t_assoc_fn) scm_sloppy_assv, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0, (SCM table, SCM key, SCM init), "This function looks up @var{key} in @var{table} and returns its handle.\n" "If @var{key} is not already present, a new handle is created which\n" "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hashv_create_handle_x { return scm_hash_fn_create_handle_x (table, key, init, (scm_t_hash_fn) scm_ihashv, (scm_t_assoc_fn) scm_sloppy_assv, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0, (SCM table, SCM key, SCM dflt), "Look up @var{key} in the hash table @var{table}, and return the\n" "value (if any) associated with it. If @var{key} is not found,\n" "return @var{dflt} (or @code{#f} if no @var{dflt} argument\n" "is supplied). Uses @code{eqv?} for equality testing.") #define FUNC_NAME s_scm_hashv_ref { if (SCM_UNBNDP (dflt)) dflt = SCM_BOOL_F; #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_ref (table, key, dflt); if (is_weak_value_hash_table (table)) return weak_value_hash_table_ref (table, key, dflt); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_ref (table, key, dflt); } #endif return scm_hash_fn_ref (table, key, dflt, (scm_t_hash_fn) scm_ihashv, (scm_t_assoc_fn) scm_sloppy_assv, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0, (SCM table, SCM key, SCM val), "Find the entry in @var{table} associated with @var{key}, and\n" "store @var{value} there. Uses @code{eqv?} for equality testing.") #define FUNC_NAME s_scm_hashv_set_x { #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_set_x (table, key, val); if (is_weak_value_hash_table (table)) return weak_value_hash_table_set_x (table, key, val); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_set_x (table, key, val); } #endif return scm_hash_fn_set_x (table, key, val, (scm_t_hash_fn) scm_ihashv, (scm_t_assoc_fn) scm_sloppy_assv, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0, (SCM table, SCM key), "Remove @var{key} (and any value associated with it) from\n" "@var{table}. Uses @code{eqv?} for equality tests.") #define FUNC_NAME s_scm_hashv_remove_x { #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_remove_x (table, key); if (is_weak_value_hash_table (table)) return weak_value_hash_table_remove_x (table, key); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_remove_x (table, key); } #endif return scm_hash_fn_remove_x (table, key, (scm_t_hash_fn) scm_ihashv, (scm_t_assoc_fn) scm_sloppy_assv, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hash_get_handle, "hash-get-handle", 2, 0, 0, (SCM table, SCM key), "This procedure returns the @code{(key . value)} pair from the\n" "hash table @var{table}. If @var{table} does not hold an\n" "associated value for @var{key}, @code{#f} is returned.\n" "Uses @code{equal?} for equality testing.") #define FUNC_NAME s_scm_hash_get_handle { return scm_hash_fn_get_handle (table, key, (scm_t_hash_fn) scm_ihash, (scm_t_assoc_fn) scm_sloppy_assoc, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hash_create_handle_x, "hash-create-handle!", 3, 0, 0, (SCM table, SCM key, SCM init), "This function looks up @var{key} in @var{table} and returns its handle.\n" "If @var{key} is not already present, a new handle is created which\n" "associates @var{key} with @var{init}.") #define FUNC_NAME s_scm_hash_create_handle_x { return scm_hash_fn_create_handle_x (table, key, init, (scm_t_hash_fn) scm_ihash, (scm_t_assoc_fn) scm_sloppy_assoc, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0, (SCM table, SCM key, SCM dflt), "Look up @var{key} in the hash table @var{table}, and return the\n" "value (if any) associated with it. If @var{key} is not found,\n" "return @var{dflt} (or @code{#f} if no @var{dflt} argument\n" "is supplied). Uses @code{equal?} for equality testing.") #define FUNC_NAME s_scm_hash_ref { if (SCM_UNBNDP (dflt)) dflt = SCM_BOOL_F; #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_ref (table, key, dflt); if (is_weak_value_hash_table (table)) return weak_value_hash_table_ref (table, key, dflt); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_ref (table, key, dflt); } #endif return scm_hash_fn_ref (table, key, dflt, (scm_t_hash_fn) scm_ihash, (scm_t_assoc_fn) scm_sloppy_assoc, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0, (SCM table, SCM key, SCM val), "Find the entry in @var{table} associated with @var{key}, and\n" "store @var{val} there. Uses @code{equal?} for equality\n" "testing.") #define FUNC_NAME s_scm_hash_set_x { #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_set_x (table, key, val); if (is_weak_value_hash_table (table)) return weak_value_hash_table_set_x (table, key, val); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_set_x (table, key, val); } #endif return scm_hash_fn_set_x (table, key, val, (scm_t_hash_fn) scm_ihash, (scm_t_assoc_fn) scm_sloppy_assoc, 0); } #undef FUNC_NAME SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0, (SCM table, SCM key), "Remove @var{key} (and any value associated with it) from\n" "@var{table}. Uses @code{equal?} for equality tests.") #define FUNC_NAME s_scm_hash_remove_x { #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_remove_x (table, key); if (is_weak_value_hash_table (table)) return weak_value_hash_table_remove_x (table, key); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_remove_x (table, key); } #endif return scm_hash_fn_remove_x (table, key, (scm_t_hash_fn) scm_ihash, (scm_t_assoc_fn) scm_sloppy_assoc, 0); } #undef FUNC_NAME typedef struct scm_t_ihashx_closure { SCM hash; SCM assoc; SCM key; } scm_t_ihashx_closure; static unsigned long scm_ihashx (SCM obj, unsigned long n, void *arg) { SCM answer; scm_t_ihashx_closure *closure = (scm_t_ihashx_closure *) arg; answer = scm_call_2 (closure->hash, obj, scm_from_ulong (n)); return scm_to_ulong (answer); } static SCM scm_sloppy_assx (SCM obj, SCM alist, void *arg) { scm_t_ihashx_closure *closure = (scm_t_ihashx_closure *) arg; return scm_call_2 (closure->assoc, obj, alist); } SCM_DEFINE (scm_hashx_get_handle, "hashx-get-handle", 4, 0, 0, (SCM hash, SCM assoc, SCM table, SCM key), "This behaves the same way as the corresponding\n" "@code{-get-handle} function, but uses @var{hash} as a hash\n" "function and @var{assoc} to compare keys. @code{hash} must be\n" "a function that takes two arguments, a key to be hashed and a\n" "table size. @code{assoc} must be an associator function, like\n" "@code{assoc}, @code{assq} or @code{assv}.") #define FUNC_NAME s_scm_hashx_get_handle { scm_t_ihashx_closure closure; closure.hash = hash; closure.assoc = assoc; closure.key = key; return scm_hash_fn_get_handle (table, key, scm_ihashx, scm_sloppy_assx, (void *) &closure); } #undef FUNC_NAME SCM_DEFINE (scm_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0, (SCM hash, SCM assoc, SCM table, SCM key, SCM init), "This behaves the same way as the corresponding\n" "@code{-create-handle} function, but uses @var{hash} as a hash\n" "function and @var{assoc} to compare keys. @code{hash} must be\n" "a function that takes two arguments, a key to be hashed and a\n" "table size. @code{assoc} must be an associator function, like\n" "@code{assoc}, @code{assq} or @code{assv}.") #define FUNC_NAME s_scm_hashx_create_handle_x { scm_t_ihashx_closure closure; closure.hash = hash; closure.assoc = assoc; closure.key = key; return scm_hash_fn_create_handle_x (table, key, init, scm_ihashx, scm_sloppy_assx, (void *)&closure); } #undef FUNC_NAME SCM_DEFINE (scm_hashx_ref, "hashx-ref", 4, 1, 0, (SCM hash, SCM assoc, SCM table, SCM key, SCM dflt), "This behaves the same way as the corresponding @code{ref}\n" "function, but uses @var{hash} as a hash function and\n" "@var{assoc} to compare keys. @code{hash} must be a function\n" "that takes two arguments, a key to be hashed and a table size.\n" "@code{assoc} must be an associator function, like @code{assoc},\n" "@code{assq} or @code{assv}.\n" "\n" "By way of illustration, @code{hashq-ref table key} is\n" "equivalent to @code{hashx-ref hashq assq table key}.") #define FUNC_NAME s_scm_hashx_ref { scm_t_ihashx_closure closure; if (SCM_UNBNDP (dflt)) dflt = SCM_BOOL_F; closure.hash = hash; closure.assoc = assoc; closure.key = key; #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_ref (table, key, dflt); if (is_weak_value_hash_table (table)) return weak_value_hash_table_ref (table, key, dflt); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_ref (table, key, dflt); } #endif return scm_hash_fn_ref (table, key, dflt, scm_ihashx, scm_sloppy_assx, (void *)&closure); } #undef FUNC_NAME SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0, (SCM hash, SCM assoc, SCM table, SCM key, SCM val), "This behaves the same way as the corresponding @code{set!}\n" "function, but uses @var{hash} as a hash function and\n" "@var{assoc} to compare keys. @code{hash} must be a function\n" "that takes two arguments, a key to be hashed and a table size.\n" "@code{assoc} must be an associator function, like @code{assoc},\n" "@code{assq} or @code{assv}.\n" "\n" " By way of illustration, @code{hashq-set! table key} is\n" "equivalent to @code{hashx-set! hashq assq table key}.") #define FUNC_NAME s_scm_hashx_set_x { scm_t_ihashx_closure closure; closure.hash = hash; closure.assoc = assoc; closure.key = key; #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_set_x (table, key, val); if (is_weak_value_hash_table (table)) return weak_value_hash_table_set_x (table, key, val); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_set_x (table, key, val); } #endif return scm_hash_fn_set_x (table, key, val, scm_ihashx, scm_sloppy_assx, (void *)&closure); } #undef FUNC_NAME SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0, (SCM hash, SCM assoc, SCM table, SCM obj), "This behaves the same way as the corresponding @code{remove!}\n" "function, but uses @var{hash} as a hash function and\n" "@var{assoc} to compare keys. @code{hash} must be a function\n" "that takes two arguments, a key to be hashed and a table size.\n" "@code{assoc} must be an associator function, like @code{assoc},\n" "@code{assq} or @code{assv}.\n" "\n" " By way of illustration, @code{hashq-remove! table key} is\n" "equivalent to @code{hashx-remove! hashq assq #f table key}.") #define FUNC_NAME s_scm_hashx_remove_x { scm_t_ihashx_closure closure; closure.hash = hash; closure.assoc = assoc; closure.key = obj; #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_remove_x (table, obj); if (is_weak_value_hash_table (table)) return weak_value_hash_table_remove_x (table, obj); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_remove_x (table, obj); } #endif return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, (void *) &closure); } #undef FUNC_NAME /* Hash table iterators */ SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, (SCM proc, SCM init, SCM table), "An iterator over hash-table elements.\n" "Accumulates and returns a result by applying PROC successively.\n" "The arguments to PROC are \"(key value prior-result)\" where key\n" "and value are successive pairs from the hash table TABLE, and\n" "prior-result is either INIT (for the first application of PROC)\n" "or the return value of the previous application of PROC.\n" "For example, @code{(hash-fold acons '() tab)} will convert a hash\n" "table into an a-list of key-value pairs.") #define FUNC_NAME s_scm_hash_fold { SCM_VALIDATE_PROC (1, proc); #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_fold (proc, init, table); if (is_weak_value_hash_table (table)) return weak_value_hash_table_fold (proc, init, table); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_fold (proc, init, table); } #endif SCM_VALIDATE_HASHTABLE (3, table); return scm_internal_hash_fold ((scm_t_hash_fold_fn) scm_call_3, (void *) SCM_UNPACK (proc), init, table); } #undef FUNC_NAME static SCM for_each_proc (void *proc, SCM handle) { return scm_call_2 (SCM_PACK (proc), SCM_CAR (handle), SCM_CDR (handle)); } SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0, (SCM proc, SCM table), "An iterator over hash-table elements.\n" "Applies PROC successively on all hash table items.\n" "The arguments to PROC are \"(key value)\" where key\n" "and value are successive pairs from the hash table TABLE.") #define FUNC_NAME s_scm_hash_for_each { SCM_VALIDATE_PROC (1, proc); #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_for_each (proc, table); if (is_weak_value_hash_table (table)) return weak_value_hash_table_for_each (proc, table); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_for_each (proc, table); } #endif SCM_VALIDATE_HASHTABLE (2, table); scm_internal_hash_for_each_handle (for_each_proc, (void *) SCM_UNPACK (proc), table); return SCM_UNSPECIFIED; } #undef FUNC_NAME SCM_DEFINE (scm_hash_for_each_handle, "hash-for-each-handle", 2, 0, 0, (SCM proc, SCM table), "An iterator over hash-table elements.\n" "Applies PROC successively on all hash table handles.") #define FUNC_NAME s_scm_hash_for_each_handle { SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, 1, FUNC_NAME); SCM_VALIDATE_HASHTABLE (2, table); scm_internal_hash_for_each_handle ((scm_t_hash_handle_fn) scm_call_1, (void *) SCM_UNPACK (proc), table); return SCM_UNSPECIFIED; } #undef FUNC_NAME static SCM map_proc (void *proc, SCM key, SCM data, SCM value) { return scm_cons (scm_call_2 (SCM_PACK (proc), key, data), value); } SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 0, 0, (SCM proc, SCM table), "An iterator over hash-table elements.\n" "Accumulates and returns as a list the results of applying PROC successively.\n" "The arguments to PROC are \"(key value)\" where key\n" "and value are successive pairs from the hash table TABLE.") #define FUNC_NAME s_scm_hash_map_to_list { SCM_VALIDATE_PROC (1, proc); #if (SCM_ENABLE_DEPRECATED == 1) if (!SCM_HASHTABLE_P (table)) { if (is_weak_key_hash_table (table)) return weak_key_hash_table_map_to_list (proc, table); if (is_weak_value_hash_table (table)) return weak_value_hash_table_map_to_list (proc, table); if (is_doubly_weak_hash_table (table)) return doubly_weak_hash_table_map_to_list (proc, table); } #endif SCM_VALIDATE_HASHTABLE (2, table); return scm_internal_hash_fold (map_proc, (void *) SCM_UNPACK (proc), SCM_EOL, table); } #undef FUNC_NAME static SCM count_proc (void *pred, SCM key, SCM data, SCM value) { if (scm_is_false (scm_call_2 (SCM_PACK (pred), key, data))) return value; else return scm_oneplus(value); } SCM_DEFINE (scm_hash_count, "hash-count", 2, 0, 0, (SCM pred, SCM table), "Return the number of elements in the given hash TABLE that\n" "cause `(PRED KEY VALUE)' to return true. To quickly determine\n" "the total number of elements, use `(const #t)' for PRED.") #define FUNC_NAME s_scm_hash_count { SCM init; SCM_VALIDATE_PROC (1, pred); SCM_VALIDATE_HASHTABLE (2, table); init = scm_from_int (0); return scm_internal_hash_fold ((scm_t_hash_fold_fn) count_proc, (void *) SCM_UNPACK (pred), init, table); } #undef FUNC_NAME SCM scm_internal_hash_fold (scm_t_hash_fold_fn fn, void *closure, SCM init, SCM table) #define FUNC_NAME s_scm_hash_fold { long i, n; SCM buckets, result = init; SCM_VALIDATE_HASHTABLE (0, table); buckets = SCM_HASHTABLE_VECTOR (table); n = SCM_SIMPLE_VECTOR_LENGTH (buckets); for (i = 0; i < n; ++i) { SCM ls, handle; for (ls = SCM_SIMPLE_VECTOR_REF (buckets, i); !scm_is_null (ls); ls = SCM_CDR (ls)) { handle = SCM_CAR (ls); result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result); } } return result; } #undef FUNC_NAME /* The following redundant code is here in order to be able to support hash-for-each-handle. An alternative would have been to replace this code and scm_internal_hash_fold above with a single scm_internal_hash_fold_handles, but we don't want to promote such an API. */ void scm_internal_hash_for_each_handle (scm_t_hash_handle_fn fn, void *closure, SCM table) #define FUNC_NAME s_scm_hash_for_each { long i, n; SCM buckets; SCM_VALIDATE_HASHTABLE (0, table); buckets = SCM_HASHTABLE_VECTOR (table); n = SCM_SIMPLE_VECTOR_LENGTH (buckets); for (i = 0; i < n; ++i) { SCM ls = SCM_SIMPLE_VECTOR_REF (buckets, i), handle; while (!scm_is_null (ls)) { if (!scm_is_pair (ls)) SCM_WRONG_TYPE_ARG (SCM_ARG3, buckets); handle = SCM_CAR (ls); if (!scm_is_pair (handle)) SCM_WRONG_TYPE_ARG (SCM_ARG3, buckets); fn (closure, handle); ls = SCM_CDR (ls); } } } #undef FUNC_NAME void scm_init_hashtab () { #include "hashtab.x" }