zOs/REXX/SORT

/* copy sort begin ***************************************************/
sortComparator: procedure expose m.
parse arg cmp, le, ri
    if cmp == '' then
        cmp = '<<='
    if length(cmp) < 6 then
        m.sort_comparator = 'cmp =' le cmp ri
    else if pos(';', cmp) < 1 then
        m.sort_comparator = "aLe =" le"; aRi =" ri"; cmp =" cmp
    else
        m.sort_comparator = "aLe =" le "; aRi =" ri";" cmp
    return
endProcedure sort

sortWords: procedure expose m.
parse arg wrds, cmp
    if words(wrds) <= 1 then
        return strip(wrds)
    m.sort_ii.0 = words(wrds)
    do sx=1 to m.sort_ii.0
        m.sort_ii.sx = word(wrds, sx)
        end
    call sort sort_ii, sort_oo, cmp
    r = m.sort_oo.1
    do sx=2 to m.sort_oo.0
        r = r m.sort_oo.sx
        end
    return r
endProcedure sortWords

sortWordsQ: procedure expose m.
parse arg wrds, cmp
    call sortComparator cmp, 'word(le, lx)', 'word(ri, rx)'
    return strip(sortWord1(wrds))
endProcedure sortWordsQ

sortWord1: procedure expose m.
parse arg wrds
    if words(wrds) <= 1 then
        return wrds
    h = words(wrds) % 2
    le = sortWord1(subWord(wrds, 1, h))
    ri = sortWord1(subWord(wrds, h+1))
    lx = 1
    rx = 1
    res = ''
    do forever
        interpret m.sort_comparator
        if cmp then do
            res = res word(le, lx)
            if lx >= words(le) then
                return res subword(ri, rx)
            lx = lx + 1
            end
        else do
            res = res word(ri, rx)
            if rx >= words(ri) then
                return res subword(le, lx)
            rx = rx + 1
            end
        end
endProcedure sortWord1

sort: procedure expose m.
parse arg i, o, cmp
    call sortComparator cmp, 'm.l.l0', 'm.r.r0'
    call sort1 i, 1, m.i.0, o, 1, sort_work, 1
    m.o.0 = m.i.0
    return
endProcedure sort

sort1: procedure expose m.
parse arg i, i0, le, o, o0, w, w0
    if le <= 3 then do
        if le = 3 then do
            call sortMerge i, i0, i0+1, i, i0+1, i0+2, w, w0
            call sortMerge i, i0+2, i0+3, w, w0, w0+2, o, o0
            end
        else if le = 2 then
            call sortMerge i, i0, i0+1, i, i0+1, i0+2, o, o0
        else if le = 1 then
            m.o.o0 = m.i.i0
        return
        end
    h = (le + 1) % 2
    call sort1 i, i0,   h,    o, o0+le-h, w, w0
    call sort1 i, i0+h, le-h, w, w0,      o, o0
    call sortMerge o, o0+le-h, o0+le, w, w0, w0+le-h, o, o0
    return
endProcedure sort1

sortMerge: procedure expose m.
parse arg l, l0, le, r, r0, re, o, o0
    do while l0 < le & r0 < re
        interpret m.sort_comparator
        if cmp then do
            m.o.o0 = m.l.l0
            l0 = l0 + 1
            end
        else do
            m.o.o0 = m.r.r0
            r0 = r0 + 1
            end
        o0 = o0 + 1
        end
    do while l0 < le
        m.o.o0 = m.l.l0
        l0 = l0 + 1
        o0 = o0 + 1
        end
    do while r0 < re
        m.o.o0 = m.r.r0
        r0 = r0 + 1
        o0 = o0 + 1
        end
    return
endProcedure sortMerge
/* copy sort end   ***************************************************/