srfi-114 reference implementation fixes Shiro Kawai 14 Oct 2014 12:35 UTC

I think there's a couple of issues in the reference implementation
of make-indexact-real-comparator:

(1) When /rounding/ argument is a procedure, it is invoked with
    a single argument (/ x epsilon), while the srfi-114 document
    says it should be called with two arguments, x and epsilon.

(2) It uses inexact-real-hash for the hash function, which delegates
    to number-hash to hash numbers.  However, the hash function
    should take the rounding mode into account, to satisfy the
    constraint that hash values for x and y must be equal when
    x and y are equal w.r.t. the compare procedure.

A suggested patch follows; though I haven't tested it
(Gauche has independent implementation for comparators).

*** comparators/constructors.scm	Tue Oct 14 02:24:25 2014
--- comparators/constructors.scm.orig	Fri Aug 15 14:10:36 2014
***************
*** 77,94 ****

  ;; Return an appropriately rounded number
  (define (rounded x symbol)
!   (case symbol
!     ((round) (round x))
!     ((ceiling) (ceiling x))
!     ((floor) (floor x))
!     ((truncate) (truncate x))
      (else (error "invalid rounding specification" symbol))))

  ;; Return a number appropriately rounded to epsilon
  (define (rounded-to x epsilon symbol)
!   (if (procedure? symbol)
!     (symbol x epsilon)
!     (rounded (/ x epsilon) symbol)))

  ;; Returns result of comparing a NaN with a non-NaN
  (define (nan-comparison nan-handling which other)
--- 77,93 ----

  ;; Return an appropriately rounded number
  (define (rounded x symbol)
!   (cond
!     ((procedure? symbol) (symbol x))
!     ((eq? symbol 'round) (round x))
!     ((eq? symbol 'ceiling) (ceiling x))
!     ((eq? symbol 'floor) (floor x))
!     ((eq? symbol 'truncate) (truncate x))
      (else (error "invalid rounding specification" symbol))))

  ;; Return a number appropriately rounded to epsilon
  (define (rounded-to x epsilon symbol)
!   (rounded (/ x epsilon) symbol))

  ;; Returns result of comparing a NaN with a non-NaN
  (define (nan-comparison nan-handling which other)
***************
*** 116,131 ****
                  (rounded-to b epsilon rounding)))))))

  ;; Return 0 for NaN, number-hash otherwise
! (define (make-inexact-real-hash epsilon symbol)
!   (lambda (obj)
!     (if (nan? obj) 0 (number-hash (rounded-to obj epsilon symbol)))))

  (define (make-inexact-real-comparator epsilon rounding nan-handling)
    (make-comparator
      inexact-real?
      #t
      (make-inexact-real-comparison epsilon rounding nan-handling)
!     (make-inexact-real-hash epsilon rounding)))

  ;;; Sequence comparator constructors and comparators
  ;;; The hash functions are based on djb2, but
--- 115,129 ----
                  (rounded-to b epsilon rounding)))))))

  ;; Return 0 for NaN, number-hash otherwise
! (define (inexact-real-hash obj)
!   (if (nan? obj) 0 (number-hash obj)))

  (define (make-inexact-real-comparator epsilon rounding nan-handling)
    (make-comparator
      inexact-real?
      #t
      (make-inexact-real-comparison epsilon rounding nan-handling)
!     inexact-real-hash))

  ;;; Sequence comparator constructors and comparators
  ;;; The hash functions are based on djb2, but