Name and export standard hash-table types.
authorChris Hanson <org/chris-hanson/cph>
Thu, 21 Aug 2008 01:00:46 +0000 (01:00 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 21 Aug 2008 01:00:46 +0000 (01:00 +0000)
v7/src/runtime/hashtb.scm
v7/src/runtime/runtime.pkg

index f1601c3221a72515c7fbd4b5a58c76a5744af1a1..f590b138162a0d3d07ac150c5cd5f18e601452f3 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: hashtb.scm,v 1.39 2008/08/20 09:01:31 cph Exp $
+$Id: hashtb.scm,v 1.40 2008/08/21 01:00:41 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -868,6 +868,14 @@ USA.
 ;;;; Miscellany
 
 (define address-hash-tables)
+
+(define eq-hash-table-type)
+(define strong-eq-hash-table-type)
+(define eqv-hash-table-type)
+(define strong-eqv-hash-table-type)
+(define equal-hash-table-type)
+(define string-hash-table-type)
+
 (define make-eq-hash-table)
 (define make-strong-eq-hash-table)
 (define make-eqv-hash-table)
@@ -880,24 +888,30 @@ USA.
 (define (initialize-package!)
   (set! address-hash-tables '())
   (add-primitive-gc-daemon! mark-address-hash-tables!)
+  (set! eq-hash-table-type
+       (make-weak-rehash-type eq-hash-mod eq?))
+  (set! strong-eq-hash-table-type
+       (make-strong-rehash-type eq-hash-mod eq?))
+  (set! eqv-hash-table-type
+       (make-weak-rehash-type eqv-hash-mod eqv?))
+  (set! strong-eqv-hash-table-type
+       (make-strong-rehash-type eqv-hash-mod eqv?))
+  (set! equal-hash-table-type
+       (make-strong-rehash-type equal-hash-mod equal?))
+  (set! string-hash-table-type
+       (make-strong-no-rehash-type string-hash-mod string=?))
   (set! make-eq-hash-table
-       (hash-table-constructor
-        (make-weak-rehash-type eq-hash-mod eq?)))
+       (hash-table-constructor eq-hash-table-type))
   (set! make-strong-eq-hash-table
-       (hash-table-constructor
-        (make-strong-rehash-type eq-hash-mod eq?)))
+       (hash-table-constructor strong-eq-hash-table-type))
   (set! make-eqv-hash-table
-       (hash-table-constructor
-        (make-weak-rehash-type eqv-hash-mod eqv?)))
+       (hash-table-constructor eqv-hash-table-type))
   (set! make-strong-eqv-hash-table
-       (hash-table-constructor
-        (make-strong-rehash-type eqv-hash-mod eqv?)))
+       (hash-table-constructor strong-eqv-hash-table-type))
   (set! make-equal-hash-table
-       (hash-table-constructor
-        (make-strong-rehash-type equal-hash-mod equal?)))
+       (hash-table-constructor equal-hash-table-type))
   (set! make-string-hash-table
-       (hash-table-constructor
-        (make-strong-no-rehash-type string-hash-mod string=?)))
+       (hash-table-constructor string-hash-table-type))
   ;; Define old names for compatibility:
   (set! make-symbol-hash-table make-eq-hash-table)
   (set! make-object-hash-table make-eqv-hash-table)
index d4e0125f29e202c2f0453328effdc6d8e78aab94..76f8a186bdd8c72296f4ab53fb5f11696fe10d20 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.658 2008/08/20 09:01:35 cph Exp $
+$Id: runtime.pkg,v 14.659 2008/08/21 01:00:46 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1841,14 +1841,15 @@ USA.
          alist->hash-table
          eq-hash
          eq-hash-mod
+         eq-hash-table-type
          equal-hash
          equal-hash-mod
+         equal-hash-table-type
          eqv-hash
          eqv-hash-mod
+         eqv-hash-table-type
          error:not-hash-table
          guarantee-hash-table
-         ;name conflict:
-         ;hash
          hash-by-identity
          hash-table->alist
          hash-table-copy
@@ -1887,6 +1888,9 @@ USA.
          make-symbol-hash-table
          set-hash-table/rehash-size!
          set-hash-table/rehash-threshold!
+         string-hash-table-type
+         strong-eq-hash-table-type
+         strong-eqv-hash-table-type
          strong-hash-table/constructor
          weak-hash-table/constructor)
   (initialization (initialize-package!)))