rendered paste body\ could be DEFERed to allow sorting different things
: select-pivot ( first last -- pivot ) over - 2/ + aligned ;
: greater? ( addr1 addr2 -- flag ) @ swap @ < ;
: exchange ( addr1 addr2 -- ) 2dup @ >r @ swap ! r> swap ! ;
: partition ( first last -- first1 last1 first2 last2 )
2dup select-pivot
over exchange
>r dup dup begin dup r@ <= while
dup r@ greater? 0= if 2dup exchange swap 1 cells + swap then
1 cells + repeat
drop dup >r 2 cells - r> r> ;
: quicksort ( first last -- )
2dup < if 2dup partition recurse recurse else 2drop then ;
: shorter-segment ( L1 R1 L2 R2 -- L1 R1 L2 R2 | L2 R2 L1 R1 )
\ Bring the shorter of the two segments to the top of the stack.
2over 2over - + > if 2swap then ;
: qsort ( L R -- ) begin 2dup < while partition shorter-segment recurse repeat 2drop ;
create a 5 , 4 , 2 , 1 , 9 , 8 , 3 ,
a dup 6 cells + partition
@ . @ . @ . @ .