Quicksort (Forth)

From LiteratePrograms

This simple recursive quicksort was originally designed by Wil Baden in 1983 to fit into one block (a 64x16 screenful of code). It sorts an array of cell-sized items (which could be pointers to larger data structures) using a late-bound comparison function lessthan.

The commented bit in qsort is an optimization to process the partition containing fewer items first. It may improve average stack usage if your flavor of Forth does tail-recursion elimination.

<<util>>=
-1 cells constant -cell
: cell-   -cell + ;

<<sort>>=
defer lessthan ( a@ b@ -- ? )   ' < is lessthan

: mid ( l r -- mid ) over - 2/ -cell and + ;

: exch ( addr1 addr2 -- ) dup @ >r over @ swap ! r> swap ! ;

: part ( l r -- l r r2 l2 )
  2dup mid @ >r ( r: pivot )
  2dup begin
    swap begin dup @  r@ lessthan while cell+ repeat
    swap begin r@ over @ lessthan while cell- repeat
    2dup <= if 2dup exch >r cell+ r> cell- then
  2dup > until  r> drop ;

: qsort ( l r -- )
  part  swap rot
  \ 2over 2over - + < if 2swap then
  2dup < if recurse else 2drop then
  2dup < if recurse else 2drop then ;

: sort ( array len -- )
  dup 2 < if 2drop exit then
  1- cells over + qsort ;

This tests the quicksort routine by sorting an array of ten numbers.

<<quicksort.fs>>=
util
sort
create test 4 , 7 ,  1 , 0 , 3 , 9 , 6 , 8 , 2 , 5 ,

: main
  test 10 sort
  10 0 do test i cells + @ . loop cr ;

main bye