REBOL[
    Title: "Merge Sort"
    File: %msort.r
    Author: "Ladislav Mecir"
    Date: 6-Sep-2004/13:26:22+1:00
    Purpose: {Merge sort a series}
]

msort: function [a compare] [msort-do merge] [
    if (length? a) < 2 [return a]
    ; define a recursive Msort-do function
    msort-do: function [a b l] [mid] [
        either l < 4 [
            if l = 3 [msort-do next b next a 2]
            merge a b 1 next b l - 1
        ] [
            mid: make integer! l / 2
            msort-do b a mid
            msort-do skip b mid skip a mid l - mid
            merge a b mid skip b mid l - mid
        ]
    ]
    ; function Merge is the key part of the algorithm
    merge: func [a b lb c lc] [
        until [
            either (compare first b first c) [
                change/only a first b
                b: next b
                a: next a
                zero? lb: lb - 1
            ] [
                change/only a first c
                c: next c
                a: next a
                zero? lc: lc - 1
            ]
        ]
        loop lb [
            change/only a first b
            b: next b
            a: next a
        ]
        loop lc [
            change/only a first c
            c: next c
            a: next a
        ]
    ]
    msort-do a copy a length? a
    a
]

comment [
    time: func [] [fourth now]

    ; return random series containing integers
    serf: function [l] [b i] [
        b: make block! l
        for i 1 l 1 [b: insert b random l]
        return head b
    ]

    compare: func [a b] [
        return a <= b
    ]

    foreach size [400000] [
        b: serf size
        start: time
        b: msort b :compare
        finish: time
        print [size (finish - start)]
    ]
]