All pastes #269501 Raw Edit

less fetching

public text v1 · immutable
·published 2006-12-06 17:03 UTC
rendered paste body
: select-pivot ( L R -- pivot ) over - 2/ + aligned ;
: greater? ( n1 n2 -- flag ) > ;
: exchange ( addr1 addr2 -- ) 2dup  @ >r  @ swap !  r> swap ! ;

: partition ( L R -- L1 R1  L2 R2 )
    2dup select-pivot over exchange
    >r dup dup r@ @ begin over r@ <= while
        over @ over greater? 0= if >r  2dup exchange  swap cell+ swap  r> then
    >r cell+ r> repeat
    2drop dup >r 2 cells - r> r> ;

: 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 ;