; 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)

OyBzdGFibGUgc29ydAoKKGRlZmluZSAocmFuZ2UgLiBhcmdzKQogIChjYXNlIChsZW5ndGggYXJncykKICAgICgoMSkgKHJhbmdlIDAgKGNhciBhcmdzKSAoaWYgKG5lZ2F0aXZlPyAoY2FyIGFyZ3MpKSAtMSAxKSkpCiAgICAoKDIpIChyYW5nZSAoY2FyIGFyZ3MpIChjYWRyIGFyZ3MpIChpZiAoPCAoY2FyIGFyZ3MpIChjYWRyIGFyZ3MpKSAxIC0xKSkpCiAgICAoKDMpIChsZXQgKChsZT8gKGlmIChuZWdhdGl2ZT8gKGNhZGRyIGFyZ3MpKSA+PSA8PSkpKQogICAgICAgICAgIChsZXQgbG9vcCAoKHgoY2FyIGFyZ3MpKSAoeHMgJygpKSkKICAgICAgICAgICAgIChpZiAobGU/IChjYWRyIGFyZ3MpIHgpCiAgICAgICAgICAgICAgICAgKHJldmVyc2UgeHMpCiAgICAgICAgICAgICAgICAgKGxvb3AgKCsgeCAoY2FkZHIgYXJncykpIChjb25zIHggeHMpKSkpKSkKICAgIChlbHNlIChlcnJvciAncmFuZ2UgInVucmVjb2duaXplZCBhcmd1bWVudHMiKSkpKQoKKGRlZmluZSAoemlwIC4geHNzKSAoYXBwbHkgbWFwIGxpc3QgeHNzKSkKCihkZWZpbmUgeHMgJygKICAoYWxmYSB6dWx1KSAoYnJhdm8geWFua2VlKSAoY2hhcmxpZSB4cmF5KSAoZGVsdGEgd2hpc2tleSkgKGVjaG8gdW5pZm9ybSkKICAoYWxmYSB0YW5nbykgKGJyYXZvIHNpZXJyYSkgKGNoYXJsaWUgcm9tZW8pIChkZWx0YSBwYXBhKSAoZWNobyBvc2NhcikpKQoKKGRlZmluZSAobHQ/IGEgYikKICAoc3RyaW5nPD8KICAgIChzeW1ib2wtPnN0cmluZyAoY2FyIGEpKQogICAgKHN5bWJvbC0+c3RyaW5nIChjYXIgYikpKSkKCihkZWZpbmUgKHFzb3J0IGx0PyB4cykKICAoaWYgKG9yIChudWxsPyB4cykgKG51bGw/IChjZHIgeHMpKSkgeHMKICAgIChsZXQgKChwaXZvdCAoY2FyIHhzKSkpCiAgICAgIChsZXQgbG9vcCAoKHhzIChjZHIgeHMpKSAobGVzc2VyIChsaXN0KSkgKGVxdWFsLW9yLWdyZWF0ZXIgKGxpc3QpKSkKICAgICAgICAoaWYgKG51bGw/IHhzKSAoYXBwZW5kIChxc29ydCBsdD8gbGVzc2VyKSAobGlzdCBwaXZvdCkgKHFzb3J0IGx0PyBlcXVhbC1vci1ncmVhdGVyKSkKICAgICAgICAgIChpZiAobHQ/IChjYXIgeHMpIHBpdm90KSAobG9vcCAoY2RyIHhzKSAoY29ucyAoY2FyIHhzKSBsZXNzZXIpIGVxdWFsLW9yLWdyZWF0ZXIpCiAgICAgICAgICAgIChsb29wIChjZHIgeHMpIGxlc3NlciAoY29ucyAoY2FyIHhzKSBlcXVhbC1vci1ncmVhdGVyKSkpKSkpKSkKCihkaXNwbGF5IChxc29ydCBsdD8geHMpKSAobmV3bGluZSkKCihkZWZpbmUgKHN0YWJsZS1zb3J0IHNvcnQgbHQ/IHhzKQogIChkZWZpbmUgKGxlc3M/IGEgYikKICAgIChvciAobHQ/IChjYWRyIGEpIChjYWRyIGIpKQogICAgICAgIChhbmQgKG5vdCAobHQ/IChjYWRyIGIpIChjYWRyIGEpKSkKICAgICAgICAgICAgICg8IChjYXIgYSkgKGNhciBiKSkpKSkKICAobWFwIGNhZHIgKHNvcnQgbGVzcz8gKHppcCAocmFuZ2UgKGxlbmd0aCB4cykpIHhzKSkpKQoKKGRpc3BsYXkgKHN0YWJsZS1zb3J0IHFzb3J0IGx0PyB4cykpIChuZXdsaW5lKQ==