; Synthetic benchmark for comparing symbols using
;
;     eq?
;     eqv?
;     symbol=?
;
; where symbol=? is like eq? except it raises an exception
; if either of its arguments is not a symbol.
;
; The benchmark is given six symbols, returning #t
; if all are distinct, and returning #f otherwise.
; (The R6RS is expected to require interpreters to
; perform this test for all formal parameter lists.)
; That's 15 equality tests per call.

(define-syntax distinct?
  (syntax-rules ()
   ((distinct? symbol=? sym1 sym2)
    (not (symbol=? sym1 sym2)))
   ((distinct? symbol=? sym1 sym2 sym3 ...)
    (if (symbol=? sym1 sym2)
        #f
        (and (distinct? symbol=? sym1 sym3 ...)
             (distinct? symbol=? sym2 sym3 ...))))))

(define-syntax symbol=?
  (syntax-rules ()
   ((symbol=? x y)
    (begin (if (not (and (symbol? x) (symbol? y)))
               (car 0))
           (eq? x y)))))

(define (distinct-eq? sym1 sym2 sym3 sym4 sym5 sym6)
  (distinct? eq? sym1 sym2 sym3 sym4 sym5 sym6))

(define (distinct-eqv? sym1 sym2 sym3 sym4 sym5 sym6)
  (distinct? eqv? sym1 sym2 sym3 sym4 sym5 sym6))

(define (distinct-symbol=? sym1 sym2 sym3 sym4 sym5 sym6)
  (distinct? symbol=? sym1 sym2 sym3 sym4 sym5 sym6))

(let ((test-yes '(a b c d e f))
      (test-no  '(a b c d e b)))
  (if (not (and (apply distinct-eq? test-yes)
                (apply distinct-eqv? test-yes)
                (apply distinct-symbol=? test-yes)
                (not (apply distinct-eq? test-no))
                (not (apply distinct-eqv? test-no))
                (not (apply distinct-symbol=? test-no))))
      (begin (display "Something's wrong.") (newline))))

(define (symtesting-benchmark . args)
  (let* ((n (if (null? args) 10000000 (car args)))
         (sn (number->string n)))
    (run-benchmark (string-append "symtesting:eq?:" sn)
                   n
                   (lambda ()
                     (distinct-eq?
                      'x1 'x2 'x3 'x4 'x5 'x6))
                   (lambda (answer) answer))
    (run-benchmark (string-append "symtesting:eqv?:" sn)
                   n
                   (lambda ()
                     (distinct-eqv?
                      'x1 'x2 'x3 'x4 'x5 'x6))
                   (lambda (answer) answer))
    (run-benchmark (string-append "symtesting:symbol=?:" sn)
                   n
                   (lambda ()
                     (distinct-symbol=?
                      'x1 'x2 'x3 'x4 'x5 'x6))
                   (lambda (answer) answer))))