Improved TPK

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