-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
*
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- *
- * This program 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 General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
+ * This library 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 2.1 of the License, or (at your option) any later version.
*
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way. To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
+ * This library 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.
*
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ */
\f
static SCM
make_hash_table (int flags, unsigned long k, const char *func_name) {
SCM table, vector;
- int i, n = k ? k : 31;
+ scm_t_hashtable *t;
+ int i = 0, n = k ? k : 31;
+ while (i < HASHTABLE_SIZE_N && n > hashtable_size[i])
+ ++i;
+ n = hashtable_size[i];
if (flags)
/* The SCM_WVECTF_NOSCAN flag informs the weak vector code not to
perform the final scan for broken references. Instead we do
func_name);
else
vector = scm_c_make_vector (n, SCM_EOL);
- scm_t_hashtable *t = scm_gc_malloc (sizeof (*t), s_hashtable);
- i = 0;
- while (i < HASHTABLE_SIZE_N && n > hashtable_size[i])
- ++i;
- if (i > 0)
- i = i - 1;
+ t = scm_gc_malloc (sizeof (*t), s_hashtable);
t->min_size_index = t->size_index = i;
t->n_items = 0;
t->lower = 0;
- t->upper = 9 * hashtable_size[i] / 10;
+ t->upper = 9 * n / 10;
t->flags = flags;
if (flags)
{
if (!SCM_NULLP (to_rehash))
{
SCM h = to_rehash, last;
+ /* important to clear to_rehash here so that we don't get stuck
+ in an infinite loop if scm_i_rehash causes GC */
+ to_rehash = SCM_EOL;
do
{
scm_i_rehash (h,
/* move tables back to weak_hashtables */
SCM_SET_HASHTABLE_NEXT (last, weak_hashtables);
weak_hashtables = to_rehash;
- to_rehash = SCM_EOL;
}
return 0;
}
return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, scm_delx_x, 0);
}
-static SCM
-fold_proc (void *proc, SCM key, SCM data, SCM value)
-{
- return scm_call_3 (SCM_PACK (proc), key, data, value);
-}
+/* 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_HASHTABLE_P (table))
- SCM_VALIDATE_VECTOR (3, table);
- return scm_internal_hash_fold (fold_proc, (void *) SCM_UNPACK (proc), init, table);
-}
-#undef FUNC_NAME
+static const char s_scm_hash_fold[];
SCM
scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table)
return result;
}
+/* 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. */
+
+static const char s_scm_hash_for_each[];
+
+void
+scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table)
+{
+ long i, n;
+ SCM buckets;
+
+ if (SCM_HASHTABLE_P (table))
+ buckets = SCM_HASHTABLE_VECTOR (table);
+ else
+ buckets = table;
+
+ n = SCM_VECTOR_LENGTH (buckets);
+ for (i = 0; i < n; ++i)
+ {
+ SCM ls = SCM_VELTS (buckets)[i], handle;
+ while (!SCM_NULLP (ls))
+ {
+ if (!SCM_CONSP (ls))
+ scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
+ handle = SCM_CAR (ls);
+ if (!SCM_CONSP (handle))
+ scm_wrong_type_arg (s_scm_hash_for_each, SCM_ARG3, buckets);
+ fn (closure, handle);
+ ls = SCM_CDR (ls);
+ }
+ }
+}
+
+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_HASHTABLE_P (table))
+ SCM_VALIDATE_VECTOR (3, table);
+ return scm_internal_hash_fold (scm_call_3, (void *) SCM_UNPACK (proc), init, table);
+}
+#undef FUNC_NAME
+
static SCM
-for_each_proc (void *proc, SCM key, SCM data, SCM value)
+for_each_proc (void *proc, SCM handle)
{
- return scm_call_2 (SCM_PACK (proc), key, data);
+ 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_VALIDATE_PROC (1, proc);
if (!SCM_HASHTABLE_P (table))
SCM_VALIDATE_VECTOR (2, table);
- scm_internal_hash_fold (for_each_proc,
- (void *) SCM_UNPACK (proc),
- SCM_BOOL_F,
- 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_t_trampoline_1 call = scm_trampoline_1 (proc);
+ SCM_ASSERT (call, proc, 1, FUNC_NAME);
+ if (!SCM_HASHTABLE_P (table))
+ SCM_VALIDATE_VECTOR (2, table);
+
+ scm_internal_hash_for_each_handle (call,
+ (void *) SCM_UNPACK (proc),
+ table);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
return scm_cons (scm_call_2 (SCM_PACK (proc), key, data), value);
}
-SCM_DEFINE (scm_hash_map, "hash-map", 2, 0, 0,
+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
+#define FUNC_NAME s_scm_hash_map_to_list
{
SCM_VALIDATE_PROC (1, proc);
if (!SCM_HASHTABLE_P (table))
HCoop / bpt / guile.git / blobdiff