mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
* hashtab.c, hashtab.h (scm_internal_hash_fold): New function.
(scm_hash_fold): New procedure. Used to process all entries in a hash table (in no particular order).
This commit is contained in:
parent
c8eed87557
commit
c7df61cd7f
2 changed files with 44 additions and 1 deletions
|
@ -529,6 +529,48 @@ scm_hashx_remove_x (hash, assoc, delete, table, obj)
|
|||
return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, scm_delx_x, 0);
|
||||
}
|
||||
|
||||
static const char s_hash_fold[];
|
||||
|
||||
SCM
|
||||
scm_internal_hash_fold (SCM table, SCM (*fn) (), void *closure, SCM init)
|
||||
{
|
||||
int i, n = SCM_LENGTH (table);
|
||||
SCM result = init;
|
||||
for (i = 0; i < n; ++i)
|
||||
{
|
||||
SCM ls = SCM_VELTS (table)[i], handle;
|
||||
while (SCM_NNULLP (ls))
|
||||
{
|
||||
SCM_ASSERT (SCM_NIMP (ls) && SCM_CONSP (ls),
|
||||
table, SCM_ARG1, s_hash_fold);
|
||||
handle = SCM_CAR (ls);
|
||||
SCM_ASSERT (SCM_NIMP (handle) && SCM_CONSP (handle),
|
||||
table, SCM_ARG1, s_hash_fold);
|
||||
result = fn (closure, SCM_CAR (handle), SCM_CDR (handle), result);
|
||||
ls = SCM_CDR (ls);
|
||||
}
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
static SCM
|
||||
fold_proc (void *proc, SCM key, SCM data, SCM value)
|
||||
{
|
||||
return scm_apply ((SCM) proc, SCM_LIST3 (key, data, value), SCM_EOL);
|
||||
}
|
||||
|
||||
SCM_PROC (s_hash_fold, "hash-fold", 3, 0, 0, scm_hash_fold);
|
||||
|
||||
SCM
|
||||
scm_hash_fold (SCM table, SCM proc, SCM init)
|
||||
{
|
||||
SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table),
|
||||
table, SCM_ARG1, s_hash_fold);
|
||||
SCM_ASSERT (SCM_NIMP (proc) && SCM_NFALSEP (scm_procedure_p (proc)),
|
||||
proc, SCM_ARG2, s_hash_fold);
|
||||
return scm_internal_hash_fold (table, fold_proc, (void *) proc, init);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -537,4 +579,3 @@ scm_init_hashtab ()
|
|||
{
|
||||
#include "hashtab.x"
|
||||
}
|
||||
|
||||
|
|
|
@ -58,6 +58,7 @@ extern SCM scm_hash_fn_create_handle_x SCM_P ((SCM table, SCM obj, SCM init, uns
|
|||
extern SCM scm_hash_fn_ref SCM_P ((SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure));
|
||||
extern SCM scm_hash_fn_set_x SCM_P ((SCM table, SCM obj, SCM val, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), void * closure));
|
||||
extern SCM scm_hash_fn_remove_x SCM_P ((SCM table, SCM obj, unsigned int (*hash_fn) (), SCM (*assoc_fn) (), SCM (*delete_fn) (), void * closure));
|
||||
extern SCM scm_internal_hash_fold SCM_P ((SCM table, SCM (*fn) (), void *closure, SCM init));
|
||||
|
||||
extern SCM scm_hashq_get_handle SCM_P ((SCM table, SCM obj));
|
||||
extern SCM scm_hashq_create_handle_x SCM_P ((SCM table, SCM obj, SCM init));
|
||||
|
@ -79,6 +80,7 @@ extern SCM scm_hashx_create_handle_x SCM_P ((SCM hash, SCM assoc, SCM table, SCM
|
|||
extern SCM scm_hashx_ref SCM_P ((SCM hash, SCM assoc, SCM table, SCM obj, SCM dflt));
|
||||
extern SCM scm_hashx_set_x SCM_P ((SCM hash, SCM assoc, SCM table, SCM obj, SCM val));
|
||||
extern SCM scm_hashx_remove_x SCM_P ((SCM hash, SCM assoc, SCM del, SCM table, SCM obj));
|
||||
extern SCM scm_hash_fold SCM_P ((SCM hash, SCM proc, SCM init));
|
||||
extern void scm_init_hashtab SCM_P ((void));
|
||||
|
||||
#endif /* HASHTABH */
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue