From 6aacffc0e846d1ac0b8d8749e318d487e2ce668b Mon Sep 17 00:00:00 2001
From: "Adam R. Nelson" <adam@nels.onl>
Date: Sat, 11 Jan 2020 11:58:31 -0500
Subject: [PATCH] fix make-comparator hash function arity in SRFI 128

---
 lib/srfi/128.sld             |  3 ++-
 lib/srfi/128/comparators.scm | 14 +++++++++++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/lib/srfi/128.sld b/lib/srfi/128.sld
index 710305ef..1d5aa903 100644
--- a/lib/srfi/128.sld
+++ b/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?
diff --git a/lib/srfi/128/comparators.scm b/lib/srfi/128/comparators.scm
index 2d135a73..ab5a282e 100644
--- a/lib/srfi/128/comparators.scm
+++ b/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)