1 ! Copyright (C) 2014 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: arrays combinators kernel locals math math.order
5 math.private sequences sequences.private strings vectors ;
11 :: quicksort ( seq from to quot: ( obj1 obj2 -- <=> ) -- )
13 from to fixnum+fast 2/ seq nth-unsafe :> pivot
17 over seq nth-unsafe pivot quot call
19 ] [ [ 1 fixnum+fast ] dip ] while
22 dup seq nth-unsafe pivot quot call
24 ] [ 1 fixnum-fast ] while
27 [ seq exchange-unsafe ]
28 [ [ 1 fixnum+fast ] [ 1 fixnum-fast ] bi* ] 2bi
32 [ seq from ] dip quot quicksort
33 [ seq ] dip to quot quicksort
34 ] when ; inline recursive
36 : check-array-capacity ( n -- n )
37 integer>fixnum-strict dup array-capacity?
38 [ "too large" throw ] unless ; inline
42 : sort! ( seq quot: ( obj1 obj2 -- <=> ) -- )
43 [ 0 over length check-array-capacity 1 - ] dip quicksort ; inline
45 : sort-with! ( seq quot: ( elt -- key ) -- )
46 [ compare ] curry sort! ; inline
48 : inv-sort-with! ( seq quot: ( elt -- key ) -- )
49 [ compare invert-comparison ] curry sort! ; inline
51 GENERIC: natural-sort! ( seq -- )
53 M: object natural-sort! [ <=> ] sort! ;
54 M: array natural-sort! [ <=> ] sort! ;
55 M: vector natural-sort! [ <=> ] sort! ;
56 M: string natural-sort! [ <=> ] sort! ;