mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
fix make-comparator hash function arity in SRFI 128
This commit is contained in:
parent
48d6c35548
commit
6aacffc0e8
2 changed files with 15 additions and 2 deletions
|
@ -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?
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Reference in a new issue