Merge pull request #604 from ar-nelson/srfi-128-hash-fix

Fix make-comparator hash function arity in SRFI 128

lib/srfi/128.sld

@@ -1,7 +1,8 @@
 (define-library (srfi 128)
   (import (scheme base) (scheme char)
           (srfi 27) (srfi 69) (srfi 95) (srfi 98) (srfi 151)
-          (only (chibi) fixnum? er-macro-transformer))
+          (only (chibi) fixnum? er-macro-transformer)
+          (only (chibi ast) opcode? procedure? procedure-arity procedure-variadic?))
   (export
    ;; Predicates:
    comparator? comparator-ordered? comparator-hashable?

lib/srfi/128/comparators.scm

@@ -1,12 +1,24 @@
 
 (define-record-type Comparator
-  (make-comparator type-test equality ordering hash)
+  (%make-comparator% type-test equality ordering hash)
   comparator?
   (type-test comparator-type-test-predicate)
   (equality comparator-equality-predicate)
   (ordering comparator-ordering-predicate)
   (hash comparator-hash-function))
 
+(define (make-comparator type-test equality ordering hash)
+  (%make-comparator%
+    type-test
+    equality
+    ordering
+    (if (or (opcode? hash)
+            (not (procedure? hash))
+            (procedure-variadic? hash)
+            (> (procedure-arity hash) 1))
+        hash
+        (lambda (x . o) (hash x)))))
+
 (define-syntax hash-bound
   (er-macro-transformer
    (lambda (expr rename compare)