Adapt GDB integration to newest patches

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

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index fc7fa42..30d781f 100644 (file)
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+ *   2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -205,6 +205,7 @@ SCM_DEFINE (scm_hash_table_p, "hash-table?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
 \f
 /* Accessing hash table entries.  */
 
@@ -523,7 +524,8 @@ SCM_DEFINE (scm_hashv_ref, "hashv-ref", 2, 1, 0,
 
   if (SCM_WEAK_TABLE_P (table))
     return scm_c_weak_table_ref (table, scm_ihashv (key, -1),
-                                 assv_predicate, SCM_PACK (key), dflt);
+                                 assv_predicate,
+                                 (void *) SCM_UNPACK (key), dflt);
 
   return scm_hash_fn_ref (table, key, dflt,
                          (scm_t_hash_fn) scm_ihashv,
@@ -543,7 +545,7 @@ SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0,
   if (SCM_WEAK_TABLE_P (table))
     {
       scm_c_weak_table_put_x (table, scm_ihashv (key, -1),
-                              assv_predicate, SCM_PACK (key),
+                              assv_predicate, (void *) SCM_UNPACK (key),
                               key, val);
       return val;
     }
@@ -565,7 +567,7 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
   if (SCM_WEAK_TABLE_P (table))
     {
       scm_c_weak_table_remove_x (table, scm_ihashv (key, -1),
-                                 assv_predicate, SCM_PACK (key));
+                                 assv_predicate, (void *) SCM_UNPACK (key));
       /* See note in hashq-remove!.  */
       return SCM_BOOL_F;
     }
@@ -629,7 +631,8 @@ SCM_DEFINE (scm_hash_ref, "hash-ref", 2, 1, 0,
 
   if (SCM_WEAK_TABLE_P (table))
     return scm_c_weak_table_ref (table, scm_ihash (key, -1),
-                                 assoc_predicate, SCM_PACK (key), dflt);
+                                 assoc_predicate,
+                                 (void *) SCM_UNPACK (key), dflt);
 
   return scm_hash_fn_ref (table, key, dflt,
                          (scm_t_hash_fn) scm_ihash,
@@ -650,7 +653,7 @@ SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0,
   if (SCM_WEAK_TABLE_P (table))
     {
       scm_c_weak_table_put_x (table, scm_ihash (key, -1),
-                              assoc_predicate, SCM_PACK (key),
+                              assoc_predicate, (void *) SCM_UNPACK (key),
                               key, val);
       return val;
     }
@@ -673,7 +676,7 @@ SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
   if (SCM_WEAK_TABLE_P (table))
     {
       scm_c_weak_table_remove_x (table, scm_ihash (key, -1),
-                                 assoc_predicate, SCM_PACK (key));
+                                 assoc_predicate, (void *) SCM_UNPACK (key));
       /* See note in hashq-remove!.  */
       return SCM_BOOL_F;
     }
@@ -966,6 +969,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