From ebfdbe4bb0e04d5ad962074683fd859126d5ec4e Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Mon, 23 Nov 2009 18:47:32 +0000
Subject: [PATCH] Combined the two merge functions into one macro, and improved
 it a little.

svn: r17002
---
 collects/scheme/private/sort.ss | 37 +++++++++++++--------------------
 1 file changed, 14 insertions(+), 23 deletions(-)

diff --git a/collects/scheme/private/sort.ss b/collects/scheme/private/sort.ss
index d75aae073f..3f02404817 100644
--- a/collects/scheme/private/sort.ss
+++ b/collects/scheme/private/sort.ss
@@ -39,41 +39,32 @@ doing these checks.
     (define-syntax-rule (ref n) (vector-ref v n))
     (define-syntax-rule (set! n x) (vector-set! v n x))
 
-    (define (merge1 A1 A2 B1 B2 C1 C2)
-      (when (< C1 B1)
-        (if (< B1 B2)
-          (if (<? (ref B1) (ref A1))
-            (begin (set! C1 (ref B1))
-                   (merge1 A1 A2 (add1 B1) B2 (add1 C1) C2))
-            (begin (set! C1 (ref A1))
-                   (merge1 (add1 A1) A2 B1 B2 (add1 C1) C2)))
-          (begin (set! C1 (ref A1))
-                 (merge1 (add1 A1) A2 B1 B2 (add1 C1) C2)))))
-    (define (merge2 A1 A2 B1 B2 C1 C2)
-      (when (< C1 B1)
-        (if (< B1 B2)
-          (if (<? (ref A1) (ref B1))
-            (begin (set! C1 (ref A1))
-                   (merge2 (add1 A1) A2 B1 B2 (add1 C1) C2))
-            (begin (set! C1 (ref B1))
-                   (merge2 A1 A2 (add1 B1) B2 (add1 C1) C2)))
-          (begin (set! C1 (ref A1))
-                 (merge2 (add1 A1) A2 B1 B2 (add1 C1) C2)))))
+    (define-syntax-rule (merge lo? A1 A2 B1 B2 C1 C2)
+      (let ([b2 B2])
+        (let loop ([a1 A1] [b1 B1] [c1 C1])
+          (if (<= b2 b1)
+            (let loop ([a1 a1] [c1 c1])
+              (when (< c1 b1) (set! c1 (ref a1)) (loop (add1 a1) (add1 c1))))
+            (when (< c1 b1)
+              (let ([x (ref a1)] [y (ref b1)])
+                (if (if lo? (not (<? y x)) (<? x y))
+                  (begin (set! c1 x) (loop (add1 a1) b1 (add1 c1)))
+                  (begin (set! c1 y) (loop a1 (add1 b1) (add1 c1))))))))))
 
     (define (copying-mergesort Alo Ahi Blo Bhi)
       (cond [(< Alo (sub1 Ahi))
              (let ([Amid (/ (+ Alo Ahi) 2)] [Bmid (/ (+ Blo Bhi) 2)])
                (copying-mergesort Amid Ahi Bmid Bhi)
                (copying-mergesort Alo Amid Amid Ahi)
-               (merge1 Amid Ahi Bmid Bhi Blo Bhi))]
+               (merge #t Amid Ahi Bmid Bhi Blo Bhi))]
             [(= Alo (sub1 Ahi))
              (set! Blo (ref Alo))]))
 
-    (define (mergesort Alo Ahi B1lo B1hi)
+    (define-syntax-rule (mergesort Alo Ahi B1lo B1hi)
       (let ([Amid (/ (+ Alo Ahi) 2)])
         (copying-mergesort Amid Ahi B1lo B1hi)
         (copying-mergesort Alo Amid Amid Ahi)
-        (merge2 B1lo B1hi Amid Ahi Alo Ahi)))
+        (merge #f B1lo B1hi Amid Ahi Alo Ahi)))
 
     (mergesort 0 n n (+ n (/ n 2)))))