So this seems to crash inside scm_hash_fn_set_x:
in libguile/hashtab.c:510:
SCM
scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned long (*hash_fn)(),
SCM (*assoc_fn)(), void * closure)
{
SCM it;
it = scm_hash_fn_create_handle_x (table, obj, SCM_BOOL_F, hash_fn, assoc_fn,
closure);
SCM_SETCDR (it, val);
return val;
}
as indicated by:
[trinidad installing-guile/guile-1.8.3]$ gdb libguile/.libs/guile
GNU gdb 6.4.90-debian
Copyright (C) 2006 Free Software Foundation, Inc. [...]
This GDB was configured as "i486-linux-gnu"...Using host libthread_db
library "/lib/tls/libthread_db.so.1".
(gdb) run -l ht.scm
[which contains:
(hashx-set! (lambda (k s) 1) (lambda (a b) #t) (make-hash-table) 'foo 'bar)
]
Starting program:
/afs/csail.mit.edu/u/g/gremio/installing-guile/guile-1.8.3/libguile/.libs/guile -l ht.scm
Failed to read a valid object file image from memory.
[Thread debugging using libthread_db enabled]
[New Thread -1211361600 (LWP 28295)]
Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread -1211361600 (LWP 28295)]
0xb7f008da in scm_hash_fn_set_x () from /usr/lib/libguile.so.17
(gdb) bt
#0 0xb7f008da in scm_hash_fn_set_x () from /usr/lib/libguile.so.17
#1 0xb7f00942 in scm_hashx_set_x () from /usr/lib/libguile.so.17
#2 0xb7efdd5d in scm_gsubr_apply () from /usr/lib/libguile.so.17
This means to me that
(define table (make-hash-table))
(hashx-create-handle! (lambda (k s) 1) (lambda (a b) #t) table 'biz 'buzz)
should not crash, and indeed, it returns #t.
It doesn't help the problem that the association fails, and I wonder if
that's because the hash_fn is supposed to be unsigned long (*hash_fn)().
How does one create one of these in user space? (lambda (k s) 1) is
something more like SCM (*hash_fn)() ?
So if I pass in something that returns scheme objects instead of unsigned
longs, and they get interpreted as unsigned longs, then no wonder I don't
find the key next time. I might be deeply misunderstanding things though.
As another question, when I hash things using hashx-set! and later the
table needs to be resized, is it the closure that's supposed to remember
what function I hashed that key with? I just added a test for this
(enclosed), and despite no segfaults, the test fails -- the hash seems to
forget about some of its items after resizing.
As a design decision, most hash implementations I've seen, if they allow
your own hash function at all, they ask you to specify it at hash creation
time, and they usually do the modulo themselves (so the hash function is
one-argument). The spec for guile seems to be somewhat more flexible, but
at the expense of a fair bit more overhead required to keep things straight
during resize. That is, in a sane implementation, you'd have to remember
the hash function used to put each key in, so you'd have some hope of
getting it back out again. Why did guile choose to spec this way?
Thanks in advance for any input,
Grem
Enclosed is a patch for test-suite/tests/hash.test that contains, among other
things, the segfaulting behavior.
Best,
Grem
I managed to compile 1.8.3 on debian and it shows much the same error,
substituting a Segmentation Fault for bus error in the last case.
Guile 1.3.4 simply returns #f in both cases.
I'm inclined to start poking at guile's source code for the first time.
Could someone give me helpful pointers in the right general direction?
Thanks,
Grem
On Thu, 10 Jan 2008, Gregory Marton wrote:
I may be misunderstanding something, but I thought this should yield 'bar:
guile> (let ((ht (make-hash-table)))
(hashx-set! (lambda (k s) 1) equal? ht 'foo 'bar)
(hashx-ref (lambda (k s) 1) equal? ht 'foo))
#f
guile> (version)
"1.8.1"
much as this does:
guile> (let ((ht (make-hash-table)))
(hash-set! ht 'foo 'bar)
(hash-ref ht 'foo))
bar
I thought perhaps the problem was with the equality test somehow, but then
even worse:
guile> (let ((ht (make-hash-table)))
(hashx-set! (lambda (k s) 1) (lambda (a b) #t) ht 'foo 'bar)
(hashx-ref (lambda (k s) 1) (lambda (a b) #t) ht 'foo))
Bus error
Thanks much,
Grem
p.s. Ludovic, I haven't forgotten about the module docs -- it's just
taking me a while to learn what I need. Sorry.
--
------ __@ Gregory A. Marton http://csail.mit.edu/~gremio/
--- _`\<,_ .
-- (*)/ (*) The prime number few.
~~~~~~~~~~~~~~~~-~~~~~~~~_~~~_~~~~~v~~~~^^^^~~~~~--~~~~~~~~~~~~~~~++~~~~~~~
--- test-suite/tests/hash.test.1.8.3 2008-01-12 04:52:45.000000000 -0500
+++ test-suite/tests/hash.test 2008-01-12 06:27:05.000000000 -0500
@@ -63,6 +63,205 @@
(pass-if (= 0 (hashq noop 1))))
;;;
+;;; make-hash-table
+;;;
+
+(with-test-prefix
+ "make-hash-table, hash-table?"
+ (pass-if-exception "make-hash-table -1" exception:out-of-range
+ (make-hash-table -1))
+ (pass-if (hash-table? (make-hash-table 0))) ;; default
+ (pass-if (not (hash-table? 'not-a-hash-table)))
+ (pass-if (equal? "#<hash-table 0/113>"
+ (with-output-to-string
+ (lambda () (write (make-hash-table 100)))))))
+
+;;;
+;;; usual set and reference
+;;;
+
+(with-test-prefix
+ "hash-set and hash-ref"
+
+ ;; auto-resizing
+ (pass-if (let ((table (make-hash-table 1))) ;;actually makes size 31
+ (hash-set! table 'one 1)
+ (hash-set! table 'two #t)
+ (hash-set! table 'three #t)
+ (hash-set! table 'four #t)
+ (hash-set! table 'five #t)
+ (hash-set! table 'six #t)
+ (hash-set! table 'seven #t)
+ (hash-set! table 'eight #t)
+ (hash-set! table 'nine 9)
+ (hash-set! table 'ten #t)
+ (hash-set! table 'eleven #t)
+ (hash-set! table 'twelve #t)
+ (hash-set! table 'thirteen #t)
+ (hash-set! table 'fourteen #t)
+ (hash-set! table 'fifteen #t)
+ (hash-set! table 'sixteen #t)
+ (hash-set! table 'seventeen #t)
+ (hash-set! table 18 #t)
+ (hash-set! table 19 #t)
+ (hash-set! table 20 #t)
+ (hash-set! table 21 #t)
+ (hash-set! table 22 #t)
+ (hash-set! table 23 #t)
+ (hash-set! table 24 #t)
+ (hash-set! table 25 #t)
+ (hash-set! table 26 #t)
+ (hash-set! table 27 #t)
+ (hash-set! table 28 #t)
+ (hash-set! table 29 #t)
+ (hash-set! table 30 'thirty)
+ (hash-set! table 31 #t)
+ (hash-set! table 32 #t)
+ (hash-set! table 33 'thirty-three)
+ (hash-set! table 34 #t)
+ (hash-set! table 35 #t)
+ (hash-set! table 'foo 'bar)
+ (and (equal? 1 (hash-ref table 'one))
+ (equal? 9 (hash-ref table 'nine))
+ (equal? 'thirty (hash-ref table 30))
+ (equal? 'thirty-three (hash-ref table 33))
+ (equal? 'bar (hash-ref table 'foo))
+ (equal? "#<hash-table 36/61>"
+ (with-output-to-string (lambda () (write table)))))))
+
+ ;; 1 and 1 are equal? and eqv? and eq?
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hash-set! table 1 'foo)
+ (hash-ref table 1))))
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hashv-set! table 1 'foo)
+ (hashv-ref table 1))))
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hashq-set! table 1 'foo)
+ (hashq-ref table 1))))
+
+ ;; 1/2 and 2/4 are equal? and eqv? but not eq?
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hash-set! table 1/2 'foo)
+ (hash-ref table 2/4))))
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hashv-set! table 1/2 'foo)
+ (hashv-ref table 2/4))))
+ (pass-if (equal? #f
+ (let ((table (make-hash-table)))
+ (hashq-set! table 1/2 'foo)
+ (hashq-ref table 2/4))))
+
+ ;; (list 1 2) is equal? but not eqv? or eq? to another (list 1 2)
+ (pass-if (equal? 'foo
+ (let ((table (make-hash-table)))
+ (hash-set! table (list 1 2) 'foo)
+ (hash-ref table (list 1 2)))))
+ (pass-if (equal? #f
+ (let ((table (make-hash-table)))
+ (hashv-set! table (list 1 2) 'foo)
+ (hashv-ref table (list 1 2)))))
+ (pass-if (equal? #f
+ (let ((table (make-hash-table)))
+ (hashq-set! table (list 1 2) 'foo)
+ (hashq-ref table (list 1 2)))))
+
+ ;; ref default argument
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hash-ref table 'foo 'bar))))
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hashv-ref table 'foo 'bar))))
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hashq-ref table 'foo 'bar))))
+ (pass-if (equal? 'bar
+ (let ((table (make-hash-table)))
+ (hashx-ref hash equal? table 'foo 'bar))))
+
+ ;; wrong type argument
+ (pass-if-exception "(hash-ref 'not-a-table 'key)" exception:wrong-type-arg
+ (hash-ref 'not-a-table 'key))
+ )
+
+;;;
+;;; hashx
+;;;
+
+(with-test-prefix
+ "auto-resizing hashx"
+ ;; auto-resizing
+ (pass-if (let ((table (make-hash-table 1))) ;;actually makes size 31
+ (hashx-set! hash assoc table 1/2 'equal)
+ (hashx-set! hashv assv table 1/3 'eqv)
+ (hashx-set! hashq assq table 4 'eq)
+ (hashx-set! hash assoc table 1/5 'equal)
+ (hashx-set! hashv assv table 1/6 'eqv)
+ (hashx-set! hashq assq table 7 'eq)
+ (hashx-set! hash assoc table 1/8 'equal)
+ (hashx-set! hashv assv table 1/9 'eqv)
+ (hashx-set! hashq assq table 10 'eq)
+ (hashx-set! hash assoc table 1/11 'equal)
+ (hashx-set! hashv assv table 1/12 'eqv)
+ (hashx-set! hashq assq table 13 'eq)
+ (hashx-set! hash assoc table 1/14 'equal)
+ (hashx-set! hashv assv table 1/15 'eqv)
+ (hashx-set! hashq assq table 16 'eq)
+ (hashx-set! hash assoc table 1/17 'equal)
+ (hashx-set! hashv assv table 1/18 'eqv)
+ (hashx-set! hashq assq table 19 'eq)
+ (hashx-set! hash assoc table 1/20 'equal)
+ (hashx-set! hashv assv table 1/21 'eqv)
+ (hashx-set! hashq assq table 22 'eq)
+ (hashx-set! hash assoc table 1/23 'equal)
+ (hashx-set! hashv assv table 1/24 'eqv)
+ (hashx-set! hashq assq table 25 'eq)
+ (hashx-set! hash assoc table 1/26 'equal)
+ (hashx-set! hashv assv table 1/27 'eqv)
+ (hashx-set! hashq assq table 28 'eq)
+ (hashx-set! hash assoc table 1/29 'equal)
+ (hashx-set! hashv assv table 1/30 'eqv)
+ (hashx-set! hashq assq table 31 'eq)
+ (hashx-set! hash assoc table 1/32 'equal)
+ (hashx-set! hashv assv table 1/33 'eqv)
+ (hashx-set! hashq assq table 34 'eq)
+ (and (equal? 'equal (hash-ref table 2/4))
+ (equal? 'eqv (hashv-ref table 2/6))
+ (equal? 'eq (hashq-ref table 4))
+ (equal? 'equal (hashx-ref hash equal? table 2/64))
+ (equal? 'eqv (hashx-ref hashv eqv? table 2/66))
+ (equal? 'eq (hashx-ref hashq eq? table 34))
+ (equal? "#<hash-table 34/61>"
+ (with-output-to-string (lambda () (write table))))))))
+
+(with-test-prefix
+ "hashx"
+ (pass-if (let ((table (make-hash-table)))
+ (hashx-set! (lambda (k v) 1) (lambda (a b) #t) table 'foo 'bar)
+ (equal?
+ 'bar (hashx-ref (lambda (k v) 1) (lambda (a b) #t) table 'baz))))
+ (pass-if (let ((table (make-hash-table)))
+ (hashx-set! (lambda (k v) 1) equal? table 'foo 'bar)
+ (equal?
+ 'bar (hashx-ref (lambda (k v) 1) equal? table 'baz))))
+ (pass-if (let ((table (make-hash-table 31)))
+ (hashx-set! (lambda (k v) 1) equal? table 'foo 'bar)
+ (equal? #f
+ (hashx-ref (lambda (k v) 2) equal? table 'foo))))
+ (pass-if (let ((table (make-hash-table)))
+ (hashx-set! hash equal? table 'foo 'bar)
+ (equal? #f
+ (hashx-ref hash (lambda (a b) #f) table 'foo)))))
+
+
+
+;;;
;;; hashx-remove!
;;;
(with-test-prefix "hashx-remove!"
