! Copyright (C) 2009 Richard Osborn.
! See http://factorcode.org/license.txt for BSD license.
USING:  kernel combinators combinators.short-circuit generalizations
        sequences arrays math ;
IN: qsort

: choose-pivot ( seq -- pivot ) 0 swap nth ;

: partition ( pivot seq -- <lowslice> <highslice> )
    dup length 1 - 0 0 rot
    [ 2dup <= ] [
        {
            { [ over 5 npick nth 6 npick < ] [
                2over 6 npick exchange
                [ [ 1 + ] bi@ ] dip ] }
            { [ over 5 npick nth 6 npick > ] [
                2dup 6 npick exchange
                1 - ] }
            [ [ 1 + ] dip ]
        } cond
    ] while
    drop
    [ drop 0 spin <slice> ]
    [ nip over length rot <slice> ] 3bi rot drop
;

: insertion-sort ( seq -- )
    1                                               ! seq i
    over length 1 -                                 ! seq i len-
    [                                               ! seq i
        2dup swap nth 2over                         ! seq i key seq j
        [   3dup
            {   [ 2nip 0 > ]                        ! j > 0 ?
                [ 1 - swap nth < ]                  ! key < seq[j-1] ?
            } 3&& ]
        [
            dup 1 - pick nth 2over swap set-nth     ! seq[j-1] =
            1 -                                     ! j-1
        ] while
        swap set-nth                                ! seq[j] = key
        1 +                                         ! seq i+
    ] times                                         ! seq i
    2drop                                           ! 
;


: qsort ( seq -- )
    dup length 8 < [
        insertion-sort
    ] [
        dup choose-pivot swap partition
        [ qsort ] bi@
    ] if
; recursive