Tweak equality-predicate-property to accept a default-value argument.

diff --git a/src/runtime/hash-table.scm b/src/runtime/hash-table.scm
index eba4724137a5db3fd36abd1d3510deb587f4f431..4e2a9e6155523e110312a878e2e4a9e69a0ccf0a 100644 (file)
--- a/src/runtime/hash-table.scm
+++ b/src/runtime/hash-table.scm
@@ -1349,14 +1349,11 @@ USA.
    (set-equality-predicate-properties! equal? hash-by-equal #t)
    (set-equality-predicate-properties! string=? string-hash #f)
    (set-equality-predicate-properties! string-ci=? string-ci-hash #f)
-   (set-equality-predicate-properties! int:= int:modulo #f)))
+   (set-equality-predicate-properties! int:= int:modulo #f)
+   (register-predicate! equality-predicate? 'equality-predicate)))
 
 (define (equality-predicate-keylist equality-predicate)
-  (let ((props (%equality-predicate-properties equality-predicate #f)))
-    (if (not props)
-        (error:not-a equality-predicate? equality-predicate
-                    'equality-predicate-keylist))
-    props))
+  (%equality-predicate-properties equality-predicate '()))
 
 (define (equality-predicate-property-names equality-predicate)
   (let loop ((keylist (equality-predicate-keylist equality-predicate)))
@@ -1364,14 +1361,25 @@ USA.
        (cons (car keylist) (loop (cddr keylist)))
        '())))
 
-(define (equality-predicate-property equality-predicate name)
-  (get-keyword-value (equality-predicate-keylist equality-predicate) name))
+(define (equality-predicate-property equality-predicate name
+                                    #!optional default-value)
+  (let ((value
+        (get-keyword-value (equality-predicate-keylist equality-predicate)
+                           name)))
+    (if (default-object? value)
+       (begin
+         (if (default-object? default-value)
+             (error "Equality predicate missing property" name))
+         default-value)
+       value)))
 
 (define (equality-predicate-hasher equality-predicate)
   (equality-predicate-property equality-predicate 'hasher))
 
 (define (equality-predicate-rehash-after-gc? equality-predicate)
-  (equality-predicate-property equality-predicate 'rehash-after-gc?))
+  (equality-predicate-property equality-predicate
+                              'rehash-after-gc?
+                              #t))
 
 (define (set-equality-predicate-properties! equality-predicate hasher
                                            rehash-after-gc? . keylist)