(define (merge lt? x1 x2)
(cond ((null? x1) x2)
((null? x2) x1)
((lt? (car x2) (car x1))
(cons (car x2) (merge x1 (cdr x2))))
(else (cons (car x1) (merge (cdr x1) x2)))))
(define (sort lt? xs)
(define (merge x1 x2)
(cond ((null? x1) x2)
((null? x2) x1)
((lt? (car x2) (car x1))
(cons (car x2) (merge x1 (cdr x2))))
(else (cons (car x1) (merge (cdr x1) x2)))))
(define (merge-pairs xs k)
(if (or (null? (cdr xs)) (odd? k)) xs
(merge-pairs (cons (merge (car xs) (cadr xs)) (cddr xs)) (quotient k 2))))
(define (next-run run xs)
(if (or (null? xs) (lt? (car xs) (car run))) (values (reverse run) xs)
(next-run (cons (car xs) run) (cdr xs))))
(define (sorting xs ys k)
(if (null? xs) (car (merge-pairs ys 0))
(call-with-values
(lambda () (next-run (list (car xs)) (cdr xs)))
(lambda (run tail)
(sorting tail (merge-pairs (cons run ys) (+ k 1)) (+ k 1))))))
(if (null? xs) xs (sorting xs '() 0)))