From 28ea9b7756b8ee14785b080b633f9b4407a51f97 Mon Sep 17 00:00:00 2001
From: Jason Wilson <edu/mit/csail/zurich/jawilson>
Date: Fri, 28 Oct 1994 05:58:22 +0000
Subject: [PATCH] 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.

---
 v7/src/runtime/hashtb.scm | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

diff --git a/v7/src/runtime/hashtb.scm b/v7/src/runtime/hashtb.scm
index 752671599..e9387f38e 100644
--- 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)
-- 
2.25.1