aboutsummaryrefslogtreecommitdiffstats
path: root/csc/sort.csc
blob: 6be1e16499ad0cf4453d534f3d117b35f1d01454 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
(define-library (csc sort)
  (export sort)
  (import (scheme base)
          (only (csc list)
                revappend
                split-at))
  (begin


    (define (sort-len cmp xs len)
      (if (<= len 1)
        xs
        (let ((n/2 (truncate-quotient len 2)))
          (let-values (((half-a half-b) (split-at n/2 xs)))
            (let ((sorted-half-a (sort-len cmp half-a n/2))
                  (sorted-half-b (sort-len cmp half-b (- len n/2))))
              (let loop ((a sorted-half-a)
                         (b sorted-half-b)
                         (acc '()))
                (cond ((null? a) (revappend acc b))
                      ((null? b) (revappend acc a))
                      ((cmp (car b) (car a))
                       (loop a (cdr b) (cons (car b) acc)))
                      (else (loop (cdr a) b (cons (car a) acc))))))))))


    (define (sort cmp xs)
      (sort-len cmp xs (length xs)))))