Change implementation of MERGE-SORT (and therefore SORT) so that it

uses the in-place vector-sorting algorithm for lists.  The previous
algorithm created a stack of depth (/ (LENGTH L) 2), which made it
impossible to use for large lists.  This algorithm creates a stack of
depth (/ (LOG (LENGTH L)) (LOG 2)).

Additionally, tweaked the vector-sorting algorithm to use indexes in a
slightly more efficient (and clearer) way.

diff --git a/v7/src/runtime/msort.scm b/v7/src/runtime/msort.scm
index 58e9651e5ba07e6e2f0d64d0857943720dd25f9c..370955acfaa2c7568afd7b54255b1b0dc3f63113 100644 (file)
--- a/v7/src/runtime/msort.scm
+++ b/v7/src/runtime/msort.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: msort.scm,v 14.6 1999/01/02 06:11:34 cph Exp $
+$Id: msort.scm,v 14.7 2000/03/16 17:09:11 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-2000 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -24,78 +24,41 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (declare (usual-integrations))
 \f
-;; Functional and unstable
+;; This merge sort is stable for partial orders (for predicates like
+;; <=, rather than like <).
 
 (define (merge-sort obj pred)
-  (define (loop l)
-    (if (and (pair? l) (pair? (cdr l)))
-       (split l '() '())
-       l))
-
-  (define (split l one two)
-    (if (pair? l)
-       (split (cdr l) two (cons (car l) one))
-       (begin
-         (if (not (null? l)) (lose))
-         (merge (loop one) (loop two)))))
-
-  (define (merge one two)
-    (cond ((null? one)
-          two)
-         ((pred (car two) (car one))
-          (cons (car two)
-                (merge (cdr two) one)))
-         (else
-          (cons (car one)
-                (merge (cdr one) two)))))
-
-  (define (lose)
-    (error:wrong-type-argument obj "list or vector" 'MERGE-SORT))
-
   (if (vector? obj)
       (merge-sort! (vector-copy obj) pred)
-      (begin
-       (if (pair? obj)
-           (if (pair? (cdr obj))
-               (loop obj)
-               (begin
-                 (if (not (null? (cdr obj))) (lose))
-                 ;; Must return newly allocated list.
-                 (list (car obj))))
-           (begin
-             (if (not (null? obj)) (lose))
-             '())))))
-
-;; This merge sort is stable for partial orders (for predicates like
-;; <=, rather than like <).
+      (vector->list (merge-sort! (list->vector obj) pred))))
 
 (define (merge-sort! v pred)
-  (define (sort-internal! vec temp low high)
-    (if (fix:< low high)
-       (let* ((middle (quotient (fix:+ low high) 2))
-              (next (fix:+ middle 1)))
-         (sort-internal! temp vec low middle)
-         (sort-internal! temp vec next high)
-         (let loop ((p low) (p1 low) (p2 next))
-           (if (not (fix:> p high))
-               (cond ((fix:> p1 middle)
-                      (vector-set! vec p (vector-ref temp p2))
-                      (loop (fix:+ p 1) p1 (fix:+ p2 1)))
-                     ((or (fix:> p2 high)
-                          (pred (vector-ref temp p1)
-                                (vector-ref temp p2)))
-                      (vector-set! vec p (vector-ref temp p1))
-                      (loop (fix:+ p 1) (fix:+ p1 1) p2))
-                     (else
-                      (vector-set! vec p (vector-ref temp p2))
-                      (loop (fix:+ p 1) p1 (fix:+ p2 1)))))))))
-
   (if (not (vector? v))
       (error:wrong-type-argument v "vector" 'MERGE-SORT!))
-  (sort-internal! v
-                 (vector-copy v)
-                 0
-                 (fix:- (vector-length v) 1))
+  (let sort-subvector
+      ((v v)
+       (temp (vector-copy v))
+       (low 0)
+       (high (vector-length v)))
+    (if (fix:> (fix:- high low) 1)
+       (let ((middle (fix:quotient (fix:+ low high) 2)))
+         ;; Sort each half of (V,LOW,HIGH) into the corresponding
+         ;; half of TEMP.
+         (sort-subvector temp v low middle)
+         (sort-subvector temp v middle high)
+         ;; Merge the two halves of TEMP back into V.
+         (let merge ((p low) (p1 low) (p2 middle))
+           (if (fix:< p high)
+               (if (and (fix:< p1 middle)
+                        (or (fix:= p2 high)
+                            (pred (vector-ref temp p1)
+                                  (vector-ref temp p2))))
+                   (begin
+                     (vector-set! v p (vector-ref temp p1))
+                     (merge (fix:+ p 1) (fix:+ p1 1) p2))
+                   (begin
+                     (vector-set! v p (vector-ref temp p2))
+                     (merge (fix:+ p 1) p1 (fix:+ p2 1)))))))))
   v)
 
 (define sort merge-sort)