sorting.quick: only allow sorting array-capacity things.
parent
2bb93f1b72
commit
8e09ee0266
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license
|
||||
|
||||
USING: arrays combinators kernel locals math math.order
|
||||
sequences sequences.private strings vectors ;
|
||||
math.private sequences sequences.private strings vectors ;
|
||||
|
||||
IN: sorting.quick
|
||||
|
||||
|
@ -10,22 +10,22 @@ IN: sorting.quick
|
|||
|
||||
:: 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 quot call
|
||||
+lt+ eq?
|
||||
] [ [ 1 + ] dip ] while
|
||||
] [ [ 1 fixnum+fast ] dip ] while
|
||||
|
||||
[
|
||||
dup seq nth-unsafe pivot quot call
|
||||
+gt+ eq?
|
||||
] [ 1 - ] while
|
||||
] [ 1 fixnum-fast ] while
|
||||
|
||||
2dup <= [
|
||||
[ seq exchange-unsafe ]
|
||||
[ [ 1 + ] [ 1 - ] bi* ] 2bi
|
||||
[ [ 1 fixnum+fast ] [ 1 fixnum-fast ] bi* ] 2bi
|
||||
] when
|
||||
] while
|
||||
|
||||
|
@ -33,10 +33,14 @@ IN: sorting.quick
|
|||
[ 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 1 - ] dip quicksort ; inline
|
||||
[ 0 over length check-array-capacity 1 - ] dip quicksort ; inline
|
||||
|
||||
: sort-with! ( seq quot: ( elt -- key ) -- )
|
||||
[ compare ] curry sort! ; inline
|
||||
|
|
Loading…
Reference in New Issue