From c7df61cd7fb6ac41f907fc34de95105b94e77650 Mon Sep 17 00:00:00 2001
From: Mikael Djurfeldt <djurfeldt@nada.kth.se>
Date: Sun, 14 Mar 1999 16:48:50 +0000
Subject: [PATCH] * 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).

---
 libguile/hashtab.c | 43 ++++++++++++++++++++++++++++++++++++++++++-
 libguile/hashtab.h |  2 ++
 2 files changed, 44 insertions(+), 1 deletion(-)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 6bb773821..d0c79c282 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -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"
 }
-
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 345644c94..dd24e4437 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -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 */