From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 9 Oct 1993 08:15:05 +0000 (+0000)
Subject: HASH-TABLE/STRONG-CONSTRUCTOR and HASH-TABLE/WEAK-CONSTRUCTOR simplify
X-Git-Tag: 20090517-FFI~7787
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=78326422077d34f2177945bf8fea034b248b273b;p=mit-scheme.git

HASH-TABLE/STRONG-CONSTRUCTOR and HASH-TABLE/WEAK-CONSTRUCTOR simplify
definition of most common constructors.
---

diff --git a/v7/src/runtime/hashtb.scm b/v7/src/runtime/hashtb.scm
index 8d368d37a..1865af5e8 100644
--- a/v7/src/runtime/hashtb.scm
+++ b/v7/src/runtime/hashtb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: hashtb.scm,v 1.8 1993/10/09 07:15:46 cph Exp $
+$Id: hashtb.scm,v 1.9 1993/10/09 08:15:05 cph Exp $
 
 Copyright (c) 1990-93 Massachusetts Institute of Technology
 
@@ -643,6 +643,14 @@ MIT in each case. |#
 (define address-hash-tables)
 (define make-string-hash-table)
 
+(define (hash-table/strong-constructor key-hash key=?)
+  (hash-table/constructor key-hash key=? cons #t car cdr set-cdr!))
+
+(define (hash-table/weak-constructor key-hash key=?)
+  (hash-table/constructor
+   key-hash key=?
+   weak-cons weak-pair/car? weak-car weak-cdr weak-set-cdr!))
+
 ;; Define old names for compatibility:
 (define hash-table/entry-value hash-table/entry-datum)
 (define hash-table/set-entry-value! hash-table/set-entry-datum!)
@@ -652,32 +660,12 @@ MIT in each case. |#
 (define (initialize-package!)
   (set! address-hash-tables '())
   (add-primitive-gc-daemon! mark-address-hash-tables!)
-  (set! make-eq-hash-table
-	(hash-table/constructor eq-hash
-				eq?
-				weak-cons
-				weak-pair/car?
-				weak-car
-				weak-cdr
-				weak-set-cdr!))
-  (set! make-eqv-hash-table
-	(hash-table/constructor eqv-hash
-				eqv?
-				weak-cons
-				weak-pair/car?
-				weak-car
-				weak-cdr
-				weak-set-cdr!))
+  (set! make-eq-hash-table (hash-table/weak-constructor eq-hash eq?))
+  (set! make-eqv-hash-table (hash-table/weak-constructor eqv-hash eqv?))
   (set! make-object-hash-table make-eqv-hash-table)
   (set! make-symbol-hash-table make-eq-hash-table)
   (set! make-string-hash-table
-	(hash-table/constructor string-hash-mod
-				string=?
-				cons
-				#t
-				car
-				cdr
-				set-cdr!))
+	(hash-table/strong-constructor string-hash-mod string=?))
   unspecific)
 
 (define-integrable (guarantee-hash-table object procedure)
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 93d0d8fa8..b0c4ff3c4 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.200 1993/10/08 23:06:27 cph Exp $
+$Id: runtime.pkg,v 14.201 1993/10/09 08:14:58 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -886,6 +886,8 @@ MIT in each case. |#
 	  hash-table/set-entry-datum!
 	  hash-table/set-entry-value!
 	  hash-table/size
+	  hash-table/strong-constructor
+	  hash-table/weak-constructor
 	  hash-table?
 	  make-eq-hash-table
 	  make-eqv-hash-table
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 93d0d8fa8..b0c4ff3c4 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.200 1993/10/08 23:06:27 cph Exp $
+$Id: runtime.pkg,v 14.201 1993/10/09 08:14:58 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -886,6 +886,8 @@ MIT in each case. |#
 	  hash-table/set-entry-datum!
 	  hash-table/set-entry-value!
 	  hash-table/size
+	  hash-table/strong-constructor
+	  hash-table/weak-constructor
 	  hash-table?
 	  make-eq-hash-table
 	  make-eqv-hash-table