From fba9c1dab496612156f816885f307ad4cc7fe980 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 10 Jun 2014 16:45:41 -0700
Subject: [PATCH] sorting.quick: better interface, allow comparison to be
 passed in.

---
 extra/sorting/quick/quick-tests.factor | 15 ++++++++----
 extra/sorting/quick/quick.factor       | 32 +++++++++++++++++++-------
 2 files changed, 35 insertions(+), 12 deletions(-)

diff --git a/extra/sorting/quick/quick-tests.factor b/extra/sorting/quick/quick-tests.factor
index 1afb80c5a0..739f8d88f3 100644
--- a/extra/sorting/quick/quick-tests.factor
+++ b/extra/sorting/quick/quick-tests.factor
@@ -1,6 +1,13 @@
-USING: kernel tools.test ;
+USING: kernel sequences tools.test ;
 IN: sorting.quick
 
-{ { } } [ { } dup quicksort ] unit-test
-{ { 1 } } [ { 1 } dup quicksort ] unit-test
-{ { 1 2 3 4 5 } } [ { 1 4 2 5 3 } dup quicksort ] unit-test
+{ { } } [ { } dup natural-sort! ] unit-test
+{ { 1 } } [ { 1 } dup natural-sort! ] unit-test
+{ { 1 2 3 4 5 } } [ { 1 4 2 5 3 } dup natural-sort! ] unit-test
+
+{
+    { "dino" "fred" "wilma" "betty" "barney" "pebbles" "bamm-bamm" }
+} [
+    { "fred" "wilma" "pebbles" "dino" "barney" "betty" "bamm-bamm" }
+    dup [ length ] sort-with!
+] unit-test
diff --git a/extra/sorting/quick/quick.factor b/extra/sorting/quick/quick.factor
index e585cb190f..38ee1b9627 100644
--- a/extra/sorting/quick/quick.factor
+++ b/extra/sorting/quick/quick.factor
@@ -8,25 +8,41 @@ IN: sorting.quick
 
 <PRIVATE
 
-:: (quicksort) ( seq from to -- )
+:: quicksort ( seq from to quot -- )
     from to < [
         from to + 2/ seq nth-unsafe :> pivot
 
         from to [ 2dup <= ] [
-            [ over seq nth-unsafe pivot before? ] [ [ 1 + ] dip ] while
-            [ dup  seq nth-unsafe pivot after? ] [ 1 - ] while
+            [
+                over seq nth-unsafe pivot quot call( x x -- x )
+                +lt+ eq?
+            ] [ [ 1 + ] dip ] while
+
+            [
+                dup seq nth-unsafe pivot quot call( x x -- x )
+                +gt+ eq?
+            ] [ 1 - ] while
+
             2dup <= [
                 [ seq exchange-unsafe ]
                 [ [ 1 + ] [ 1 - ] bi* ] 2bi
             ] when
         ] while
 
-        [ seq from ] dip (quicksort)
-        [ seq ] dip to (quicksort)
-
+        [ seq from ] dip quot quicksort
+        [ seq ] dip to quot quicksort
     ] when ; inline recursive
 
 PRIVATE>
 
-: quicksort ( seq -- )
-    0 over length 1 - (quicksort) ;
+: sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
+    [ 0 over length 1 - ] dip quicksort ;
+
+: sort-with! ( seq quot: ( elt -- key ) -- )
+    [ compare ] curry sort! ; inline
+
+: inv-sort-with! ( seq quot: ( elt -- key ) -- )
+    [ compare invert-comparison ] curry sort! ; inline
+
+: natural-sort! ( seq -- )
+    [ <=> ] sort! ;