(define (any pred ls)
  (and (pair? ls) (or (pred (car ls)) (any pred (cdr ls)))))

(define (filter pred ls)
  (cond ((null? ls) ls)
        ((pred (car ls)) (cons (car ls) (filter pred (cdr ls))))
        (else (filter pred (cdr ls)))))

(define (lset-intq ls1 ls2)
  (filter (lambda (x) (memq x ls2)) ls1))

(define (lset-diffq ls1 ls2)
  (filter (lambda (x) (not (memq x ls2))) ls1))

(define scheme-implementation
  (let*
      ((unified-null/false (lambda () (eq? '() #f)))
       (false-one-armed-if (lambda () (eq? #f (if #f #f))))
       (null-one-armed-if (lambda () (eq? '() (if #f #f))))
       (singleton-quoted-empty-vector (lambda () (eq? '#() '#())))
       (singleton-empty-string (lambda () (eq? "" "")))
       (singleton-combinators
        (lambda () (letrec ((id (lambda () (lambda (x) x)))) (eq? (id) (id)))))
       (case-sensitive (lambda () (not (eq? 'a 'A))))
       (space-default-strings
        (lambda () (string=? (make-string 10) "          ")))
       (question-default-strings
        (lambda () (string=? (make-string 10) "??????????")))
       (rationals (lambda () (= (+ (/ 1 3) (/ 1 2)) (/ 5 6))))
       (wrap-to-float
        (lambda () (any inexact? (map (lambda (x) (expt 2 x)) '(29 30 31 61 62 63)))))
       (wrap-to-negative
        (lambda () (or (< (expt 2 29) (expt 2 28))
                  (< (expt 2 31) (expt 2 30))
                  (< (expt 2 63) (expt 2 62)))))
       (no-trailing-zero-in-float
        (lambda () (string=? "1." (number->string 1.0))))
       (no-leading-zero-in-complex
        (lambda () (string=? "+1.0i" (number->string (sqrt -1)))))
       (keywords
        (lambda () (not (eq? (string->symbol ":foo") ':foo))))
       (tests
        `((,unified-null/false mit-scheme oaklisp)
          (,singleton-quoted-empty-vector chez kawa mzscheme oaklisp rscheme scsh stklos)
          (,singleton-empty-string chez guile jscheme kawa llava oaklisp rscheme scm scsh stalin stklos)
          (,singleton-combinators kawa mzscheme stalin)
          (,space-default-strings bigloo chicken elk gauche gambit inlab-scheme kawa larceny rscheme)
          (,question-default-strings jaja ksm scsh)
          (,wrap-to-float chicken inlab-scheme jscheme rscheme)
          (,wrap-to-negative bigloo stalin)
          (,rationals chez gambit kawa ksm larceny mit-scheme mzscheme oaklisp sisc scsh stklos)
          (,false-one-armed-if bigloo)
          (,null-one-armed-if elk inlab-scheme llava)
          (,no-trailing-zero-in-float gambit mit-scheme scsh)
          (,no-leading-zero-in-complex kawa)
          (,keywords bigloo gauche kawa stklos)
          (,case-sensitive bigloo chicken gauche guile jaja jscheme kawa rscheme scsh)
          ))
       (schemes
        '(bigloo chicken chez elk gambit gauche guile inlab-scheme jscheme
          kawa ksm oaklisp larceny mit-scheme mzscheme rscheme scm scsh sisc
          stalin stklos)))
    ;; run once each time you change schemes/tests
    (for-each
     (lambda (a)
       (for-each
        (lambda (b)
          (if (and (not (eq? a b))
                   (not (any (lambda (t)
                               (if (memq a t) (not (memq b t)) (memq b t)))
                             tests)))
            (begin (display "can't distinguish ") (display a)
                   (display " from ") (display b) (newline))))
        schemes))
     schemes)
    (lambda ()
      (let part ((t tests) (s schemes))
        (cond ((null? s) #f)
              ((null? (cdr s)) (car s))
              ((null? t) s)
              (else
               (part (cdr t) ((if ((caar t)) lset-intq lset-diffq) s (cdar t)))))))))

(display (scheme-implementation))
(newline)