add hash-count for native tables

* libguile/hashtab.c (scm_hash_count): New function.  Count the number
  of elements in a hash table.

* doc/ref/api-compound.texi (Hash Tables): Update examples and
  reference.

* test-suite/tests/hash.test (hash-count): New test.

4 files changed, 73 insertions, 2 deletions

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index be3d65f4e..f7fa07d90 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -3796,8 +3796,9 @@ key is not found.
 #f
 @end lisp
 
-There is no procedure for calculating the number of key/value-pairs in
-a hash table, but @code{hash-fold} can be used for doing exactly that.
+Interesting results can be computed by using @code{hash-fold} to work
+through each element.  This example will count the total number of
+elements:
 
 @lisp
 (hash-fold (lambda (key value seed) (+ 1 seed)) 0 h)
@@ -3805,6 +3806,24 @@ a hash table, but @code{hash-fold} can be used for doing exactly that.
 3
 @end lisp
 
+The same thing can be done with the procedure @code{hash-count}, which
+can also count the number of elements matching a particular predicate.
+For example, count the number of elements with string values:
+
+@lisp
+(hash-count (lambda (key value) (string? value)) h)
+@result{}
+2
+@end lisp
+
+Counting all the elements is a simple task using @code{const}:
+
+@lisp
+(hash-count (const #t) h)
+@result{}
+3
+@end lisp
+
 @node Hash Table Reference
 @subsubsection Hash Table Reference
 
@@ -4032,6 +4051,13 @@ For example, the following returns a count of how many keys in
 @end example
 @end deffn
 
+@deffn {Scheme Procedure} hash-count pred table
+@deffnx {C Function} scm_hash_count (pred, table)
+Return the number of elements in the given hash @var{table} that cause
+@code{(@var{pred} @var{key} @var{value})} to return true.  To quickly
+determine the total number of elements, use @code{(const #t)} for
+@var{pred}.
+@end deffn
 
 @c Local Variables:
 @c TeX-master: "guile.texi"
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 0abc7dc04..88cb199c5 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -584,6 +584,7 @@ SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
 
 /* Accessing hash table entries.  */
 
@@ -1371,6 +1372,33 @@ SCM_DEFINE (scm_hash_map_to_list, "hash-map->list", 2, 0, 0,
 }
 #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
diff --git a/libguile/hashtab.h b/libguile/hashtab.h
index 314994630..dcebcb81e 100644
--- a/libguile/hashtab.h
+++ b/libguile/hashtab.h
@@ -164,6 +164,7 @@ SCM_API SCM scm_hash_fold (SCM proc, SCM init, SCM hash);
 SCM_API SCM scm_hash_for_each (SCM proc, SCM hash);
 SCM_API SCM scm_hash_for_each_handle (SCM proc, SCM hash);
 SCM_API SCM scm_hash_map_to_list (SCM proc, SCM hash);
+SCM_API SCM scm_hash_count (SCM hash, SCM pred);
 SCM_INTERNAL void scm_i_hashtable_print (SCM exp, SCM port, scm_print_state *pstate);
 SCM_INTERNAL void scm_init_hashtab (void);
 
diff --git a/test-suite/tests/hash.test b/test-suite/tests/hash.test
index bcdfe9110..72aa0c478 100644
--- a/test-suite/tests/hash.test
+++ b/test-suite/tests/hash.test
@@ -292,3 +292,19 @@
    exception:wrong-type-arg
    (hashx-set! (lambda (k s) 1) (lambda (k al) #t) (make-hash-table) 'foo 'bar))
   )
+
+
+;;;
+;;; hash-count
+;;;
+
+(with-test-prefix "hash-count"
+  (let ((table (make-hash-table)))
+    (hashq-set! table 'foo "bar")
+    (hashq-set! table 'braz "zonk")
+    (hashq-create-handle! table 'frob #f)
+
+    (pass-if (equal? 3 (hash-count (const #t) table)))
+
+    (pass-if (equal? 2 (hash-count (lambda (k v)
+                                     (string? v)) table)))))