home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0963.lha / SIOD / scm / qsort.scm < prev    next >
Text File  |  1993-05-08  |  984b  |  26 lines
  1.  
  2. (define test >=)
  3.  
  4. (define (qsort! v m n)
  5.         (define (interchange i j)
  6.                 (let ((t (vector-ref v i)))
  7.                      (vector-set! v i (vector-ref v j))
  8.                      (vector-set! v j t)))
  9.         (define (qsort-i m n)
  10.                 (if (< m n)
  11.                     (do ((i m)
  12.                          (j (1+ n))
  13.                          (k (vector-ref v m)))
  14.                         ((>= i j) (interchange m j)
  15.                                   (qsort-i m (-1+ j))
  16.                                   (qsort-i (1+ j) n))
  17.                         (set! i (1+ i))
  18.                         (do () ((or (test (vector-ref v i) k) (>= i n)))
  19.                                (set! i (1+ i)))
  20.                         (set! j (-1+ j))
  21.                         (do () ((or (test k (vector-ref v j)) (<= j m)))
  22.                                (set! j (-1+ j)))
  23.                         (if (< i j)
  24.                             (interchange i j)))))
  25.         (qsort-i m n))
  26.