lsort -index 0 -ascii $list

# We will begin by extracting the five list elements into variables ''p0''..''p4'', and the five sort keys into ''x0''..''x4''. The generated code will use these variables.

# The ''sort5'' code will be too long for us to want to write it out in longhand, so let's write some Tcl code to generate it, instead.  We start with some basics.  We're going to want the generated code to be nicely indented.  It turns out that the indentation will closely track the level of recursion in the Tcl code that will write the ''sort5'' procedure, so we can use the following little procedure to make the spaces at the beginning of a line.

 proc indent {} {
    return [format {%*s} [expr { 4 * [info level] - 12 }] {}]
 }

# The generated code is going to have a nest of constucts that all look like:
# if { [string compare $x1 $x2] <= 0 } {
#     ... code ...
# } else {
#     ... more code ...
# }
# The <= operator will be replaced with < if x2 preceded x1 in the original list.  This replacement will guarantee stability.  Here are procedures to generate the comparisons:

 proc emitCompare { v0 v1 codeVar } {
    upvar 1 $codeVar code
    append code [indent] {if } \{ \[ {string compare $x} $v0 { $x} $v1 \]
    if { $v0 < $v1 } {
        append code { <= }
    } else {
        append code { < }
    }
    append code {0 } \} { } \{ \n
 }
 proc emitElse { codeVar } {
    upvar 1 $codeVar code
    append code [indent] \} { else } \{ \n
 }
 proc emitEndIf { codeVar } {
    upvar 1 $codeVar code
    append code [indent] \} \n
 }

# We also need to generate a [[return]] command to sort the list once the correct order of elements is known:

 proc emitReturn { a b c d e codeVar } {
    upvar 1 $codeVar code
    append code [indent] {    return } \[ {list $p} $a { $p} $b { $p} $c \
        { $p} $d { $p} $e \] \n
 }

# With these preliminaries out of the way, here's the procedure that makes 'sort5'.  It has the variable extraction code; everything else happens in 'pair0', which follows it:

 proc makeSort5Proc {} {
    set code {}
    append code {proc sort5 { list } } \{ \n
    for { set i 0 } { $i < 5 } { incr i } {
        append code \
            {    set x} $i { [lindex [set p} $i { [lindex $list } $i {]] 0]} \n
    }
    pair0 code
    append code \} \n
    return $code
 }

# On entry to the code generated by 'pair0', nothing is known about the order of the elements. 'pair0' compare elements 0 and 1, and calls 'pair1' with the element indices correctly ordered:

 proc pair0 { codeVar } {
   upvar 1 $codeVar code
    emitCompare 0 1 code
    pair1 0 1 code
    emitElse code
    pair1 1 0 code
    emitEndIf code
 }

# On entry to 'pair1', it is known that the element at index ''a'' precedes the element at index ''b''. Nothing else is known.  The 'pair1' procedure compares elements 2 and 3, and calls 'pair2' with the results:

 proc pair1 { a b codeVar } {
    upvar 1 $codeVar code
    emitCompare 2 3 code
    pair2 $a $b 2 3 code
    emitElse code
    pair2 $a $b 3 2 code
    emitEndIf code
 }

# On entry to 'pair2', it is known that the element at index ''a'' precedes the one at index ''b'' and that the one at index ''c'' precedes the one at index ''d''. Nothing has yet examined element 4. The 'pair2' procedure compares elements ''b'' and ''d'', and calls 'place5' with the results.

 proc pair2 { a b c d codeVar } {
    upvar 1 $codeVar code
    emitCompare $b $d code
    place5 $a $b $c $d code
    emitElse code
    place5 $c $d $a $b code
    emitEndIf code
 }

# After three comparisons, things begin to get interesting. Let's represent the relationships by connecting the elements with lines. If element ''a'' is known to precede element ''b'', then a line joins ''a'' and ''b'' with ''a'' at the left end. What's known so far is:
#     b---d
#    /   /
#   a   c
# Nothing is known about element 4. Our next plan is to use binary search to insert it into the chain of elements ''a'', ''b'' and ''d'', so we begin by comparing it with element ''b''.

 proc place5 { a b c d codeVar } { 
     upvar 1 $codeVar code
     emitCompare 4 $b code
     place5a $a $b $c $d code
     emitElse code
     place5b $a $b $c $d code
     emitEndIf code
 }

# We now have done four comparisons, and established the relationships:
 #    a---b---d
 #       /   /
 #      4   c
# Continue the binary search by comparing element 4 against element ''a''.

 proc place5a { a b c d codeVar } {
     upvar 1 $codeVar code
     emitCompare 4 $a code
     insert3 4 $a $b $d $c code
     emitElse code
     insert3 $a 4 $b $d $c code
     emitEndIf code
 }

# In this procedure, we have done four comparisons, and established the relationships:
#          4
#         /
#    a---b---d 
#           /
#          c
# Continue the binary search by comparing element 4 agains element ''d''.

 proc place5b { a b c d codeVar } {
     upvar 1 $codeVar code
     emitCompare 4 $d code
     insert3 $a $b 4 $d $c code
     emitElse code
     insert2 $a $b $d 4 $c code
     emitEndIf code
 }

# Five comparisons have completed the binary search that inserts the last element into a three-element chain. We now have the relationships:
#    a---b---c---d
#               /
#              e
# We start another binary search to insert element ''e'' into the chain
# formed by elements ''a'', ''b'' and ''c''. Once again, things begin by
# comparing it against the middle element ''b'':

 proc insert3 { a b c d e codeVar } {
     upvar 1 $codeVar code
     emitCompare $e $b code
     insert3a $a $b $c $d $e code
     emitElse code
     insert3b $a $b $c $d $e code
     emitEndIf code
 }

# Six comparisons have established:
#    a---b---c---d
#       /
#      e
# One more comparison determines the sequence.

 proc insert3a { a b c d e codeVar } {
     upvar 1 $codeVar code
     emitCompare $e $a code
     emitReturn $e $a $b $c $d code
     emitElse code
     emitReturn $a $e $b $c $d code
     emitEndIf code
 }

# Six comparisons have established:
#         c
#        / \ 
#   a---b   d
#        \ /
#         e
# One more comparison determines the order of ''c'' and ''e''.

 proc insert3b { a b c d e codeVar } {
     upvar 1 $codeVar code
     emitCompare $e $c code
     emitReturn $a $b $e $c $d code
     emitElse code
     emitReturn $a $b $c $e $d code
     emitEndIf code
 }

# The next procedure handles the (lucky) case where five comparisons establish the relationships:
#    a---b---c---d
#           /
#          e
# Compare ''e'' against ''b'', then against ''a'' if necessary.

 proc insert2 { a b c d e codeVar } {
     upvar 1 $codeVar code
     emitCompare $e $b code
     insert3a $a $b $c $d $e code
     emitElse code
     emitReturn $a $b $e $c $d code
     emitEndIf code
 }

# A call to [[makeSort5Proc]] finishes the job:
 eval [makeSort5Proc]

 proc sort5 { list } {
    set x0 [lindex [set p0 [lindex $list 0]] 0]
    set x1 [lindex [set p1 [lindex $list 1]] 0]
    set x2 [lindex [set p2 [lindex $list 2]] 0]
    set x3 [lindex [set p3 [lindex $list 3]] 0]
    set x4 [lindex [set p4 [lindex $list 4]] 0]
    if {[string compare $x0 $x1] <= 0 } {
        if {[string compare $x2 $x3] <= 0 } {
            if {[string compare $x1 $x3] <= 0 } {
                if {[string compare $x4 $x1] < 0 } {
                    if {[string compare $x4 $x0] < 0 } {
                        if {[string compare $x2 $x0] < 0 } {
                            if {[string compare $x2 $x4] <= 0 } {
                             return [list $p2 $p4 $p0 $p1 $p3]
                            } else {
                             return [list $p4 $p2 $p0 $p1 $p3]
                            }
                        } else {
                            if {[string compare $x2 $x1] < 0 } {
                             return [list $p4 $p0 $p2 $p1 $p3]
                            } else {
                             return [list $p4 $p0 $p1 $p2 $p3]
                            }
                        }
                    } else {
                        if {[string compare $x2 $x4] <= 0 } {
                            if {[string compare $x2 $x0] < 0 } {
                             return [list $p2 $p0 $p4 $p1 $p3]
                            } else {
                             return [list $p0 $p2 $p4 $p1 $p3]
                            }
 . . .