; hoare's partition, improved
; showing only the final version of the program
 
(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 (shuffle ary)
  (do ((v ary) (n (vector-length ary) (- n 1)))
      ((zero? n) ary)
    (let* ((r (random n)) (t (vector-ref ary r)))
      (vector-set! ary r (vector-ref ary (- n 1)))
      (vector-set! ary (- n 1) t))))
 
(define-syntax do-until
  (syntax-rules (loop)
    ((do-until body ... condition)
      (let loop () body ... (unless condition (loop))))))
 
(define (partition lt? ary lo hi)
  (let ((x (vector-ref ary lo)) (i (- lo 1)) (j hi))
    (let forever ()
      (do-until (set! j (- j 1)) (not (lt? x (vector-ref ary j))))
      (do-until (set! i (+ i 1)) (not (lt? (vector-ref ary i) x)))
      (when (< i j)
        (let ((t (vector-ref ary i)))
          (vector-set! ary i (vector-ref ary j))
          (vector-set! ary j t))
        (forever)))
    (values j ary)))
 
(define cutoff 15)

(define (quicksort lt? ary lo hi)
  (if (< cutoff (- hi lo))
      (call-with-values
        (lambda ()
          (partition lt? ary lo hi))
        (lambda (p ary)
          (cond ((< (- p lo) (- hi p))
                  (quicksort lt? ary lo (+ p 1))
                  (quicksort lt? ary (+ p 1) hi))
          (else (quicksort lt? ary (+ p 1) hi)
                (quicksort lt? ary lo (+ p 1))))))
      ary))

(define (insert-sort lt? ary lo hi)
  (do ((i (+ lo 1) (+ i 1))) ((= i hi) ary)
    (let ((t (vector-ref ary i)))
      (do ((j (- i 1) (- j 1)))
          ((or (< j lo) (lt? (vector-ref ary j) t))
            (vector-set! ary (+ j 1) t))
        (vector-set! ary (+ j 1) (vector-ref ary j))))))

(define (sort lt? ary)
  (let ((hi (vector-length ary)))
    (quicksort lt? ary 0 hi)
    (insert-sort lt? ary 0 hi)))
 
(display (sort < (shuffle (list->vector (range 1000))))) (newline)