All sorts of sorting algorithms written in Scheme (Gauche)

sort.scm

(use srfi-27)
(use srfi-42)

(define-macro (swap! a b)
  (let1 t (gensym)
    `(let1 ,t ,a
       (set! ,a ,b)
       (set! ,b ,t))))

(define (bubble-sort v)
  (let ((v (vector-copy v))
        (continue #t))
    (while continue
      (set! continue #f)
      (do-ec (: i (- (vector-length v) 1))
        (when (> (vector-ref v i) (vector-ref v (+ i 1)))
          (swap! (vector-ref v i) (vector-ref v (+ i 1)))
          (set! continue #t))))
    v))

(define (insertion-sort v)
  (let1 v (vector-copy v)
    (do-ec (: i 1 (vector-length v))
      (let1 e (vector-ref v i)
        (let l ((j (- i 1)))
          (if (and (>= j 0) (> (vector-ref v j) e))
            (begin
             (vector-set! v (+ j 1) (vector-ref v j))
             (l (- j 1)))
            (vector-set! v (+ j 1) e)))))
    v))

(define (selection-sort v)
  (let ((v (vector-copy v))
        (n (vector-length v)))
    (do-ec (: i (- n 1))
      (let l ((j (+ i 1)) (m i))
        (if (< j n)
          (l (+ j 1)
           (if (< (vector-ref v j) (vector-ref v m))
             j m))
          (swap! (vector-ref v i) (vector-ref v m)))))
    v))

(define (merge-sort v)
  (define (rec ls)
    (if (<= (length ls) 1)
      ls
      (receive (a b) (split-at ls (div (length ls) 2))
        (let l ((result '()) (a (rec a)) (b (rec b)))
          (cond ((and (null? a) (null? b))
                 (reverse result))
                ((null? a)
                 (l (cons (car b) result) '() (cdr b)))
                ((null? b)
                 (l (cons (car a) result) (cdr a) '()))
                ((< (car a) (car b))
                 (l (cons (car a) result) (cdr a) b))
                (else (l (cons (car b) result) a (cdr b))))))))
  ((.$ list->vector rec vector->list) v))

(define (quick-sort v)
  (let1 v (vector-copy v)
    (define (partition a b)
      (let* ((pi (div (+ a b) 2))
             (pv (vector-ref v pi))
             (j a))
        (swap! (vector-ref v pi) (vector-ref v b))
        (let l ((i a))
          (when (< i b)
            (when (< (vector-ref v i) pv)
              (swap! (vector-ref v i) (vector-ref v j))
              (inc! j))
            (l (+ i 1))))
        (swap! (vector-ref v j) (vector-ref v b))
        j))
    (let rec ((a 0) (b (- (vector-length v) 1)))
      (when (< a b)
        (let1 p (partition a b)
          (rec a (- p 1))
          (rec (+ p 1) b))))
    v))

; usage: % gosh sort.scm <number of elements (n)>
(define (main args)
  (random-source-randomize! default-random-source)
  (let* ((n (string->number (cadr args)))
         (v (vector-ec (: i n) (random-integer n))))
    (print v)
    (print (sort v))
    (print (bubble-sort v))
    (print (insertion-sort v))
    (print (selection-sort v))
    (print (merge-sort v))
    (print (quick-sort v)))
  0)