(define (grab x y)
  (set-cdr! x (cons y (cdr x)))
  x)

(define (make-tournament-play predicate)
  (lambda (x y)
    (if (predicate (car x) (car y))
        (grab x y)
        (grab y x))))

(define (make-tournament initializer reduction)
  (lambda (forest predicate)
    (reduction
      (make-tournament-play predicate)
      forest)))

(define sequential-tournament! (make-tournament right-reduce!))

(define parallel-tournament! (make-tournament parallel-reduce!))

(define (make-tournament-sort! tournament1 tournament2)
  (lambda (plist predicate)
    (let ((p (tournament1 (map! list plist) predicate)))
      (for-each-cdr
        (lambda (x) (set-cdr! x (tournament2 (cdr x) predicate)))
        p)
      p)))

(define tournament-sort-p!
  (make-tournament-sort! parallel-tournament! parallel-tournament!))

(define tournament-sort-s!
  (make-tournament-sort! parallel-tournament! sequential-tournament!))

(define tournament-sort-s-s!
  (make-tournament-sort! sequential-tournament! sequential-tournament!))

(define (grab! x y)
  (set-cdr! y (cdar x))
  (set-cdr! (car x) y)
  x)

(define (tournament-play! x y predicate)
  (if (predicate (caar x) (caar y))
      (grab! x y)
      (grab! y x)))

(define (sequential-tournament! forest predicate)
  (cond
    ((null? forest) '())
    ((null? (cdr forest)) (car forest))
    (else
      (let ((x (reverse! forest)))
        (do ((result x (tournament-play! result next predicate))
             (next (cdr x) after-next)
             (after-next (cddr x) (cdr after-next)))
            ((null? after-next)
             (car (tournament-play! result next predicate))))))))

(define (parallel-tournament! forest predicate)
  (define (tournament-round! so-far to-be-done)
    (cond ((null? to-be-done) so-far)
          ((null? (cdr to-be-done))
           (set-cdr! to-be-done so-far)
           to-be-done)
          (else
            (let* ((i (cdr to-be-done))
                   (j (cdr i))
                   (new (tournament-play! to-be-done i predicate)))
              (set-cdr! new so-far)
              (tournament-round! new j)))))
  (if (null? forest)
      '()
      (do ((x forest (tournament-round! '() x)))
          ((null? (cdr x)) (car x)))))