factor: trim using lists

[factor.git] / extra / sorting / quick / quick.factor

diff --git a/extra/sorting/quick/quick.factor b/extra/sorting/quick/quick.factor
index e585cb190f976ed30bf1b52f4baebc89f766f4bf..f7b5ed51a280922358fd15026ad18ae2632cab0d 100644 (file)
--- a/extra/sorting/quick/quick.factor
+++ b/extra/sorting/quick/quick.factor
@@ -1,32 +1,56 @@
 ! Copyright (C) 2014 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: combinators kernel locals math math.order sequences
-sequences.private ;
+USING: arrays kernel math math.order math.private sequences
+sequences.private strings vectors ;
 
 IN: sorting.quick
 
 <PRIVATE
 
-:: (quicksort) ( seq from to -- )
+:: quicksort ( seq from to quot: ( obj1 obj2 -- <=> ) -- )
     from to < [
-        from to + 2/ seq nth-unsafe :> pivot
+        from to fixnum+fast 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
+                +lt+ eq?
+            ] [ [ 1 fixnum+fast ] dip ] while
+
+            [
+                dup seq nth-unsafe pivot quot call
+                +gt+ eq?
+            ] [ 1 fixnum-fast ] while
+
             2dup <= [
                 [ seq exchange-unsafe ]
-                [ [ 1 + ] [ 1 - ] bi* ] 2bi
+                [ [ 1 fixnum+fast ] [ 1 fixnum-fast ] 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
 
+: check-array-capacity ( n -- n )
+    integer>fixnum-strict dup array-capacity?
+    [ "too large" throw ] unless ; inline
+
 PRIVATE>
 
-: quicksort ( seq -- )
-    0 over length 1 - (quicksort) ;
+: sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
+    [ 0 over length check-array-capacity 1 - ] dip quicksort ; inline
+
+: sort-with! ( seq quot: ( elt -- key ) -- )
+    [ compare ] curry sort! ; inline
+
+: inv-sort-with! ( seq quot: ( elt -- key ) -- )
+    [ compare invert-comparison ] curry sort! ; inline
+
+GENERIC: natural-sort! ( seq -- )
+
+M: object natural-sort!  [ <=> ] sort! ;
+M: array natural-sort! [ <=> ] sort! ;
+M: vector natural-sort! [ <=> ] sort! ;
+M: string natural-sort! [ <=> ] sort! ;