2.38.8.7 Selecting comparators

Function: make-selecting-comparator comparator0 comparator …

Return a comparator whose procedures make use of the comparator arguments as follows:

• The type test predicate passes its argument to the type test predicates of the comparators in the sequence given. If any of them returns #t: so does the type test predicate; otherwise, it returns #f.
• The arguments of the equality, compare, and hash functions are passed to the type test predicate of each comparator in sequence. The first comparator whose type test predicate is satisfied on all the arguments is used when comparing those arguments. All other comparators are ignored. If no type test predicate is satisfied, an error is signalled.

This procedure is analogous to the expression types select-compare and cond-compare from SRFI-67.

#!vicare
(import (vicare) (srfi :114))

(define-constant C
  (make-selecting-comparator boolean-comparator
                             exact-integer-comparator
                             string-comparator))

;; type test
(let ((test-type (comparator-type-test-procedure C)))
  (test-type #t)        ⇒ #t
  (test-type #f)        ⇒ #t
  (test-type 1)         ⇒ #t
  (test-type "ciao")    ⇒ #t
  (test-type '(1 . 2))  ⇒ #f
  (test-type 2.0)       ⇒ #f
  (test-type 1+2i))     ⇒ #f

;; type check
(let ((check-type (comparator-check-type-procedure C)))
  (check-type #t)       ⇒ #t
  (check-type #f)       ⇒ #t
  (check-type 1)        ⇒ #t
  (check-type "ciao")   ⇒ #t
  (try
      (comparator-check-type C (void))
    (catch E
      ((&comparator-type-error)
       #t)
      (else E))))       ⇒ #t

;; comparison
(let ((compare (comparator-comparison-procedure C)))
  (compare #t #t)       ⇒ 0
  (compare #t #f)       ⇒ +1
  (compare #f #t)       ⇒ -1

  (compare 1 1)         ⇒ 0
  (compare 2 1)         ⇒ +1
  (compare 1 2)         ⇒ -1

  (compare "1" "1")     ⇒ 0
  (compare "2" "1")     ⇒ +1
  (compare "1" "2")     ⇒ -1

  (try
      (compare #t 1)
    (catch E
      ((&comparator-type-error)
       #t)
      (else E)))        ⇒ #t

  (try
      (compare #t "ciao")
    (catch E
      ((&comparator-type-error)
       #t)
      (else E)))        ⇒ #t

  (try
      (compare 1 "ciao")
    (catch E
      ((&comparator-type-error)
       #t)
      (else E))))       ⇒ #t

;; hash
(let ((hash (comparator-hash-function C)))
  (non-negative-exact-integer? (hash #t))       ⇒ #t
  (non-negative-exact-integer? (hash #f))       ⇒ #t
  (non-negative-exact-integer? (hash 1))        ⇒ #t
  (non-negative-exact-integer? (hash "ciao"))   ⇒ #t

  (try
      (hash 1+2i)
    (catch E
      ((&comparator-type-error)
       #t)
      (else E))))       ⇒ #t