; stable sort
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
((3) (let ((le? (if (negative? (caddr args)) >= <=)))
(let loop ((x(car args)) (xs '()))
(if (le? (cadr args) x)
(reverse xs)
(loop (+ x (caddr args)) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
(define (zip . xss) (apply map list xss))
(define xs '(
(alfa zulu) (bravo yankee) (charlie xray) (delta whiskey) (echo uniform)
(alfa tango) (bravo sierra) (charlie romeo) (delta papa) (echo oscar)))
(define (lt? a b)
(string<?
(symbol->string (car a))
(symbol->string (car b))))
(define (qsort lt? xs)
(if (or (null? xs) (null? (cdr xs))) xs
(let ((pivot (car xs)))
(let loop ((xs (cdr xs)) (lesser (list)) (equal-or-greater (list)))
(if (null? xs) (append (qsort lt? lesser) (list pivot) (qsort lt? equal-or-greater))
(if (lt? (car xs) pivot) (loop (cdr xs) (cons (car xs) lesser) equal-or-greater)
(loop (cdr xs) lesser (cons (car xs) equal-or-greater))))))))
(display (qsort lt? xs)) (newline)
(define (stable-sort sort lt? xs)
(define (less? a b)
(or (lt? (cadr a) (cadr b))
(and (not (lt? (cadr b) (cadr a)))
(< (car a) (car b)))))
(map cadr (sort less? (zip (range (length xs)) xs))))
(display (stable-sort qsort lt? xs)) (newline)