From 90b68c062d3e4ff8d552248475121a93c7bb082a Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Tue, 15 Jul 2008 23:37:09 -0500
Subject: [PATCH] Make it into a stable sort

---
 core/sorting/sorting-docs.factor  | 4 ++++
 core/sorting/sorting-tests.factor | 6 ++++++
 core/sorting/sorting.factor       | 8 ++++----
 3 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/core/sorting/sorting-docs.factor b/core/sorting/sorting-docs.factor
index e55d1eb150..18bc7f14cf 100644
--- a/core/sorting/sorting-docs.factor
+++ b/core/sorting/sorting-docs.factor
@@ -3,6 +3,10 @@ sequences math.order ;
 IN: sorting
 
 ARTICLE: "sequences-sorting" "Sorting sequences"
+"The " { $vocab-link "sorting" } " vocabulary implements the merge-sort algorithm. It runs in " { $snippet "O(n log n)" } " time, and is a " { $emphasis "stable" } " sort, meaning that the order of equal elements is preserved."
+$nl
+"The algorithm only allocates two additional arrays, both the size of the input sequence, and uses iteration rather than recursion, and thus is suitable for sorting large sequences."
+$nl
 "Sorting combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- <=> )" } ", where the output value is one of the three " { $link "order-specifiers" } "."
 $nl
 "Sorting a sequence with a custom comparator:"
diff --git a/core/sorting/sorting-tests.factor b/core/sorting/sorting-tests.factor
index 5f3dab14bc..63e193c89f 100755
--- a/core/sorting/sorting-tests.factor
+++ b/core/sorting/sorting-tests.factor
@@ -18,3 +18,9 @@ unit-test
 ] unit-test
 
 [ ] [ { 1 2 } [ 2drop 1 ] sort drop ] unit-test
+
+! Is it a stable sort?
+[ t ] [ { { 1 "a" } { 1 "b" } { 1 "c" } } dup sort-keys = ] unit-test
+
+[ { { 1 "a" } { 1 "b" } { 1 "c" } { 1 "e" } { 2 "d" } } ]
+[ { { 1 "a" } { 1 "b" } { 1 "c" } { 2 "d" } { 1 "e" } } sort-keys ] unit-test
diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor
index a93a30e7f2..8b84ea8fe0 100755
--- a/core/sorting/sorting.factor
+++ b/core/sorting/sorting.factor
@@ -50,13 +50,13 @@ TUPLE: merge
 : dump-r  [ [ from2>> ] [ to2>> ] [ seq>> ] tri ] [ accum>> ] bi dump ; inline
 : l-next  [ [ l-elt ] [ [ 1+ ] change-from1 drop ] bi ] [ accum>> ] bi push ; inline
 : r-next  [ [ r-elt ] [ [ 1+ ] change-from2 drop ] bi ] [ accum>> ] bi push ; inline
-: decide  [ [ l-elt ] [ r-elt ] bi ] dip call +lt+ eq? ; inline
+: decide  [ [ l-elt ] [ r-elt ] bi ] dip call +gt+ eq? ; inline
 
 : (merge) ( merge quot -- )
-    over l-done? [ drop dump-r ] [
-        over r-done? [ drop dump-l ] [
+    over r-done? [ drop dump-l ] [
+        over l-done? [ drop dump-r ] [
             2dup decide
-            [ over l-next ] [ over r-next ] if
+            [ over r-next ] [ over l-next ] if
             (merge)
         ] if
     ] if ; inline