home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / language / gambit.cpt / init.scm < prev    next >
Encoding:
Text File  |  1992-03-18  |  729 b   |  34 lines

  1. (display "Loading \"init.scm\"") (newline)
  2.  
  3.  
  4.  
  5. ; Sort using mergesort
  6. ;
  7. ; (sort '(6 2 8 4 1) <) ==> (1 2 4 6 8)
  8.  
  9. (define (sort l <?)
  10.  
  11.   (define (mergesort l)
  12.  
  13.     (define (merge l1 l2)
  14.       (cond ((null? l1) l2)
  15.             ((null? l2) l1)
  16.             (else
  17.              (let ((e1 (car l1)) (e2 (car l2)))
  18.                (if (<? e1 e2)
  19.                  (cons e1 (merge (cdr l1) l2))
  20.                  (cons e2 (merge l1 (cdr l2))))))))
  21.  
  22.     (define (split l)
  23.       (if (or (null? l) (null? (cdr l)))
  24.         l
  25.         (cons (car l) (split (cddr l)))))
  26.  
  27.     (if (or (null? l) (null? (cdr l)))
  28.       l
  29.       (let* ((l1 (mergesort (split l)))
  30.              (l2 (mergesort (split (cdr l)))))
  31.         (merge l1 l2))))
  32.  
  33.   (mergesort l))
  34.