\ Wil Baden's sorter, 4tH version
\ Set PRECEDES for different datatypes or sort order.
[UNDEFINED] SORT [IF]
DEFER PRECEDES
: EXCHANGE ( addr_1 addr_2 -- )
DUP @ >R OVER @ SWAP ! R> SWAP ! ;
: PARTITION ( lo hi -- lo_1 hi_1 lo_2 hi_2 )
2DUP OVER - 2/ -1 CELLS AND + @ >R ( R: median)
2DUP BEGIN ( lo_1 hi_2 lo_2 hi_1)
SWAP BEGIN DUP @ R@ PRECEDES WHILE CELL+ REPEAT
SWAP BEGIN R@ OVER @ PRECEDES WHILE CELL- REPEAT
2DUP > NOT IF 2DUP EXCHANGE >R CELL+ R> CELL- THEN
2DUP > UNTIL ( lo_1 hi_2 lo_2 hi_1)
R> DROP SWAP ROT ( lo_1 hi_1 lo_2 hi_2)
;
: QSORT ( lo hi -- )
PARTITION ( lo_1 hi_1 lo_2 hi_2)
2>R 2DUP 2R> 2SWAP 2>R 2DUP 2R> 2SWAP - +
< IF 2SWAP THEN ( lo_1 hi_1 lo_2 hi_2)
2DUP < IF RECURSE ELSE 2DROP THEN
2DUP < IF RECURSE ELSE 2DROP THEN ;
: SORT ( addr n -- )
DUP 2 < IF 2DROP EXIT THEN
1- CELLS OVER + ( addr addr+{n-1}cells) QSORT ;
[DEFINED] 4TH# [IF]
hide EXCHANGE
hide PARTITION
hide QSORT
[THEN]
[THEN]
|