Improved TPK

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