/* 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
}
#undef FUNC_NAME
+
\f
/* Accessing hash table entries. */
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,
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;
}
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;
}
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,
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;
}
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;
}
}
#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