I added hash-table/get-key which is useful when implementing sets and

even more useful when using hash-tables to intern objects which you
would also like to attach datums to.

diff --git a/v7/src/runtime/hashtb.scm b/v7/src/runtime/hashtb.scm
index 752671599dd95f212096fd30092121f01a79986f..e9387f38eb9ecf3ac2244dca0372280639bc8b46 100644 (file)
--- a/v7/src/runtime/hashtb.scm
+++ b/v7/src/runtime/hashtb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: hashtb.scm,v 1.19 1994/05/30 06:57:54 cph Exp $
+$Id: hashtb.scm,v 1.20 1994/10/28 05:58:22 jawilson Exp $
 
 Copyright (c) 1990-94 Massachusetts Institute of Technology
 
@@ -211,6 +211,30 @@ MIT in each case. |#
                  (else
                   (loop (cdr entries)))))))))
 
+;; This is useful when interning objects using a hash-table.
+(define (hash-table/get-key table key default)
+  (guarantee-hash-table table 'HASH-TABLE/GET)
+  (let ((entries
+        (vector-ref (table-buckets table) (compute-key-hash table key))))
+    (if (and key (table-standard-accessors? table))
+       ;; Optimize standard case: compiler makes this fast.
+       (let loop ((entries entries))
+         (cond ((null? entries)
+                default)
+               ((eq? (system-pair-car (car entries)) key)
+                (system-pair-car (car entries)))
+               (else
+                (loop (cdr entries)))))
+       (let ((key=? (table-key=? table))
+             (entry-key (table-entry-key table)))
+         (let loop ((entries entries))
+           (cond ((null? entries)
+                  default)
+                 ((key=? (entry-key (car entries)) key)
+                  (entry-key (car entries)))
+                 (else
+                  (loop (cdr entries)))))))))
+
 (define hash-table/lookup
   (let ((default (list #f)))
     (lambda (table key if-found if-not-found)