\ Wil Baden's sorter, 4tH version
\ Set PRECEDES for different datatypes or sort order.

[UNDEFINED] SORT     [IF]
[UNDEFINED] PRECEDES [IF]
DEFER PRECEDES                         ( addr addr -- flag )
[THEN]                                 \ compatible with QSORT

: EXCHANGE                             ( addr_1 addr_2 -- )
    DUP @ >R  OVER @ SWAP !  R> SWAP ! ;

: PARTITION                            ( lo hi -- lo_1 hi_1 lo_2 hi_2 )
    2DUP OVER - 2/ -1 CELLS AND +  @ >R  ( R: median)
    2DUP BEGIN                         ( lo_1 hi_2 lo_2 hi_1)
         SWAP BEGIN  DUP @ R@   PRECEDES WHILE  CELL+  REPEAT
         SWAP BEGIN  R@ OVER @  PRECEDES WHILE  CELL-  REPEAT
         2DUP > NOT IF  2DUP EXCHANGE  >R CELL+ R> CELL-  THEN
    2DUP > UNTIL                       ( lo_1 hi_2 lo_2 hi_1)
    R> DROP SWAP ROT                   ( lo_1 hi_1 lo_2 hi_2)
    ;

: QSORT                                ( lo hi -- )
    PARTITION                          ( lo_1 hi_1 lo_2 hi_2)
    2>R 2DUP 2R> 2SWAP 2>R 2DUP 2R> 2SWAP - +
         < IF  2SWAP  THEN             ( lo_1 hi_1 lo_2 hi_2)
    2DUP < IF  RECURSE  ELSE  2DROP  THEN
    2DUP < IF  RECURSE  ELSE  2DROP  THEN ;

: SORT                                 ( addr n -- )
    DUP 2 < IF  2DROP  EXIT THEN
    1- CELLS OVER + ( addr addr+{n-1}cells) QSORT  ;

[DEFINED] 4TH# [IF]
hide EXCHANGE
hide PARTITION
hide QSORT
[THEN]
[THEN]
