mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

hash-set! on weak tables returns the value

Browse source 
* libguile/weak-table.h:
* libguile/weak-table.c (scm_weak_table_putq_x)
  (scm_weak_table_remq_x, scm_weak_table_clear_x)
  (scm_weak_table_for_each): Declare these as returning void instead of
  SCM.
* libguile/hashtab.c (scm_hashq_set_x, scm_hashq_remove_x)
  (scm_hashv_set_x, scm_hashv_remove_x)
  (scm_hash_set_x, scm_hash_remove_x)
  (scm_hashx_set_x, scm_hashx_remove_x):
  (scm_hash_for_each): For weak tables, have the set! functions return
  the values, as they used to do.  Have remove! functions return #f,
  indicating the lack of a handle.  Shim around for-each to return
  unspecified, even though that wasn't yet a problem.

* test-suite/tests/weaks.test: Add a test.
This commit is contained in:
Andy Wingo 2012-03-02 18:26:56 +01:00
parent dee4e3ee3c
commit 07e69928fc
4 changed files with 47 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

39
libguile/hashtab.c
View file

@ -356,7 +356,10 @@ SCM_DEFINE (scm_hash_clear_x, "hash-clear!", 1, 0, 0,
#define FUNC_NAME s_scm_hash_clear_x #define FUNC_NAME s_scm_hash_clear_x
{ {
if (SCM_WEAK_TABLE_P (table)) 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); SCM_VALIDATE_HASHTABLE (SCM_ARG1, table);
@ -430,7 +433,10 @@ SCM_DEFINE (scm_hashq_set_x, "hashq-set!", 3, 0, 0,
#define FUNC_NAME s_scm_hashq_set_x #define FUNC_NAME s_scm_hashq_set_x
{ {
if (SCM_WEAK_TABLE_P (table)) 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, return scm_hash_fn_set_x (table, key, val,
(scm_t_hash_fn) scm_ihashq, (scm_t_hash_fn) scm_ihashq,
@ -448,7 +454,14 @@ SCM_DEFINE (scm_hashq_remove_x, "hashq-remove!", 2, 0, 0,
#define FUNC_NAME s_scm_hashq_remove_x #define FUNC_NAME s_scm_hashq_remove_x
{ {
if (SCM_WEAK_TABLE_P (table)) 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, return scm_hash_fn_remove_x (table, key,
(scm_t_hash_fn) scm_ihashq, (scm_t_hash_fn) scm_ihashq,
@ -532,7 +545,7 @@ SCM_DEFINE (scm_hashv_set_x, "hashv-set!", 3, 0, 0,
scm_c_weak_table_put_x (table, scm_ihashv (key, -1), scm_c_weak_table_put_x (table, scm_ihashv (key, -1),
assv_predicate, SCM_PACK (key), assv_predicate, SCM_PACK (key),
key, val); key, val);
return SCM_UNSPECIFIED; return val;
} }
return scm_hash_fn_set_x (table, key, val, return scm_hash_fn_set_x (table, key, val,
@ -553,7 +566,8 @@ SCM_DEFINE (scm_hashv_remove_x, "hashv-remove!", 2, 0, 0,
{ {
scm_c_weak_table_remove_x (table, scm_ihashv (key, -1), scm_c_weak_table_remove_x (table, scm_ihashv (key, -1),
assv_predicate, SCM_PACK (key)); 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, return scm_hash_fn_remove_x (table, key,
@ -638,7 +652,7 @@ SCM_DEFINE (scm_hash_set_x, "hash-set!", 3, 0, 0,
scm_c_weak_table_put_x (table, scm_ihash (key, -1), scm_c_weak_table_put_x (table, scm_ihash (key, -1),
assoc_predicate, SCM_PACK (key), assoc_predicate, SCM_PACK (key),
key, val); key, val);
return SCM_UNSPECIFIED; return val;
} }
return scm_hash_fn_set_x (table, key, val, return scm_hash_fn_set_x (table, key, val,
@ -660,7 +674,8 @@ SCM_DEFINE (scm_hash_remove_x, "hash-remove!", 2, 0, 0,
{ {
scm_c_weak_table_remove_x (table, scm_ihash (key, -1), scm_c_weak_table_remove_x (table, scm_ihash (key, -1),
assoc_predicate, SCM_PACK (key)); 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, return scm_hash_fn_remove_x (table, key,
@ -812,7 +827,7 @@ SCM_DEFINE (scm_hashx_set_x, "hashx-set!", 5, 0, 0,
unsigned long h = scm_to_ulong (scm_call_2 (hash, key, unsigned long h = scm_to_ulong (scm_call_2 (hash, key,
scm_from_ulong (-1))); scm_from_ulong (-1)));
scm_c_weak_table_put_x (table, h, assx_predicate, &closure, key, val); 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, return scm_hash_fn_set_x (table, key, val, scm_ihashx, scm_sloppy_assx,
@ -843,7 +858,8 @@ SCM_DEFINE (scm_hashx_remove_x, "hashx-remove!", 4, 0, 0,
unsigned long h = scm_to_ulong (scm_call_2 (hash, obj, unsigned long h = scm_to_ulong (scm_call_2 (hash, obj,
scm_from_ulong (-1))); scm_from_ulong (-1)));
scm_c_weak_table_remove_x (table, h, assx_predicate, &closure); 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, return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx,
@ -893,7 +909,10 @@ SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0,
SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_PROC (1, proc);
if (SCM_WEAK_TABLE_P (table)) 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); SCM_VALIDATE_HASHTABLE (2, table);

14
libguile/weak-table.c
View file

@ -971,24 +971,22 @@ scm_weak_table_refq (SCM table, SCM key, SCM dflt)
dflt); dflt);
} }
SCM void
scm_weak_table_putq_x (SCM table, SCM key, SCM value) scm_weak_table_putq_x (SCM table, SCM key, SCM value)
{ {
scm_c_weak_table_put_x (table, scm_ihashq (key, -1), scm_c_weak_table_put_x (table, scm_ihashq (key, -1),
assq_predicate, SCM_UNPACK_POINTER (key), assq_predicate, SCM_UNPACK_POINTER (key),
key, value); key, value);
return SCM_UNSPECIFIED;
} }
SCM void
scm_weak_table_remq_x (SCM table, SCM key) scm_weak_table_remq_x (SCM table, SCM key)
{ {
scm_c_weak_table_remove_x (table, scm_ihashq (key, -1), scm_c_weak_table_remove_x (table, scm_ihashq (key, -1),
assq_predicate, SCM_UNPACK_POINTER (key)); assq_predicate, SCM_UNPACK_POINTER (key));
return SCM_UNSPECIFIED;
} }
SCM void
scm_weak_table_clear_x (SCM table) scm_weak_table_clear_x (SCM table)
#define FUNC_NAME "weak-table-clear!" #define FUNC_NAME "weak-table-clear!"
{ {
@ -1004,8 +1002,6 @@ scm_weak_table_clear_x (SCM table)
t->n_items = 0; t->n_items = 0;
scm_i_pthread_mutex_unlock (&t->lock); scm_i_pthread_mutex_unlock (&t->lock);
return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1073,7 +1069,7 @@ for_each_trampoline (void *closure, SCM k, SCM v, SCM seed)
return seed; return seed;
} }
SCM void
scm_weak_table_for_each (SCM proc, SCM table) scm_weak_table_for_each (SCM proc, SCM table)
#define FUNC_NAME "weak-table-for-each" #define FUNC_NAME "weak-table-for-each"
{ {
@ -1081,8 +1077,6 @@ scm_weak_table_for_each (SCM proc, SCM table)
SCM_VALIDATE_PROC (1, proc); SCM_VALIDATE_PROC (1, proc);
scm_c_weak_table_fold (for_each_trampoline, SCM_UNPACK_POINTER (proc), SCM_BOOL_F, table); scm_c_weak_table_fold (for_each_trampoline, SCM_UNPACK_POINTER (proc), SCM_BOOL_F, table);
return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME

10
libguile/weak-table.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_WEAK_TABLE_H #ifndef SCM_WEAK_TABLE_H
#define SCM_WEAK_TABLE_H #define SCM_WEAK_TABLE_H
/* Copyright (C) 2011 Free Software Foundation, Inc. /* Copyright (C) 2011, 2012 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -58,15 +58,15 @@ SCM_INTERNAL void scm_c_weak_table_remove_x (SCM table, unsigned long raw_hash,
void *closure); void *closure);
SCM_INTERNAL SCM scm_weak_table_refq (SCM table, SCM key, SCM dflt); SCM_INTERNAL SCM scm_weak_table_refq (SCM table, SCM key, SCM dflt);
SCM_INTERNAL SCM scm_weak_table_putq_x (SCM table, SCM key, SCM value); SCM_INTERNAL void scm_weak_table_putq_x (SCM table, SCM key, SCM value);
SCM_INTERNAL SCM scm_weak_table_remq_x (SCM table, SCM key); SCM_INTERNAL void scm_weak_table_remq_x (SCM table, SCM key);
SCM_INTERNAL SCM scm_weak_table_clear_x (SCM table); SCM_INTERNAL void scm_weak_table_clear_x (SCM table);
SCM_INTERNAL SCM scm_c_weak_table_fold (scm_t_table_fold_fn proc, void *closure, SCM_INTERNAL SCM scm_c_weak_table_fold (scm_t_table_fold_fn proc, void *closure,
SCM init, SCM table); SCM init, SCM table);
SCM_INTERNAL SCM scm_weak_table_fold (SCM proc, SCM init, SCM table); SCM_INTERNAL SCM scm_weak_table_fold (SCM proc, SCM init, SCM table);
SCM_INTERNAL SCM scm_weak_table_for_each (SCM proc, SCM table); SCM_INTERNAL void scm_weak_table_for_each (SCM proc, SCM table);
SCM_INTERNAL SCM scm_weak_table_map_to_list (SCM proc, SCM table); SCM_INTERNAL SCM scm_weak_table_map_to_list (SCM proc, SCM table);

10
test-suite/tests/weaks.test
View file

@ -1,5 +1,5 @@
;;;; weaks.test --- tests guile's weaks -*- scheme -*- ;;;; weaks.test --- tests guile's weaks -*- scheme -*-
;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. ;;;; Copyright (C) 1999, 2001, 2003, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -232,6 +232,14 @@
(hash-set! t "foo" 1) (hash-set! t "foo" 1)
(equal? (hash-ref t "foo") 1))) (equal? (hash-ref t "foo") 1)))
(pass-if "hash-set!, weak key, returns value"
(let ((t (make-weak-value-hash-table))
(val (string #\f #\o #\o)))
(eq? (hashq-set! t "bar" val)
(hashv-set! t "bar" val)
(hash-set! t "bar" val)
val)))
(pass-if "assoc can do anything" (pass-if "assoc can do anything"
;; Until 1.9.12, as hash table's custom ASSOC procedure was ;; Until 1.9.12, as hash table's custom ASSOC procedure was
;; called with the GC lock alloc held, which imposed severe ;; called with the GC lock alloc held, which imposed severe