Permalink
Switch branches/tags
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
57 lines (41 sloc) 1.54 KB
! Copyright (C) 2014 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: arrays combinators kernel locals math math.order
math.private sequences sequences.private strings vectors ;
IN: sorting.quick
<PRIVATE
:: quicksort ( seq from to quot: ( obj1 obj2 -- <=> ) -- )
from to < [
from to fixnum+fast 2/ seq nth-unsafe :> pivot
from to [ 2dup <= ] [
[
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 fixnum+fast ] [ 1 fixnum-fast ] bi* ] 2bi
] when
] while
[ 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>
: 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! ;