Merge remote-tracking branch 'origin/stable-2.0'

[bpt/guile.git] / libguile / hashtab.c

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index d01df76..fff48b8 100644 (file)
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -205,6 +205,7 @@ SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
 \f
 /* Accessing hash table entries.  */
 
@@ -356,7 +357,10 @@ SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0,
 #define FUNC_NAME s_scm_hash_clear_x
 {
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_clear_x (table);
+    {
+      scm_weak_table_clear_x (table);
+      return SCM_UNSPECIFIED;
+    }
 
   SCM_VALIDATE_HASHTABLE (SCM_ARG1, table);
 
@@ -430,7 +434,10 @@ SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0,
 #define FUNC_NAME s_scm_hashq_set_x
 {
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_putq_x (table, key, val);
+    {
+      scm_weak_table_putq_x (table, key, val);
+      return val;
+    }
 
   return scm_hash_fn_set_x (table, key, val,
                            (scm_t_hash_fn) scm_ihashq,
@@ -448,7 +455,14 @@ SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
 #define FUNC_NAME s_scm_hashq_remove_x
 {
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_remq_x (table, key);
+    {
+      scm_weak_table_remq_x (table, key);
+      /* This return value is for historical compatibility with
+         hash-remove!, which returns either the "handle" corresponding
+         to the entry, or #f.  Since weak tables don't have handles, we
+         have to return #f.  */
+      return SCM_BOOL_F;
+    }
 
   return scm_hash_fn_remove_x (table, key,
                               (scm_t_hash_fn) scm_ihashq,
@@ -532,7 +546,7 @@ SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0,
       scm_c_weak_table_put_x (table, scm_ihashv (key, -1),
                               assv_predicate, SCM_PACK (key),
                               key, val);
-      return SCM_UNSPECIFIED;
+      return val;
     }
 
   return scm_hash_fn_set_x (table, key, val,
@@ -553,7 +567,8 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
     {
       scm_c_weak_table_remove_x (table, scm_ihashv (key, -1),
                                  assv_predicate, SCM_PACK (key));
-      return SCM_UNSPECIFIED;
+      /* See note in hashq-remove!.  */
+      return SCM_BOOL_F;
     }
 
   return scm_hash_fn_remove_x (table, key,
@@ -638,7 +653,7 @@ SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0,
       scm_c_weak_table_put_x (table, scm_ihash (key, -1),
                               assoc_predicate, SCM_PACK (key),
                               key, val);
-      return SCM_UNSPECIFIED;
+      return val;
     }
 
   return scm_hash_fn_set_x (table, key, val,
@@ -660,7 +675,8 @@ SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
     {
       scm_c_weak_table_remove_x (table, scm_ihash (key, -1),
                                  assoc_predicate, SCM_PACK (key));
-      return SCM_UNSPECIFIED;
+      /* See note in hashq-remove!.  */
+      return SCM_BOOL_F;
     }
 
   return scm_hash_fn_remove_x (table, key,
@@ -812,7 +828,7 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
       unsigned long h = scm_to_ulong (scm_call_2 (hash, key,
                                                   scm_from_ulong (-1)));
       scm_c_weak_table_put_x (table, h, assx_predicate, &closure, key, val);
-      return SCM_UNSPECIFIED;
+      return val;
     }
 
   return scm_hash_fn_set_x (table, key, val, scm_ihashx, scm_sloppy_assx,
@@ -843,7 +859,8 @@ SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0,
       unsigned long h = scm_to_ulong (scm_call_2 (hash, obj,
                                                   scm_from_ulong (-1)));
       scm_c_weak_table_remove_x (table, h, assx_predicate, &closure);
-      return SCM_UNSPECIFIED;
+      /* See note in hashq-remove!.  */
+      return SCM_BOOL_F;
     }
 
   return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx,
@@ -893,7 +910,10 @@ SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0,
   SCM_VALIDATE_PROC (1, proc);
 
   if (SCM_WEAK_TABLE_P (table))
-    return scm_weak_table_for_each (proc, table);
+    {
+      scm_weak_table_for_each (proc, table);
+      return SCM_UNSPECIFIED;
+    }
 
   SCM_VALIDATE_HASHTABLE (2, table);
   
@@ -947,6 +967,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
+
 \f
 
 SCM