zpg / partition (aga

create numbers 7 , 6 , 8 , 23 , 1 , 2 , 11 , 12 ,

: array. ( array -- )
    ." #( "
    dup cell+ swap @ 0 do dup @ . cell+ loop drop
    ." )" ;

: array-last ( array -- n )
    dup @ cells + ;

: array-bounds ( array -- n n )
    dup cell+ swap array-last ;

: exchange ( add1 add2 )
    over @ over @ >r
    swap ! r> swap ! ;

: cell- 1 cells - ;

: inspect-partition ( n n n n -- n n n n )
    2over 2over 2swap
    swap ." L1 ==> " @ . ." R1 ==> " @ . cr
    swap ." L2 ==> " @ . ." R2 ==> " @ . ;

: pivot-value ( L R -- n )
    nip @ ;

: partition ( L R -- L1 R1 L2 R2 )
    2dup
    2dup pivot-value >r
    cr ." Partition Value: " r@ . ." -- stack is: " .s
    begin 2dup <= while
	    swap ( r l ) begin dup @  r@ < while cell+ repeat
	    swap ( l r ) begin r@ over @ < while cell- repeat
	    2dup <= if
		2dup exchange
		cell- swap cell+ swap then repeat
    r> drop
    ( L1 R2 L2 R1 )
    swap rot ;

: qsort ( L R -- )
    partition
    ( l1 r1 l2 r2 )
    2dup < if recurse 2drop then 2drop
    2dup < if recurse 2drop then 2drop ;

: sort ( array -- )
    array-bounds qsort ;

numbers sort