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)