zpg, sorting intern

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

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

defer partition-compare
' < is partition-compare 

: partition ( L R -- L1 R1 L2 R2 )
    2dup
    2dup pivot-value >r
    begin 2dup <= while
	    swap ( r l ) begin dup @  r@ partition-compare while cell+ repeat
	    swap ( l r ) begin r@ over @ partition-compare while cell- repeat
	    2dup <= if
		2dup exchange
		cell- swap cell+ swap then repeat
    r> drop
    ( L1 R2 L2 R1 )
    swap rot ;

: qsort ( L R -- )
    begin  2dup < while  partition recurse  repeat  2drop ;

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