Sorting algorithms/Merge sort: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎[[Merge sort#ALGOL 68]]: add {{trans|python}})
m (→‎{{header|Standard ML}}: minor reformat of SML and extra example)
 
(431 intermediate revisions by more than 100 users not shown)
Line 1: Line 1:
{{task|Sorting Algorithms}}
{{task|Sorting Algorithms}}{{Sorting Algorithm}}[[Category:Recursion]]The '''merge sort''' is a recursive sort of order n*log(n) (technically n*lg(n)--lg is log base 2) sort. It is notable for having no worst case. It is ''always O(n*log(n))''. The basic idea is to split the collection into smaller groups by halving it until the groups only have one element or no elements (which are both entirely sorted groups). Then merge the groups back together so that their elements are in order. This is how the algorithm gets its "divide and conquer" description.
{{Sorting Algorithm}}
[[Category:Sorting]]
[[Category:Recursion]]


The &nbsp; '''merge sort''' &nbsp; is a recursive sort of order &nbsp; <big> n*log(n). </big>
Write a function to sort a collection of integers using the merge sort. The merge sort algorithm comes in two parts: a sort function and a merge function. The functions in pseudocode look like this:

function mergesort(m)
It is notable for having a worst case and average complexity of &nbsp; <big> ''O(n*log(n))'', </big> &nbsp; and a best case complexity of &nbsp; <big> ''O(n)'' &nbsp; </big> (for pre-sorted input).
var list left, right, result

if length(m) ≤ 1
The basic idea is to split the collection into smaller groups by halving it until the groups only have one element or no elements &nbsp; (which are both entirely sorted groups).
return m

else
Then merge the groups back together so that their elements are in order.
var middle = length(m) / 2
for each x in m up to middle - 1
This is how the algorithm gets its &nbsp; ''divide and conquer'' &nbsp; description.
add x to left

for each x in m at and after middle

add x to right
;Task:
Write a function to sort a collection of integers using the merge sort.


The merge sort algorithm comes in two parts:
a sort function and
a merge function

The functions in pseudocode look like this:
'''function''' ''mergesort''(m)
'''var''' list left, right, result
'''if''' length(m) ≤ 1
'''return''' m
'''else'''
'''var''' middle = length(m) / 2
'''for each''' x '''in''' m '''up to''' middle - 1
'''add''' x '''to''' left
'''for each''' x '''in''' m '''at and after''' middle
'''add''' x '''to''' right
left = mergesort(left)
left = mergesort(left)
right = mergesort(right)
right = mergesort(right)
'''if''' last(left) ≤ first(right)
'''append''' right '''to''' left
'''return''' left
result = merge(left, right)
result = merge(left, right)
return result
'''return''' result

function merge(left,right)
'''function''' ''merge''(left,right)
var list result
'''var''' list result
while length(left) > 0 and length(right) > 0
'''while''' length(left) > 0 and length(right) > 0
if first(left) ≤ first(right)
'''if''' first(left) ≤ first(right)
append first(left) to result
'''append''' first(left) '''to''' result
left = rest(left)
left = rest(left)
else
'''else'''
append first(right) to result
'''append''' first(right) '''to''' result
right = rest(right)
right = rest(right)
if length(left) > 0
'''if''' length(left) > 0
append rest(left) to result
'''append''' rest(left) '''to''' result
if length(right) > 0
'''if''' length(right) > 0
append rest(right) to result
'''append''' rest(right) '''to''' result
return result
'''return''' result


;See also:
* &nbsp; the Wikipedia entry: &nbsp; [[wp:Merge_sort| merge sort]]


Note: &nbsp; better performance can be expected if, rather than recursing until &nbsp; <big> length(m) ≤ 1, </big> &nbsp; an insertion sort is used for &nbsp; <big> length(m) </big> &nbsp; smaller than some threshold larger than &nbsp; '''1'''. &nbsp; However, this complicates the example code, so it is not shown here.
<br><br>

=={{header|11l}}==
{{trans|Python}}

<syntaxhighlight lang="11l">F merge(left, right)
[Int] result
V left_idx = 0
V right_idx = 0
L left_idx < left.len & right_idx < right.len
I left[left_idx] <= right[right_idx]
result.append(left[left_idx])
left_idx++
E
result.append(right[right_idx])
right_idx++

I left_idx < left.len
result.extend(left[left_idx ..])
I right_idx < right.len
result.extend(right[right_idx ..])
R result

F merge_sort(m)
I m.len <= 1
R m

V middle = m.len I/ 2
V left = m[0.<middle]
V right = m[middle..]

left = merge_sort(left)
right = merge_sort(right)
R Array(merge(left, right))

V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
print(merge_sort(arr))</syntaxhighlight>

{{out}}
<pre>
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
</pre>

=={{header|360 Assembly}}==
{{trans|BBC BASIC}}
The program uses ASM structured macros and two ASSIST macros (XDECO, XPRNT) to keep the code as short as possible.
<syntaxhighlight lang="360asm">* Merge sort 19/06/2016
MAIN CSECT
STM R14,R12,12(R13) save caller's registers
LR R12,R15 set R12 as base register
USING MAIN,R12 notify assembler
LA R11,SAVEXA get the address of my savearea
ST R13,4(R11) save caller's save area pointer
ST R11,8(R13) save my save area pointer
LR R13,R11 set R13 to point to my save area
LA R1,1 1
LA R2,NN hbound(a)
BAL R14,SPLIT call split(1,hbound(a))
LA RPGI,PG pgi=0
LA RI,1 i=1
DO WHILE=(C,RI,LE,=A(NN)) do i=1 to hbound(a)
LR R1,RI i
SLA R1,2 .
L R2,A-4(R1) a(i)
XDECO R2,XDEC edit a(i)
MVC 0(4,RPGI),XDEC+8 output a(i)
LA RPGI,4(RPGI) pgi=pgi+4
LA RI,1(RI) i=i+1
ENDDO , end do
XPRNT PG,80 print buffer
L R13,SAVEXA+4 restore caller's savearea address
LM R14,R12,12(R13) restore caller's registers
XR R15,R15 set return code to 0
BR R14 return to caller
* split(istart,iend) ------recursive---------------------
SPLIT STM R14,R12,12(R13) save all registers
LR R9,R1 save R1
LA R1,72 amount of storage required
GETMAIN RU,LV=(R1) allocate storage for stack
USING STACK,R10 make storage addressable
LR R10,R1 establish stack addressability
LA R11,SAVEXB get the address of my savearea
ST R13,4(R11) save caller's save area pointer
ST R11,8(R13) save my save area pointer
LR R13,R11 set R13 to point to my save area
LR R1,R9 restore R1
LR RSTART,R1 istart=R1
LR REND,R2 iend=R2
IF CR,REND,EQ,RSTART THEN if iend=istart
B RETURN return
ENDIF , end if
BCTR R2,0 iend-1
IF C,R2,EQ,RSTART THEN if iend-istart=1
LR R1,REND iend
SLA R1,2 .
L R2,A-4(R1) a(iend)
LR R1,RSTART istart
SLA R1,2 .
L R3,A-4(R1) a(istart)
IF CR,R2,LT,R3 THEN if a(iend)<a(istart)
LR R1,RSTART istart
SLA R1,2 .
LA R2,A-4(R1) @a(istart)
LR R1,REND iend
SLA R1,2 .
LA R3,A-4(R1) @a(iend)
MVC TEMP,0(R2) temp=a(istart)
MVC 0(4,R2),0(R3) a(istart)=a(iend)
MVC 0(4,R3),TEMP a(iend)=temp
ENDIF , end if
B RETURN return
ENDIF , end if
LR RMIDDL,REND iend
SR RMIDDL,RSTART iend-istart
SRA RMIDDL,1 (iend-istart)/2
AR RMIDDL,RSTART imiddl=istart+(iend-istart)/2
LR R1,RSTART istart
LR R2,RMIDDL imiddl
BAL R14,SPLIT call split(istart,imiddl)
LA R1,1(RMIDDL) imiddl+1
LR R2,REND iend
BAL R14,SPLIT call split(imiddl+1,iend)
LR R1,RSTART istart
LR R2,RMIDDL imiddl
LR R3,REND iend
BAL R14,MERGE call merge(istart,imiddl,iend)
RETURN L R13,SAVEXB+4 restore caller's savearea address
XR R15,R15 set return code to 0
LA R0,72 amount of storage to free
FREEMAIN A=(R10),LV=(R0) free allocated storage
L R14,12(R13) restore caller's return address
LM R2,R12,28(R13) restore registers R2 to R12
BR R14 return to caller
DROP R10 base no longer needed
* merge(jstart,jmiddl,jend) ------------------------------------
MERGE STM R1,R3,JSTART jstart=r1,jmiddl=r2,jend=r3
SR R2,R1 jmiddl-jstart
LA RBS,2(R2) bs=jmiddl-jstart+2
LA RI,1 i=1
LR R3,RBS bs
BCTR R3,0 bs-1
DO WHILE=(CR,RI,LE,R3) do i=0 to bs-1
L R2,JSTART jstart
AR R2,RI jstart+i
SLA R2,2 .
L R2,A-8(R2) a(jstart+i-1)
LR R1,RI i
SLA R1,2 .
ST R2,B-4(R1) b(i)=a(jstart+i-1)
LA RI,1(RI) i=i+1
ENDDO , end do
LA RI,1 i=1
L RJ,JMIDDL j=jmiddl
LA RJ,1(RJ) j=jmiddl+1
L RK,JSTART k=jstart
DO UNTIL=(CR,RI,EQ,RBS,OR, do until i=bs or X
C,RJ,GT,JEND) j>jend
LR R1,RI i
SLA R1,2 .
L R4,B-4(R1) r4=b(i)
LR R1,RJ j
SLA R1,2 .
L R3,A-4(R1) r3=a(j)
LR R9,RK k
SLA R9,2 r9 for a(k)
IF CR,R4,LE,R3 THEN if b(i)<=a(j)
ST R4,A-4(R9) a(k)=b(i)
LA RI,1(RI) i=i+1
ELSE , else
ST R3,A-4(R9) a(k)=a(j)
LA RJ,1(RJ) j=j+1
ENDIF , end if
LA RK,1(RK) k=k+1
ENDDO , end do
DO WHILE=(CR,RI,LT,RBS) do while i<bs
LR R1,RI i
SLA R1,2 .
L R2,B-4(R1) b(i)
LR R1,RK k
SLA R1,2 .
ST R2,A-4(R1) a(k)=b(i)
LA RI,1(RI) i=i+1
LA RK,1(RK) k=k+1
ENDDO , end do
BR R14 return to caller
* ------- ------------------ ------------------------------------
LTORG
SAVEXA DS 18F savearea of main
NN EQU ((B-A)/L'A) number of items
A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
B DS (NN/2+1)F merge sort static storage
TEMP DS F for swap
JSTART DS F jstart
JMIDDL DS F jmiddl
JEND DS F jend
PG DC CL80' ' buffer
XDEC DS CL12 for edit
STACK DSECT dynamic area
SAVEXB DS 18F " savearea of mergsort (72 bytes)
YREGS
RI EQU 6 i
RJ EQU 7 j
RK EQU 8 k
RSTART EQU 6 istart
REND EQU 7 i
RMIDDL EQU 8 i
RPGI EQU 3 pgi
RBS EQU 0 bs
END MAIN</syntaxhighlight>
{{out}}
<pre>
-31 0 1 2 2 4 45 58 65 69 74 82 82 83 88 89 99 104 112 782
</pre>

=={{header|AArch64 Assembly}}==
{{works with|as|Raspberry Pi 3B version Buster 64 bits}}
<syntaxhighlight lang="aarch64 assembly">
/* ARM assembly AARCH64 Raspberry PI 3B */
/* program mergeSort64.s */
/*******************************************/
/* Constantes file */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"

/*********************************/
/* Initialized data */
/*********************************/
.data
szMessSortOk: .asciz "Table sorted.\n"
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
sMessResult: .asciz "Value : @ \n"
szCarriageReturn: .asciz "\n"
.align 4
TableNumber: .quad 1,3,11,6,2,5,9,10,8,4,7
#TableNumber: .quad 10,9,8,7,6,-5,4,3,2,1
.equ NBELEMENTS, (. - TableNumber) / 8
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: // entry of program
ldr x0,qAdrTableNumber // address number table
mov x1,0 // first element
mov x2,NBELEMENTS // number of élements
bl mergeSort
ldr x0,qAdrTableNumber // address number table
bl displayTable
ldr x0,qAdrTableNumber // address number table
mov x1,NBELEMENTS // number of élements
bl isSorted // control sort
cmp x0,1 // sorted ?
beq 1f
ldr x0,qAdrszMessSortNok // no !! error sort
bl affichageMess
b 100f
1: // yes
ldr x0,qAdrszMessSortOk
bl affichageMess
100: // standard end of the program
mov x0,0 // return code
mov x8,EXIT // request to exit program
svc 0 // perform the system call
qAdrsZoneConv: .quad sZoneConv
qAdrszCarriageReturn: .quad szCarriageReturn
qAdrsMessResult: .quad sMessResult
qAdrTableNumber: .quad TableNumber
qAdrszMessSortOk: .quad szMessSortOk
qAdrszMessSortNok: .quad szMessSortNok
/******************************************************************/
/* control sorted table */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements > 0 */
/* x0 return 0 if not sorted 1 if sorted */
isSorted:
stp x2,lr,[sp,-16]! // save registers
stp x3,x4,[sp,-16]! // save registers
mov x2,0
ldr x4,[x0,x2,lsl 3]
1:
add x2,x2,1
cmp x2,x1
bge 99f
ldr x3,[x0,x2, lsl 3]
cmp x3,x4
blt 98f
mov x4,x3
b 1b
98:
mov x0,0 // not sorted
b 100f
99:
mov x0,1 // sorted
100:
ldp x3,x4,[sp],16 // restaur 2 registers
ldp x2,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* merge */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains second start index */
/* r3 contains the last index */
merge:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
str x8,[sp,-16]!
mov x5,x2 // init index x2->x5
1: // begin loop first section
ldr x6,[x0,x1,lsl 3] // load value first section index r1
ldr x7,[x0,x5,lsl 3] // load value second section index r5
cmp x6,x7
ble 4f // <= -> location first section OK
str x7,[x0,x1,lsl 3] // store value second section in first section
add x8,x5,1
cmp x8,x3 // end second section ?
ble 2f
str x6,[x0,x5,lsl 3]
b 4f // loop
2: // loop insert element part 1 into part 2
sub x4,x8,1
ldr x7,[x0,x8,lsl 3] // load value 2
cmp x6,x7 // value <
bge 3f
str x6,[x0,x4,lsl 3] // store value
b 4f // loop
3:
str x7,[x0,x4,lsl 3] // store value 2
add x8,x8,1
cmp x8,x3 // end second section ?
ble 2b // no loop
sub x8,x8,1
str x6,[x0,x8,lsl 3] // store value 1
4:
add x1,x1,1
cmp x1,x2 // end first section ?
blt 1b

100:
ldr x8,[sp],16 // restaur 1 register
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/******************************************************************/
/* merge sort */
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the index of first element */
/* x2 contains the number of element */
mergeSort:
stp x3,lr,[sp,-16]! // save registers
stp x4,x5,[sp,-16]! // save registers
stp x6,x7,[sp,-16]! // save registers
cmp x2,2 // end ?
blt 100f
lsr x4,x2,1 // number of element of each subset
add x5,x4,1
tst x2,#1 // odd ?
csel x4,x5,x4,ne
mov x5,x1 // save first element
mov x6,x2 // save number of element
mov x7,x4 // save number of element of each subset
mov x2,x4
bl mergeSort
mov x1,x7 // restaur number of element of each subset
mov x2,x6 // restaur number of element
sub x2,x2,x1
mov x3,x5 // restaur first element
add x1,x1,x3 // + 1
bl mergeSort // sort first subset
mov x1,x5 // restaur first element
mov x2,x7 // restaur number of element of each subset
add x2,x2,x1
mov x3,x6 // restaur number of element
add x3,x3,x1
sub x3,x3,1 // last index
bl merge
100:
ldp x6,x7,[sp],16 // restaur 2 registers
ldp x4,x5,[sp],16 // restaur 2 registers
ldp x3,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30

/******************************************************************/
/* Display table elements */
/******************************************************************/
/* x0 contains the address of table */
displayTable:
stp x1,lr,[sp,-16]! // save registers
stp x2,x3,[sp,-16]! // save registers
mov x2,x0 // table address
mov x3,0
1: // loop display table
ldr x0,[x2,x3,lsl 3]
ldr x1,qAdrsZoneConv
bl conversion10S // décimal conversion
ldr x0,qAdrsMessResult
ldr x1,qAdrsZoneConv
bl strInsertAtCharInc // insert result at // character
bl affichageMess // display message
add x3,x3,1
cmp x3,NBELEMENTS - 1
ble 1b
ldr x0,qAdrszCarriageReturn
bl affichageMess
mov x0,x2
100:
ldp x2,x3,[sp],16 // restaur 2 registers
ldp x1,lr,[sp],16 // restaur 2 registers
ret // return to address lr x30
/********************************************************/
/* File Include fonctions */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"
</syntaxhighlight>
=={{header|ACL2}}==

<syntaxhighlight lang="lisp">(defun split (xys)
(if (endp (rest xys))
(mv xys nil)
(mv-let (xs ys)
(split (rest (rest xys)))
(mv (cons (first xys) xs)
(cons (second xys) ys)))))

(defun mrg (xs ys)
(declare (xargs :measure (+ (len xs) (len ys))))
(cond ((endp xs) ys)
((endp ys) xs)
((< (first xs) (first ys))
(cons (first xs) (mrg (rest xs) ys)))
(t (cons (first ys) (mrg xs (rest ys))))))

(defthm split-shortens
(implies (consp (rest xs))
(mv-let (ys zs)
(split xs)
(and (< (len ys) (len xs))
(< (len zs) (len xs))))))

(defun msort (xs)
(declare (xargs
:measure (len xs)
:hints (("Goal"
:use ((:instance split-shortens))))))
(if (endp (rest xs))
xs
(mv-let (ys zs)
(split xs)
(mrg (msort ys)
(msort zs)))))</syntaxhighlight>

=={{header|Action!}}==
Action! language does not support recursion. Therefore an iterative approach has been proposed.
<syntaxhighlight lang="action!">DEFINE MAX_COUNT="100"

PROC PrintArray(INT ARRAY a INT size)
INT i

Put('[)
FOR i=0 TO size-1
DO
IF i>0 THEN Put(' ) FI
PrintI(a(i))
OD
Put(']) PutE()
RETURN

PROC Merge(INT ARRAY a INT first,mid,last)
INT ARRAY left(MAX_COUNT),right(MAX_COUNT)
INT leftSize,rightSize,i,j,k
leftSize=mid-first+1
rightSize=last-mid
FOR i=0 TO leftSize-1
DO
left(i)=a(first+i)
OD
FOR i=0 TO rightSize-1
DO
right(i)=a(mid+1+i)
OD
i=0 j=0
k=first
WHILE i<leftSize AND j<rightSize
DO
IF left(i)<=right(j) THEN
a(k)=left(i)
i==+1
ELSE
a(k)=right(j)
j==+1
FI
k==+1
OD
WHILE i<leftSize
DO
a(k)=left(i)
i==+1 k==+1
OD
WHILE j<rightSize
DO
a(k)=right(j)
j==+1 k==+1
OD
RETURN

PROC MergeSort(INT ARRAY a INT size)
INT currSize,first,mid,last

currSize=1
WHILE currSize<size
DO
first=0
WHILE first<size-1
DO
mid=first+currSize-1
IF mid>size-1 THEN
mid=size-1
FI
last=first+2*currSize-1
IF last>size-1 THEN
last=size-1
FI
Merge(a,first,mid,last);

first==+2*currSize
OD
currSize==*2
OD
RETURN

PROC Test(INT ARRAY a INT size)
PrintE("Array before sort:")
PrintArray(a,size)
MergeSort(a,size)
PrintE("Array after sort:")
PrintArray(a,size)
PutE()
RETURN

PROC Main()
INT ARRAY
a(10)=[1 4 65535 0 3 7 4 8 20 65530],
b(21)=[10 9 8 7 6 5 4 3 2 1 0
65535 65534 65533 65532 65531
65530 65529 65528 65527 65526],
c(8)=[101 102 103 104 105 106 107 108],
d(12)=[1 65535 1 65535 1 65535 1
65535 1 65535 1 65535]
Test(a,10)
Test(b,21)
Test(c,8)
Test(d,12)
RETURN</syntaxhighlight>
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Merge_sort.png Screenshot from Atari 8-bit computer]
<pre>
Array before sort:
[1 4 -1 0 3 7 4 8 20 -6]
Array after sort:
[-6 -1 0 1 3 4 4 7 8 20]

Array before sort:
[10 9 8 7 6 5 4 3 2 1 0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10]
Array after sort:
[-10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 8 9 10]

Array before sort:
[101 102 103 104 105 106 107 108]
Array after sort:
[101 102 103 104 105 106 107 108]

Array before sort:
[1 -1 1 -1 1 -1 1 -1 1 -1 1 -1]
Array after sort:
[-1 -1 -1 -1 -1 -1 1 1 1 1 1 1]
</pre>

=={{header|ActionScript}}==
<syntaxhighlight lang="actionscript">function mergesort(a:Array)
{
//Arrays of length 1 and 0 are always sorted
if(a.length <= 1) return a;
else
{
var middle:uint = a.length/2;
//split the array into two
var left:Array = new Array(middle);
var right:Array = new Array(a.length-middle);
var j:uint = 0, k:uint = 0;
//fill the left array
for(var i:uint = 0; i < middle; i++)
left[j++]=a[i];
//fill the right array
for(i = middle; i< a.length; i++)
right[k++]=a[i];
//sort the arrays
left = mergesort(left);
right = mergesort(right);
//If the last element of the left array is less than or equal to the first
//element of the right array, they are in order and don't need to be merged
if(left[left.length-1] <= right[0])
return left.concat(right);
a = merge(left, right);
return a;
}
}

function merge(left:Array, right:Array)
{
var result:Array = new Array(left.length + right.length);
var j:uint = 0, k:uint = 0, m:uint = 0;
//merge the arrays in order
while(j < left.length && k < right.length)
{
if(left[j] <= right[k])
result[m++] = left[j++];
else
result[m++] = right[k++];
}
//If one of the arrays has remaining entries that haven't been merged, they
//will be greater than the rest of the numbers merged so far, so put them on the
//end of the array.
for(; j < left.length; j++)
result[m++] = left[j];
for(; k < right.length; k++)
result[m++] = right[k];
return result;
}</syntaxhighlight>


=={{header|Ada}}==
=={{header|Ada}}==
This example creates a generic package for sorting arrays of any type. Ada allows array indices to be any discrete type, including enumerated types which are non-numeric. Furthermore, numeric array indices can start at any value, positive, negative, or zero. The following code handles all the possible variations in index types.
This example creates a generic package for sorting arrays of any type. Ada allows array indices to be any discrete type, including enumerated types which are non-numeric. Furthermore, numeric array indices can start at any value, positive, negative, or zero. The following code handles all the possible variations in index types.
<syntaxhighlight lang="ada">generic
<ada>
generic
type Element_Type is private;
type Element_Type is private;
type Index_Type is (<>);
type Index_Type is (<>);
Line 43: Line 726:
package Mergesort is
package Mergesort is
function Sort(Item : Collection_Type) return Collection_Type;
function Sort(Item : Collection_Type) return Collection_Type;
end MergeSort;
end MergeSort;</syntaxhighlight>
</ada>


<syntaxhighlight lang="ada">package body Mergesort is
<ada>
package body Mergesort is
-----------
-----------
Line 60: Line 741:
begin
begin
while Left_Index <= Left'Last and Right_Index <= Right'Last loop
while Left_Index <= Left'Last and Right_Index <= Right'Last loop
if Left(Left_Index) < Right(Right_Index) then
if Left(Left_Index) <= Right(Right_Index) then
Result(Result_Index) := Left(Left_Index);
Result(Result_Index) := Left(Left_Index);
Left_Index := Index_Type'Succ(Left_Index); -- increment Left_Index
Left_Index := Index_Type'Succ(Left_Index); -- increment Left_Index
Line 108: Line 789:
end Sort;
end Sort;


end Mergesort;
end Mergesort;</syntaxhighlight>

</ada>
The following code provides an usage example for the generic package defined above.
The following code provides an usage example for the generic package defined above.
<syntaxhighlight lang="ada">with Ada.Text_Io; use Ada.Text_Io;
<ada>
with Ada.Text_Io; use Ada.Text_Io;
with Mergesort;
with Mergesort;


Line 131: Line 809:
Print(List);
Print(List);
Print(List_Sort.Sort(List));
Print(List_Sort.Sort(List));
end Mergesort_Test;
end Mergesort_Test;</syntaxhighlight>
{{out}}
</ada>
The output of this example is:
<pre>
<pre>
1 5 2 7 3 9 4 6
1 5 2 7 3 9 4 6
Line 144: Line 821:
a different memory location is expensive, then the optimised version should
a different memory location is expensive, then the optimised version should
be used as the DATA elements are handled indirectly.
be used as the DATA elements are handled indirectly.
<pre>MODE DATA = CHAR;
<syntaxhighlight lang="algol68">MODE DATA = CHAR;


PROC merge sort = ([]DATA m)[]DATA: (
PROC merge sort = ([]DATA m)[]DATA: (
Line 184: Line 861:


[32]CHAR char array data := "big fjords vex quick waltz nymph";
[32]CHAR char array data := "big fjords vex quick waltz nymph";
print((merge sort(char array data), new line));</pre>
print((merge sort(char array data), new line));</syntaxhighlight>
{{out}}
Output:
<pre>
abcdefghiijklmnopqrstuvwxyz
abcdefghiijklmnopqrstuvwxyz
</pre>

Optimised version:
Optimised version:
# avoids FLEX array copies and manipulations
# avoids FLEX array copies and manipulations
# avoids type DATA memory copies, useful in cases where DATA is a large STRUCT
# avoids type DATA memory copies, useful in cases where DATA is a large STRUCT
<pre>PROC opt merge sort = ([]REF DATA m)[]REF DATA: (
<syntaxhighlight lang="algol68">PROC opt merge sort = ([]REF DATA m)[]REF DATA: (
IF LWB m >= UPB m THEN
IF LWB m >= UPB m THEN
m
m
Line 228: Line 906:


[]REF CHAR result = opt merge sort(data);
[]REF CHAR result = opt merge sort(data);
FOR i TO UPB result DO print((result[i])) OD; print(new line)</pre>
FOR i TO UPB result DO print((result[i])) OD; print(new line)</syntaxhighlight>
{{out}}
Output:
<pre>
abcdefghiijklmnopqrstuvwxyz
abcdefghiijklmnopqrstuvwxyz
</pre>


=={{header|C sharp|C#}}==
=={{header|AppleScript}}==
{{works with|C sharp|C#|2.0+}}
<csharp>
using System;
using System.Collections.Generic;


<syntaxhighlight lang="applescript">(*
namespace RosettaCode.MergeSort
In-place, iterative binary merge sort
{
Merge sort algorithm: John von Neumann, 1945.
public static class MergeSorter
Convenience terminology used here:
run: one of two adjacent source-list ranges containing ordered items for merging.
block: range in the destination list to which two runs are merged.
*)
on mergeSort(theList, l, r) -- Sort items l thru r of theList.
set listLength to (count theList)
if (listLength < 2) then return
-- Convert negative and/or transposed range indices.
if (l < 0) then set l to listLength + l + 1
if (r < 0) then set r to listLength + r + 1
if (l > r) then set {l, r} to {r, l}
-- Script object containing the input list and the sort range indices.
script main
property lst : theList
property l : missing value
property r : missing value
end script
set {main's l, main's r} to {l, r}
-- Just swap adjacent items as necessary on the first pass.
-- (Short insertion sorts would be better, to create larger initial runs.)
repeat with j from (l + 1) to r by 2
set i to j - 1
set lv to main's lst's item i
set rv to main's lst's item j
if (lv > rv) then
set main's lst's item i to rv
set main's lst's item j to lv
end if
end repeat
set rangeLength to r - l + 1
if (rangeLength < 3) then return -- That's all if fewer than three items to sort.
-- Script object to alternate with the one above as the source and destination for the
-- merges. Its list need only contain the items from the sort range as ordered so far.
script aux
property lst : main's lst's items l thru r
property l : 1
property r : rangeLength
end script
-- Work out how many merging passes will be needed and set the script objects' initial
-- source and destination roles so that the final pass will merge back to the original list.
set passesToDo to 0
set blockSize to 2
repeat while (blockSize < rangeLength)
set passesToDo to passesToDo + 1
set blockSize to blockSize + blockSize
end repeat
set {srce, dest} to {{main, aux}, {aux, main}}'s item (passesToDo mod 2 + 1)
-- Do the remaining passes, doubling the run and block sizes on each pass.
-- (The end set in each pass will usually be truncated.)
set blockSize to 2
repeat passesToDo times -- Per pass.
set runSize to blockSize
set blockSize to blockSize + blockSize
set k to (dest's l) - 1 -- Destination traversal index.
repeat with leftStart from srce's l to srce's r by blockSize -- Per merge.
set blockEnd to k + blockSize
if (blockEnd comes after dest's r) then set blockEnd to dest's r
set i to leftStart -- Left run traversal index.
set leftEnd to leftStart + runSize - 1
if (leftEnd comes before srce's r) then
set j to leftEnd + 1 -- Right run traversal index.
set rightEnd to leftEnd + runSize
if (rightEnd comes after srce's r) then set rightEnd to srce's r
-- Merge process:
set lv to srce's lst's item i
set rv to srce's lst's item j
repeat with k from (k + 1) to blockEnd
if (lv > rv) then
set dest's lst's item k to rv
if (j = rightEnd) then exit repeat -- Right run used up.
set j to j + 1
set rv to srce's lst's item j
else
set dest's lst's item k to lv
if (i = leftEnd) then -- Left run used up.
set i to j
exit repeat
end if
set i to i + 1
set lv to srce's lst's item i
end if
end repeat
end if
-- Use up the remaining items from the not-yet-exhausted run.
repeat with k from (k + 1) to blockEnd
set dest's lst's item k to srce's lst's item i
set i to i + 1
end repeat
end repeat -- Per merge.
-- Switch source and destination scripts for the next pass.
tell srce
set srce to dest
set dest to it
end tell
end repeat -- Per pass.
return -- nothing
end mergeSort
property sort : mergeSort

-- Demo:
local aList
set aList to {22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90}
sort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
return aList</syntaxhighlight>

{{output}}
<syntaxhighlight lang="applescript">{2, 4, 8, 15, 22, 22, 37, 38, 46, 48, 49, 53, 54, 54, 58, 70, 72, 76, 80, 82, 84, 86, 90, 93, 98}</syntaxhighlight>

=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
<syntaxhighlight lang="arm assembly">
/* ARM assembly Raspberry PI */
/* program mergeSort.s */
/* REMARK 1 : this program use routines in a include file
see task Include a file language arm assembly
for the routine affichageMess conversion10
see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes */
/************************************/
.include "../constantes.inc"

/*********************************/
/* Initialized data */
/*********************************/
.data
szMessSortOk: .asciz "Table sorted.\n"
szMessSortNok: .asciz "Table not sorted !!!!!.\n"
sMessResult: .asciz "Value : @ \n"
szCarriageReturn: .asciz "\n"
.align 4
#TableNumber: .int 1,11,3,6,2,5,9,10,8,4,7
TableNumber: .int 10,9,8,7,6,5,4,3,2,1
.equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data */
/*********************************/
.bss
sZoneConv: .skip 24
/*********************************/
/* code section */
/*********************************/
.text
.global main
main: @ entry of program
ldr r0,iAdrTableNumber @ address number table
mov r1,#0 @ first element
mov r2,#NBELEMENTS @ number of élements
bl mergeSort
ldr r0,iAdrTableNumber @ address number table
bl displayTable
ldr r0,iAdrTableNumber @ address number table
mov r1,#NBELEMENTS @ number of élements
bl isSorted @ control sort
cmp r0,#1 @ sorted ?
beq 1f
ldr r0,iAdrszMessSortNok @ no !! error sort
bl affichageMess
b 100f
1: @ yes
ldr r0,iAdrszMessSortOk
bl affichageMess
100: @ standard end of the program
mov r0, #0 @ return code
mov r7, #EXIT @ request to exit program
svc #0 @ perform the system call
iAdrszCarriageReturn: .int szCarriageReturn
iAdrsMessResult: .int sMessResult
iAdrTableNumber: .int TableNumber
iAdrszMessSortOk: .int szMessSortOk
iAdrszMessSortNok: .int szMessSortNok
/******************************************************************/
/* control sorted table */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of elements > 0 */
/* r0 return 0 if not sorted 1 if sorted */
isSorted:
push {r2-r4,lr} @ save registers
mov r2,#0
ldr r4,[r0,r2,lsl #2]
1:
add r2,#1
cmp r2,r1
movge r0,#1
bge 100f
ldr r3,[r0,r2, lsl #2]
cmp r3,r4
movlt r0,#0
blt 100f
mov r4,r3
b 1b
100:
pop {r2-r4,lr}
bx lr @ return
/******************************************************************/
/* merge */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains second start index */
/* r3 contains the last index */
merge:
push {r1-r8,lr} @ save registers
mov r5,r2 @ init index r2->r5
1: @ begin loop first section
ldr r6,[r0,r1,lsl #2] @ load value first section index r1
ldr r7,[r0,r5,lsl #2] @ load value second section index r5
cmp r6,r7
ble 3f @ <= -> location first section OK
str r7,[r0,r1,lsl #2] @ store value second section in first section
add r8,r5,#1
cmp r8,r3 @ end second section ?
strgt r6,[r0,r5,lsl #2]
bgt 3f @ loop
2: @ loop insert element part 1 into part 2
sub r4,r8,#1
ldr r7,[r0,r8,lsl #2] @ load value 2
cmp r6,r7 @ value <
strlt r6,[r0,r4,lsl #2] @ store value
blt 3f
str r7,[r0,r4,lsl #2] @ store value 2
add r8,#1
cmp r8,r3 @ end second section ?
ble 2b @ no loop
sub r8,#1
str r6,[r0,r8,lsl #2] @ store value 1
3:
add r1,#1
cmp r1,r2 @ end first section ?
blt 1b

100:
pop {r1-r8,lr}
bx lr @ return
/******************************************************************/
/* merge sort */
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the index of first element */
/* r2 contains the number of element */
mergeSort:
push {r3-r7,lr} @ save registers
cmp r2,#2
blt 100f
lsr r4,r2,#1 @ number of element of each subset
tst r2,#1
addne r4,#1
mov r5,r1 @ save first element
mov r6,r2 @ save number of element
mov r7,r4 @ save number of element of each subset
mov r2,r4
bl mergeSort
mov r1,r7 @ restaur number of element of each subset
mov r2,r6 @ restaur number of element
sub r2,r1
mov r3,r5 @ restaur first element
add r1,r3 @ + 1
bl mergeSort @ sort first subset
mov r1,r5 @ restaur first element
mov r2,r7 @ restaur number of element of each subset
add r2,r1
mov r3,r6 @ restaur number of element
add r3,r1
sub r3,#1 @ last index
bl merge
100:
pop {r3-r7,lr}
bx lr @ return
/******************************************************************/
/* Display table elements */
/******************************************************************/
/* r0 contains the address of table */
displayTable:
push {r0-r3,lr} @ save registers
mov r2,r0 @ table address
mov r3,#0
1: @ loop display table
ldr r0,[r2,r3,lsl #2]
ldr r1,iAdrsZoneConv @
bl conversion10S @ décimal conversion
ldr r0,iAdrsMessResult
ldr r1,iAdrsZoneConv @ insert conversion
bl strInsertAtCharInc
bl affichageMess @ display message
add r3,#1
cmp r3,#NBELEMENTS - 1
ble 1b
ldr r0,iAdrszCarriageReturn
bl affichageMess
mov r0,r2
100:
pop {r0-r3,lr}
bx lr
iAdrsZoneConv: .int sZoneConv
/***************************************************/
/* ROUTINES INCLUDE */
/***************************************************/
.include "../affichage.inc"
</syntaxhighlight>
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">merge: function [a,b,left,middle,right][
leftLen: middle - left
rightLen: right - middle

l: 0
r: leftLen

loop left..dec middle 'i [
b\[l]: a\[i]
l: l + 1
]
loop middle..dec right 'i [
b\[r]: a\[i]
r: r + 1
]

l: 0
r: leftLen
i: left

while [and? l < leftLen r < leftLen + rightLen][
if? b\[l] < b\[r] [
a\[i]: b\[l]
l: l + 1
]
else [
a\[i]: b\[r]
r: r + 1
]
i: i + 1
]

while [l < leftLen][
a\[i]: b\[l]
l: l + 1
i: i + 1
]
while [r < leftLen + rightLen][
a\[i]: b\[r]
r: r + 1
i: i + 1
]
]

mergeLR: function [a,b,left,right][
if 1 >= right - left -> return ø
mid: (left + right) / 2
mergeLR a b left mid
mergeLR a b mid right
merge a b left mid right
]

mergeSort: function [arr][
result: new arr
b: new array.of:size result 0

mergeLR result b 0 size result
return result
]

print mergeSort [3 1 2 8 5 7 9 4 6]</syntaxhighlight>

{{out}}

<pre>1 2 3 4 5 6 7 8 9</pre>

=={{header|Astro}}==
<syntaxhighlight lang="python">fun mergesort(m):
if m.lenght <= 1: return m
let middle = floor m.lenght / 2
let left = merge(m[:middle])
let right = merge(m[middle-1:]);

fun merge(left, right):
let result = []
while not (left.isempty or right.isempty):
if left[1] <= right[1]:
result.push! left.shift!()
else:
result.push! right.shift!()
result.push! left.push! right

let arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
print mergesort arr</syntaxhighlight>

=={{Header|ATS}}==

=== A mergesort for linear lists ===


This algorithm modifies the links in the list, rather than allocate new cons-pairs. It requires no garbage collector.

<syntaxhighlight lang="ats">(*------------------------------------------------------------------*)
(* Mergesort in ATS2, for linear lists. *)
(*------------------------------------------------------------------*)

#include "share/atspre_staload.hats"

staload UN = "prelude/SATS/unsafe.sats"

#define NIL list_vt_nil ()
#define :: list_vt_cons

(*------------------------------------------------------------------*)

(* Destructive stable merge. *)
extern fun {a : vt@ype}
list_vt_merge {m, n : int}
(lst1 : list_vt (a, m),
lst2 : list_vt (a, n))
:<!wrt> list_vt (a, m + n)

(* Order predicate for list_vt_merge. You have to implement this to
suit your needs. *)
extern fun {a : vt@ype}
list_vt_merge$lt : (&a, &a) -<> bool

(* Destructive stable mergesort. *)
extern fun {a : vt@ype}
list_vt_mergesort {n : int}
(lst : list_vt (a, n))
:<!wrt> list_vt (a, n)

(* Order predicate for list_vt_mergesort. You have to implement this
to suit your needs. *)
extern fun {a : vt@ype}
list_vt_mergesort$lt : (&a, &a) -<> bool

(*------------------------------------------------------------------*)

implement {a}
list_vt_merge {m, n} (lst1, lst2) =
let
macdef lt = list_vt_merge$lt<a>

fun
loop {m, n : nat} .<m + n>.
(lst1 : list_vt (a, m),
lst2 : list_vt (a, n),
lst_merged : &List_vt a? >> list_vt (a, m + n))
:<!wrt> void =
case+ lst1 of
| ~ NIL => lst_merged := lst2
| @ elem1 :: tail1 =>
begin
case+ lst2 of
| ~ NIL =>
let
prval () = fold@ lst1
in
lst_merged := lst1
end
| @ elem2 :: tail2 =>
if ~(elem2 \lt elem1) then
let
val () = lst_merged := lst1
prval () = fold@ lst2
val () = loop (tail1, lst2, tail1)
prval () = fold@ lst_merged
in
end
else
let
val () = lst_merged := lst2
prval () = fold@ lst1
val () = loop (lst1, tail2, tail2)
prval () = fold@ lst_merged
in
end
end

prval () = lemma_list_vt_param lst1 (* Proves 0 <= m. *)
prval () = lemma_list_vt_param lst2 (* Proves 0 <= n. *)
prval () = prop_verify {0 <= m} ()
prval () = prop_verify {0 <= n} ()

var lst_merged : List_vt a?
val () = loop {m, n} (lst1, lst2, lst_merged)
in
lst_merged
end

(*------------------------------------------------------------------*)

implement {a}
list_vt_mergesort {n} lst =
let
implement
list_vt_merge$lt<a> (x, y) =
list_vt_mergesort$lt<a> (x, y)

(* You can make SMALL larger than 1 and write small_sort as a fast
stable sort for small lists. *)
#define SMALL 1
fn
small_sort {m : pos | m <= SMALL}
(lst : list_vt (a, m),
m : int m)
:<!wrt> list_vt (a, m) =
lst

fun
recurs {m : pos} .<m>.
(lst : list_vt (a, m),
m : int m)
:<!wrt> list_vt (a, m) =
if m <= SMALL then
small_sort (lst, m)
else
let
prval () = prop_verify {2 <= m} ()
val i = m / 2
val @(lst1, lst2) = list_vt_split_at<a> (lst, i)
val lst1 = recurs (lst1, i)
val lst2 = recurs (lst2, m - i)
in
list_vt_merge<a> (lst1, lst2)
end

prval () = lemma_list_vt_param lst (* Proves 0 <= n. *)
prval () = prop_verify {0 <= n} ()
in
case+ lst of
| NIL => lst
| _ :: _ => recurs (lst, length lst)
end

(*------------------------------------------------------------------*)

extern fun
list_vt_mergesort_int {n : int}
(lst : list_vt (int, n))
:<!wrt> list_vt (int, n)

implement
list_vt_mergesort_int {n} lst =
let
implement
list_vt_mergesort$lt<int> (x, y) =
x < y
in
list_vt_mergesort<int> {n} lst
end

implement
main0 () =
let
val lst = $list_vt (22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49,
48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76,
53, 37, 90)
val () = println! ("before : ", $UN.castvwtp1{List int} lst)
val lst = list_vt_mergesort_int lst
val () = println! ("after : ", $UN.castvwtp1{List int} lst)
in
list_vt_free<int> lst
end

(*------------------------------------------------------------------*)</syntaxhighlight>

{{out}}
<pre>$ patscc -O3 -DATS_MEMALLOC_LIBC mergesort_task_for_list_vt.dats && ./a.out
before : 22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90
after : 2, 4, 8, 15, 22, 22, 37, 38, 46, 48, 49, 53, 54, 54, 58, 70, 72, 76, 80, 82, 84, 86, 90, 93, 98</pre>

Footnote: Rather than directly write a mergesort for "ordinary" non-linear lists, I would write a routine to do the following:

* make a copy of the list;
* cast the copy to a linear list;
* sort the linear list;
* cast the result to non-linear list, and return the casted result.


This way, new cons-pairs are allocated only once.

The same thing can be done in other languages, of course. An interesting thing about this ATS implementation, though, is it proves the result is of the same length as the input. It does not, however, prove that the result satisfies the order predicate.

===A mergesort for non-linear lists of integers, guaranteeing a sorted result===


The following program not only sorts a list of integers, but verifies that the result is sorted. It is the simplest implementation I could think of that does that. It works by having a special kind of list that can be consed only in sorted order.

The length of the result also is verified. However, there is no proof that the result contains the same data as the input.

<syntaxhighlight lang="ats">//--------------------------------------------------------------------
//
// A mergesort for 32-bit signed integers.
//
//--------------------------------------------------------------------

#include "share/atspre_staload.hats"

(*------------------------------------------------------------------*)

#define ENTIER_MAX 2147483647

(* We do not include the most negative two's-complement number. *)
stadef entier (i : int) = ~ENTIER_MAX <= i && i <= ENTIER_MAX
sortdef entier = {i : int | entier i}

typedef entier (i : int) = [entier i] int i
typedef entier = [i : entier] entier i

datatype sorted_entier_list (int, int) =
| sorted_entier_list_nil (0, ENTIER_MAX)
| {n : nat}
{i, j : entier | ~(j < i)}
sorted_entier_list_cons (n + 1, i) of
(entier i, sorted_entier_list (n, j))
typedef sorted_entier_list (n : int) =
[i : entier] sorted_entier_list (n, i)
typedef sorted_entier_list =
[n : int] sorted_entier_list n

infixr ( :: ) :::
#define NIL list_nil ()
#define :: list_cons
#define SNIL sorted_entier_list_nil ()
#define ::: sorted_entier_list_cons

(*------------------------------------------------------------------*)

extern prfn
lemma_sorted_entier_list_param
{n : int}
(lst : sorted_entier_list n)
:<prf> [0 <= n] void

extern fn
sorted_entier_list_length
{n : int}
(lst : sorted_entier_list n)
:<> [0 <= n] int n

extern fn
sorted_entier_list_merge
{m, n : int}
{i, j : entier}
(lst1 : sorted_entier_list (m, i),
lst2 : sorted_entier_list (n, j))
:<> sorted_entier_list (m + n, min (i, j))

extern fn
entier_list_mergesort
{n : int}
(lst : list (entier, n)) (* An ordinary list. *)
:<!wrt> sorted_entier_list n

extern fn
sorted_entier_list2list
{n : int}
(lst : sorted_entier_list n)
:<> list (entier, n)

overload length with sorted_entier_list_length
overload merge with sorted_entier_list_merge
overload mergesort with entier_list_mergesort
overload to_list with sorted_entier_list2list

(*------------------------------------------------------------------*)

primplement
lemma_sorted_entier_list_param {n} lst =
case+ lst of
| SNIL => ()
| _ ::: _ => ()

implement
sorted_entier_list_length {n} lst =
(* This implementation is tail-recursive. *)
let
fun
count {m : nat | m <= n} .<n - m>.
(lst : sorted_entier_list (n - m),
m : int m)
:<> [0 <= n] int n =
case+ lst of
| SNIL => m
| _ ::: tail => count {m + 1} (tail, succ m)

prval () = lemma_sorted_entier_list_param lst
in
count (lst, 0)
end

implement
sorted_entier_list_merge (lst1, lst2) =
(* This implementation is *NOT* tail recursive. It will use O(m+n)
stack space. *)
let
fun
recurs {m, n : nat}
{i, j : entier} .<m + n>.
(lst1 : sorted_entier_list (m, i),
lst2 : sorted_entier_list (n, j))
:<> sorted_entier_list (m + n, min (i, j)) =
case+ lst1 of
| SNIL => lst2
| i ::: tail1 =>
begin
case+ lst2 of
| SNIL => lst1
| j ::: tail2 =>
if ~(j < i) then
i ::: recurs (tail1, lst2)
else
j ::: recurs (lst1, tail2)
end

prval () = lemma_sorted_entier_list_param lst1
prval () = lemma_sorted_entier_list_param lst2
in
recurs (lst1, lst2)
end

implement
entier_list_mergesort lst =
let
fun
recurs {m : nat} .<m>.
(lst : list (entier, m),
m : int m)
:<!wrt> sorted_entier_list m =
if m = 1 then
let
val+ head :: NIL = lst
in
head ::: SNIL
end
else if m = 0 then
SNIL
else
let
val m_left = m \g1int_ndiv 2
val m_right = m - m_left
val @(left, right) = list_split_at (lst, m_left)
val left = recurs (list_vt2t left, m_left)
and right = recurs (right, m_right)
in
left \merge right
end

prval () = lemma_list_param lst
in
recurs (lst, length lst)
end

implement
sorted_entier_list2list lst =
(* This implementation is *NOT* tail recursive. It will use O(n)
stack space. *)
let
fun
recurs {n : nat} .<n>.
(lst : sorted_entier_list n)
:<> list (entier, n) =
case+ lst of
| SNIL => NIL
| head ::: tail => head :: recurs tail

prval () = lemma_sorted_entier_list_param lst
in
recurs lst
end

(*------------------------------------------------------------------*)

fn
print_Int_list
{n : int}
(lst : list (Int, n))
: void =
let
fun
loop {n : nat} .<n>.
(lst : list (Int, n))
: void =
case+ lst of
| NIL => ()
| head :: tail =>
begin
print! (" ");
print! (head);
loop tail
end
prval () = lemma_list_param lst
in
loop lst
end

implement
main0 () =
let
val example_list =
$list (22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54,
93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90)
val sorted_list = mergesort example_list
in
print! ("unsorted ");
print_Int_list example_list;
println! ();
print! ("sorted ");
print_Int_list (to_list sorted_list);
println! ()
end

(*------------------------------------------------------------------*)</syntaxhighlight>

{{out}}
<pre>patscc -O3 -DATS_MEMALLOC_GCBDW mergesort_task_verified.dats -lgc && ./a.out
unsorted 22 15 98 82 22 4 58 70 80 38 49 48 46 54 93 8 54 2 72 84 86 76 53 37 90
sorted 2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98</pre>

''Postscript''. One might try adding a line such as

<pre>val x = 3 ::: 2 ::: SNIL</pre>

to the program and see that the compiler will report it as erroneous, on grounds that "2 is not less than 3" is unsatisfied.

== [[AutoHotkey_L]] ==
AutoHotkey_L has true array support and can dynamically grow and shrink its arrays at run time.
This version of Merge Sort only needs '''n''' locations to sort.
[http://www.autohotkey.com/forum/viewtopic.php?t=77693&highlight=| AHK forum post]
<syntaxhighlight lang="autohotkey">#NoEnv

Test := []
Loop 100 {
Random n, 0, 999
Test.Insert(n)
}
Result := MergeSort(Test)
Loop % Result.MaxIndex() {
MsgBox, 1, , % Result[A_Index]
IfMsgBox Cancel
Break
}
Return


/*
Function MergeSort
Sorts an array by first recursively splitting it down to its
individual elements and then merging those elements in their
correct order.
Parameters
Array The array to be sorted
Returns
The sorted array
*/
MergeSort(Array)
{
{
; Return single element arrays
public static List<T> Sort<T>(List<T> list) where T : IComparable
{
If (! Array.HasKey(2))
if (list.Count <= 1) return list;
Return Array


; Split array into Left and Right halfs
List<T> left = list.GetRange(0, list.Count / 2);
Left := [], Right := [], Middle := Array.MaxIndex() // 2
List<T> right = list.GetRange(left.Count, list.Count - left.Count);
Loop % Middle
return Merge(Sort(left), Sort(right));
Right.Insert(Array.Remove(Middle-- + 1)), Left.Insert(Array.Remove(1))
}
If (Array.MaxIndex())
Right.Insert(Array.Remove(1))
Left := MergeSort(Left), Right := MergeSort(Right)


; If all the Right values are greater than all the
public static List<T> Merge<T>(List<T> left, List<T> right) where T : IComparable
; Left values, just append Right at the end of Left.
{
If (Left[Left.MaxIndex()] <= Right[1]) {
List<T> result = new List<T>();
while (left.Count > 0 && right.Count > 0)
Loop % Right.MaxIndex()
{
Left.Insert(Right.Remove(1))
if (left[0].CompareTo(right[0]) <= 0)
Return Left
{
result.Add(left[0]);
left.RemoveAt(0);
}
else
{
result.Add(right[0]);
right.RemoveAt(0);
}
}
result.AddRange(left);
result.AddRange(right);
return result;
}
}
; Loop until one of the arrays is empty
While(Left.MaxIndex() and Right.MaxIndex())
Left[1] <= Right[1] ? Array.Insert(Left.Remove(1))
: Array.Insert(Right.Remove(1))

Loop % Left.MaxIndex()
Array.Insert(Left.Remove(1))

Loop % Right.MaxIndex()
Array.Insert(Right.Remove(1))
Return Array
}</syntaxhighlight>

=={{header|AutoHotkey}}==
Contributed by Laszlo on the ahk [http://www.autohotkey.com/forum/post-276483.html#276483 forum]
<syntaxhighlight lang="autohotkey">MsgBox % MSort("")
MsgBox % MSort("xxx")
MsgBox % MSort("3,2,1")
MsgBox % MSort("dog,000000,cat,pile,abcde,1,zz,xx,z")

MSort(x) { ; Merge-sort of a comma separated list
If (2 > L:=Len(x))
Return x ; empty or single item lists are sorted
StringGetPos p, x, `,, % "L" L//2 ; Find middle comma
Return Merge(MSort(SubStr(x,1,p)), MSort(SubStr(x,p+2))) ; Split, Sort, Merge
}

Len(list) {
StringReplace t, list,`,,,UseErrorLevel ; #commas -> ErrorLevel
Return list="" ? 0 : ErrorLevel+1
}

Item(list,ByRef p) { ; item at position p, p <- next position
Return (p := InStr(list,",",0,i:=p+1)) ? SubStr(list,i,p-i) : SubStr(list,i)
}

Merge(list0,list1) { ; Merge 2 sorted lists
IfEqual list0,, Return list1
IfEqual list1,, Return list0
i0 := Item(list0,p0:=0)
i1 := Item(list1,p1:=0)
Loop {
i := i0>i1
list .= "," i%i% ; output smaller
If (p%i%)
i%i% := Item(list%i%,p%i%) ; get next item from processed list
Else {
i ^= 1 ; list is exhausted: attach rest of other
Return SubStr(list "," i%i% (p%i% ? "," SubStr(list%i%,p%i%+1) : ""), 2)
}
}
}</syntaxhighlight>

=={{header|BASIC}}==
==={{header|BBC BASIC}}===
<syntaxhighlight lang="bbcbasic">DEFPROC_MergeSort(Start%,End%)
REM *****************************************************************
REM This procedure Merge Sorts the chunk of data% bounded by
REM Start% & End%.
REM *****************************************************************

LOCAL Middle%
IF End%=Start% ENDPROC

IF End%-Start%=1 THEN
IF data%(End%)<data%(Start%) THEN
SWAP data%(Start%),data%(End%)
ENDIF
ENDPROC
ENDIF

Middle%=Start%+(End%-Start%)/2

PROC_MergeSort(Start%,Middle%)
PROC_MergeSort(Middle%+1,End%)
PROC_Merge(Start%,Middle%,End%)

ENDPROC
:
DEF PROC_Merge(Start%,Middle%,End%)

LOCAL fh_size%
fh_size% = Middle%-Start%+1

FOR I%=0 TO fh_size%-1
fh%(I%)=data%(Start%+I%)
NEXT I%

I%=0
J%=Middle%+1
K%=Start%

REPEAT
IF fh%(I%) <= data%(J%) THEN
data%(K%)=fh%(I%)
I%+=1
K%+=1
ELSE
data%(K%)=data%(J%)
J%+=1
K%+=1
ENDIF
UNTIL I%=fh_size% OR J%>End%

WHILE I% < fh_size%
data%(K%)=fh%(I%)
I%+=1
K%+=1
ENDWHILE

ENDPROC</syntaxhighlight>
Usage would look something like this example which sorts a series of 1000 random integers:
<syntaxhighlight lang="bbcbasic">REM Example of merge sort usage.
Size%=1000

S1%=Size%/2

DIM data%(Size%)
DIM fh%(S1%)

FOR I%=1 TO Size%
data%(I%)=RND(100000)
NEXT

PROC_MergeSort(1,Size%)

END</syntaxhighlight>

==={{header|Chipmunk Basic}}===
{{works with|Chipmunk Basic|3.6.4}}
{{trans|Quite BASIC}}
<syntaxhighlight lang="qbasic">100 REM Sorting algorithms/Merge sort
110 CLS
120 LET N = 10
130 LET C = 0
140 OPTION BASE 1
150 DIM A(10)
160 DIM B(10)
170 RANDOMIZE TIMER
180 GOSUB 810
190 REM Print the random array
200 PRINT "unsort ";
210 GOSUB 860
220 REM Sort the array
230 GOSUB 300
240 PRINT " sort ";
250 REM Print the sorted array
260 GOSUB 860
270 PRINT "Number of iterations: ";C
290 END
300 REM Merge sort the list A of length N
310 REM Using the array B for temporary storage
320 REM
330 REM === Split phase ===
340 REM C counts the number of split/merge iterations
350 LET C = C+1
360 LET X = 1
370 LET Y = 1
380 LET Z = N
390 GOTO 410
400 IF A(X) < A(X-1) THEN GOTO 470
410 LET B(Y) = A(X)
420 LET Y = Y+1
430 LET X = X+1
440 IF Z < Y THEN GOTO 500
450 GOTO 400
460 IF A(X) < A(X-1) THEN GOTO 410
470 LET B(Z) = A(X)
480 LET Z = Z-1
490 LET X = X+1
500 IF Z < Y THEN GOTO 530
510 GOTO 460
520 REM
530 REM === Merge Phase ===
540 REM Q means "we're done" (or "quit")
550 REM Q is 1 until we know that this is _not_ the last iteration
560 LET Q = 1
570 LET X = 1
580 LET Y = 1
590 LET Z = N
600 REM First select the smaller item
610 IF B(Y) < B(Z) THEN GOTO 710 ELSE GOTO 750
620 REM Check if the loop is done
630 IF Z < Y THEN GOTO 790
640 REM If both items are smaller then start over with the smallest
650 IF B(Y) >= A(X-1) OR B(Z) >= A(X-1) THEN GOTO 680
660 LET Q = 0
670 GOTO 600
680 REM Pick the smallest item that represents an increase
690 IF B(Z) < B(Y) AND B(Z) >= A(X-1) THEN GOTO 750
700 IF B(Z) > B(Y) AND B(Y) < A(X-1) THEN GOTO 750
710 LET A(X) = B(Y)
720 LET Y = Y+1
730 LET X = X+1
740 GOTO 620
750 LET A(X) = B(Z)
760 LET Z = Z-1
770 LET X = X+1
780 GOTO 620
790 IF Q = 0 THEN GOTO 330
800 RETURN
810 REM Create a random list of N integers
820 FOR I = 1 TO N
830 LET A(I) = FLOOR(RND(100))
840 NEXT I
850 RETURN
860 REM PRINT the list A
870 FOR I = 1 TO N
880 PRINT A(I);" ";
890 NEXT I
900 PRINT
910 RETURN</syntaxhighlight>

==={{header|Minimal BASIC}}===
{{trans|Quite BASIC}}
<syntaxhighlight lang="qbasic">120 LET N = 10
130 LET C = 0
140 OPTION BASE 1
150 DIM A(10)
160 DIM B(10)
170 RANDOMIZE
180 GOSUB 810
190 REM Print the random array
200 PRINT "unsort ";
210 GOSUB 860
220 REM Sort the array
230 GOSUB 300
240 PRINT " sort ";
250 REM Print the sorted array
260 GOSUB 860
270 PRINT "Number of iterations: "; C
290 GOTO 950
300 REM Merge sort the list A of length N
310 REM Using the array B for temporary storage
320 REM
330 REM === Split phase ===
340 REM C counts the number of split/merge iterations
350 LET C = C+1
360 LET X = 1
370 LET Y = 1
380 LET Z = N
390 GOTO 410
400 IF A(X) < A(X-1) THEN 470
410 LET B(Y) = A(X)
420 LET Y = Y+1
430 LET X = X+1
440 IF Z < Y THEN 500
450 GOTO 400
460 IF A(X) < A(X-1) THEN 410
470 LET B(Z) = A(X)
480 LET Z = Z-1
490 LET X = X+1
500 IF Z < Y THEN 530
510 GOTO 460
520 REM
530 REM === Merge Phase ===
540 REM Q means "we're done" (or "quit")
550 REM Q is 1 until we know that this is _not_ the last iteration
560 LET Q = 1
570 LET X = 1
580 LET Y = 1
590 LET Z = N
600 REM First select the smaller item
610 IF B(Y) < B(Z) THEN 710
615 IF B(Y) > B(Z) THEN 750
620 REM Check if the loop is done
630 IF Z < Y THEN 790
640 REM If both items are smaller then start over with the smallest
650 IF B(Y) >= A(X-1) THEN 680
655 IF B(Z) >= A(X-1) THEN 680
660 LET Q = 0
670 GOTO 600
680 REM Pick the smallest item that represents an increase
690 IF B(Z) < B(Y) THEN 695
692 IF B(Z) > B(Y) THEN 700
695 IF B(Z) >= A(X-1) THEN 750
700 IF B(Z) > B(Y) THEN 705
705 IF B(Y) < A(X-1) THEN 750
710 LET A(X) = B(Y)
720 LET Y = Y+1
730 LET X = X+1
740 GOTO 620
750 LET A(X) = B(Z)
760 LET Z = Z-1
770 LET X = X+1
780 GOTO 620
790 IF Q = 0 THEN 330
800 RETURN
810 REM Create a random list of N integers
820 FOR I = 1 TO N
830 LET A(I) = INT((RND * 100) + .5)
840 NEXT I
850 RETURN
860 REM PRINT the list A
870 FOR I = 1 TO N
880 PRINT A(I); " ";
890 NEXT I
900 PRINT
910 RETURN
950 END</syntaxhighlight>

==={{header|Quite BASIC}}===
<syntaxhighlight lang="qbasic">100 REM Sorting algorithms/Merge sort
110 CLS
120 LET N = 10
130 LET C = 0
150 ARRAY A
160 ARRAY B
180 GOSUB 810
190 REM Print the random array
200 PRINT "unsort ";
210 GOSUB 860
220 REM Sort the array
230 GOSUB 300
240 PRINT " sort ";
250 REM Print the sorted array
260 GOSUB 860
270 PRINT "Number of iterations: "; C
290 END
300 REM Merge sort the list A of length N
310 REM Using the array B for temporary storage
320 REM
330 REM === Split phase ===
340 REM C counts the number of split/merge iterations
350 LET C = C+1
360 LET X = 1
370 LET Y = 1
380 LET Z = N
390 GOTO 410
400 IF A(X) < A(X-1) THEN GOTO 470
410 LET B(Y) = A(X)
420 LET Y = Y+1
430 LET X = X+1
440 IF Z < Y THEN GOTO 500
450 GOTO 400
460 IF A(X) < A(X-1) THEN GOTO 410
470 LET B(Z) = A(X)
480 LET Z = Z-1
490 LET X = X+1
500 IF Z < Y THEN GOTO 530
510 GOTO 460
520 REM
530 REM === Merge Phase ===
540 REM Q means "we're done" (or "quit")
550 REM Q is 1 until we know that this is _not_ the last iteration
560 LET Q = 1
570 LET X = 1
580 LET Y = 1
590 LET Z = N
600 REM First select the smaller item
610 IF B(Y) < B(Z) THEN GOTO 710 ELSE GOTO 750
620 REM Check if the loop is done
630 IF Z < Y THEN GOTO 790
640 REM If both items are smaller then start over with the smallest
650 IF B(Y) >= A(X-1) OR B(Z) >= A(X-1) THEN GOTO 680
660 LET Q = 0
670 GOTO 600
680 REM Pick the smallest item that represents an increase
690 IF B(Z) < B(Y) AND B(Z) >= A(X-1) THEN GOTO 750
700 IF B(Z) > B(Y) AND B(Y) < A(X-1) THEN GOTO 750
710 LET A(X) = B(Y)
720 LET Y = Y+1
730 LET X = X+1
740 GOTO 620
750 LET A(X) = B(Z)
760 LET Z = Z-1
770 LET X = X+1
780 GOTO 620
790 IF Q = 0 THEN GOTO 330
800 RETURN
810 REM Create a random list of N integers
820 FOR I = 1 TO N
830 LET A(I) = FLOOR(RND(100))
840 NEXT I
850 RETURN
860 REM PRINT the list A
870 FOR I = 1 TO N
880 PRINT A(I); " ";
890 NEXT I
900 PRINT
910 RETURN</syntaxhighlight>

=={{header|BCPL}}==
<syntaxhighlight lang="bcpl">get "libhdr"

let mergesort(A, n) be if n >= 2
$( let m = n / 2
mergesort(A, m)
mergesort(A+m, n-m)
merge(A, n, m)
$)
and merge(A, n, m) be
$( let i, j = 0, m
let x = getvec(n)
for k=0 to n-1
x!k := A!valof
test j~=n & (i=m | A!j < A!i)
$( j := j + 1
resultis j - 1
$)
else
$( i := i + 1
resultis i - 1
$)
for i=0 to n-1 do a!i := x!i
freevec(x)
$)

let write(s, A, len) be
$( writes(s)
for i=0 to len-1 do writed(A!i, 4)
wrch('*N')
$)
let start() be
$( let array = table 4,65,2,-31,0,99,2,83,782,1
let length = 10
write("Before: ", array, length)
mergesort(array, length)
write("After: ", array, length)
$)</syntaxhighlight>
{{out}}
<pre>Before: 4 65 2 -31 0 99 2 83 782 1
After: -31 0 1 2 2 4 65 83 99 782</pre>

=={{header|C}}==
<syntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>

void merge (int *a, int n, int m) {
int i, j, k;
int *x = malloc(n * sizeof (int));
for (i = 0, j = m, k = 0; k < n; k++) {
x[k] = j == n ? a[i++]
: i == m ? a[j++]
: a[j] < a[i] ? a[j++]
: a[i++];
}
}
for (i = 0; i < n; i++) {
a[i] = x[i];
}
free(x);
}
}
</csharp>


void merge_sort (int *a, int n) {
As in the Ada example above, the following code provides a usage example:
if (n < 2)
return;
int m = n / 2;
merge_sort(a, m);
merge_sort(a + m, n - m);
merge(a, n, m);
}


int main () {
<csharp>
int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
using System;
int n = sizeof a / sizeof a[0];
using System.Collections.Generic;
int i;
for (i = 0; i < n; i++)
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
merge_sort(a, n);
for (i = 0; i < n; i++)
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
return 0;
}</syntaxhighlight>
{{out}}
<pre>
4 65 2 -31 0 99 2 83 782 1
-31 0 1 2 2 4 65 83 99 782
</pre>


Non-recursive variant:
namespace RosettaCode.MergeSort

{
<syntaxhighlight lang="c">#include <stdio.h>
class Program
#include <stdlib.h>
{
#include <string.h>
static void Main(string[] args)

{
/* x and y are sorted, copy nx+ny sorted values to r */
List<int> testList = new List<int> { 1, 5, 2, 7, 3, 9, 4, 6 };
void merge(int nx, int*x, int ny, int*y, int*r) {
printList(testList);
int i= 0, j= 0, k= 0;
printList(MergeSorter.Sort(testList));
while (i<nx && j<ny) {
int a= x[i], b= y[j];
if (a<b) {
r[k++]= a;
i++;
} else {
r[k++]= b;
j++;
}
}
}
if (i<nx) {
memcpy(r+k, i+x, (nx-i)*sizeof (int));
} else if (j<ny) {
memcpy(r+k, j+y, (ny-j)*sizeof (int));
}
}


void mergesort(int ny, int *y) {
private static void printList<T>(List<T> list)
int stride= 1, mid, *r= y, *t, *x= malloc(ny*sizeof (int));
{
foreach (var t in list)
while (stride < ny) {
{
stride= 2*(mid= stride);
Console.Write(t + " ");
for (int i= 0; i<ny; i+= stride) {
int lim= mid;
if (i+stride >= ny) {
if (i+mid >= ny) {
memcpy(i+x, i+y, (ny-i)*sizeof (int));
continue;
}
lim= ny-(i+mid);
}
}
Console.WriteLine();
merge(mid, i+y, lim, i+mid+y, i+x);
}
}
t= x; x= y; y=t;
}
}
if (y!=r) {
}</csharp>
memcpy(r, y, ny*sizeof(int));
x= y;
}
free(x);
}


int main () {
Again, as in the Ada example the output is:
int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
int n = sizeof a / sizeof a[0];
int i;
for (i = 0; i < n; i++)
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
mergesort(n, a);
for (i = 0; i < n; i++)
printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
return 0;
}</syntaxhighlight>
{{out}}
<pre>
<pre>
1 5 2 7 3 9 4 6
4 65 2 -31 0 99 2 83 782 1
1 2 3 4 5 6 7 9
-31 0 1 2 2 4 65 83 99 782</pre>

</pre>
=={{header|C sharp|C#}}==
{{works with|C sharp|C#|3.0+}}
<syntaxhighlight lang="csharp">namespace RosettaCode {
using System;

public class MergeSort<T> where T : IComparable {
#region Constants
public const UInt32 INSERTION_LIMIT_DEFAULT = 12;
public const Int32 MERGES_DEFAULT = 6;
#endregion

#region Properties
public UInt32 InsertionLimit { get; }
protected UInt32[] Positions { get; set; }

private Int32 merges;
public Int32 Merges {
get { return merges; }
set {
// A minimum of 2 merges are required
if (value > 1)
merges = value;
else
throw new ArgumentOutOfRangeException($"value = {value} must be greater than one", nameof(Merges));

if (Positions == null || Positions.Length != merges)
Positions = new UInt32[merges];
}
}
#endregion

#region Constructors
public MergeSort(UInt32 insertionLimit, Int32 merges) {
InsertionLimit = insertionLimit;
Merges = merges;
}

public MergeSort()
: this(INSERTION_LIMIT_DEFAULT, MERGES_DEFAULT) {
}
#endregion

#region Sort Methods
public void Sort(T[] entries) {
// Allocate merge buffer
var entries2 = new T[entries.Length];
Sort(entries, entries2, 0, entries.Length - 1);
}

// Top-Down K-way Merge Sort
public void Sort(T[] entries1, T[] entries2, Int32 first, Int32 last) {
var length = last + 1 - first;
if (length < 2) return;
if (length < Merges || length < InsertionLimit) {
InsertionSort<T>.Sort(entries1, first, last);
return;
}

var left = first;
var size = ceiling(length, Merges);
for (var remaining = length; remaining > 0; remaining -= size, left += size) {
var right = left + Math.Min(remaining, size) - 1;
Sort(entries1, entries2, left, right);
}

Merge(entries1, entries2, first, last);
Array.Copy(entries2, first, entries1, first, length);
}
#endregion

#region Merge Methods
public void Merge(T[] entries1, T[] entries2, Int32 first, Int32 last) {
Array.Clear(Positions, 0, Merges);
// This implementation has a quadratic time dependency on the number of merges
for (var index = first; index <= last; index++)
entries2[index] = remove(entries1, first, last);
}

private T remove(T[] entries, Int32 first, Int32 last) {
T entry = default;
Int32? found = default;
var length = last + 1 - first;

var index = 0;
var left = first;
var size = ceiling(length, Merges);
for (var remaining = length; remaining > 0; remaining -= size, left += size, index++) {
var position = Positions[index];
if (position < Math.Min(remaining, size)) {
var next = entries[left + position];
if (!found.HasValue || entry.CompareTo(next) > 0) {
found = index;
entry = next;
}
}
}

// Remove entry
Positions[found.Value]++;
return entry;
}
#endregion

#region Math Methods
private static Int32 ceiling(Int32 numerator, Int32 denominator) {
return (numerator + denominator - 1) / denominator;
}
#endregion
}

#region Insertion Sort
static class InsertionSort<T> where T : IComparable {
public static void Sort(T[] entries, Int32 first, Int32 last) {
for (var next = first + 1; next <= last; next++)
insert(entries, first, next);
}

/// <summary>Bubble next entry up to its sorted location, assuming entries[first:next - 1] are already sorted.</summary>
private static void insert(T[] entries, Int32 first, Int32 next) {
var entry = entries[next];
while (next > first && entries[next - 1].CompareTo(entry) > 0)
entries[next] = entries[--next];
entries[next] = entry;
}
}
#endregion
}</syntaxhighlight>
'''Example''':
<syntaxhighlight lang="csharp"> using Sort;
using System;

class Program {
static void Main(String[] args) {
var entries = new Int32[] { 7, 5, 2, 6, 1, 4, 2, 6, 3 };
var sorter = new MergeSort<Int32>();
sorter.Sort(entries);
Console.WriteLine(String.Join(" ", entries));
}
}</syntaxhighlight>
{{out}}
<pre>1 2 2 3 4 5 6 6 7</pre>

=={{header|C++}}==
<syntaxhighlight lang="cpp">#include <iterator>
#include <algorithm> // for std::inplace_merge
#include <functional> // for std::less

template<typename RandomAccessIterator, typename Order>
void mergesort(RandomAccessIterator first, RandomAccessIterator last, Order order)
{
if (last - first > 1)
{
RandomAccessIterator middle = first + (last - first) / 2;
mergesort(first, middle, order);
mergesort(middle, last, order);
std::inplace_merge(first, middle, last, order);
}
}

template<typename RandomAccessIterator>
void mergesort(RandomAccessIterator first, RandomAccessIterator last)
{
mergesort(first, last, std::less<typename std::iterator_traits<RandomAccessIterator>::value_type>());
}</syntaxhighlight>


=={{header|Clojure}}==
=={{header|Clojure}}==
{{trans|Haskell}}
<syntaxhighlight lang="lisp">
(defn merge [left right]
(cond (nil? left) right
(nil? right) left
:else (let [[l & *left] left
[r & *right] right]
(if (<= l r) (cons l (merge *left right))
(cons r (merge left *right))))))


(defn merge-sort [list]
This solution is pilfered from the Haskell version.
(if (< (count list) 2)
list
(let [[left right] (split-at (/ (count list) 2) list)]
(merge (merge-sort left) (merge-sort right)))))
</syntaxhighlight>


=={{header|COBOL}}==
(defn merge* [left right]
Cobol cannot do recursion, so this version simulates recursion. The working storage is therefore pretty complex, so I have shown the whole program, not just the working procedure division parts.
(cond (nil? left) right
<syntaxhighlight lang="cobol"> IDENTIFICATION DIVISION.
(nil? right) left
true (let [[l & *left] left
PROGRAM-ID. MERGESORT.
[r & *right] right]
AUTHOR. DAVE STRATFORD.
(if (< l r) (cons l (merge* *left right))
DATE-WRITTEN. APRIL 2010.
(cons r (merge* left *right))))))
INSTALLATION. HEXAGON SYSTEMS LIMITED.
******************************************************************
* MERGE SORT *
(defn merge-sort [L]
* The Merge sort uses a completely different paradigm, one of *
(let [[l & *L] L]
* divide and conquer, to many of the other sorts. The data set *
(if (nil? *L)
* is split into smaller sub sets upon which are sorted and then *
L
* merged together to form the final sorted data set. *
(let [[left right] (split-at (/ (count L) 2) L)]
* This version uses the recursive method. Split the data set in *
(merge* (merge-sort left) (merge-sort right))))))
* half and perform a merge sort on each half. This in turn splits*
* each half again and again until each set is just one or 2 items*
* long. A set of one item is already sorted so is ignored, a set *
* of two is compared and swapped as necessary. The smaller data *
* sets are then repeatedly merged together to eventually form the*
* full, sorted, set. *
* Since cobol cannot do recursion this module only simulates it *
* so is not as fast as a normal recursive version would be. *
* Scales very well to larger data sets, its relative complexity *
* means it is not suited to sorting smaller data sets: use an *
* Insertion sort instead as the Merge sort is a stable sort. *
******************************************************************


ENVIRONMENT DIVISION.
=={{header|Common Lisp}}==
CONFIGURATION SECTION.
SOURCE-COMPUTER. ICL VME.
OBJECT-COMPUTER. ICL VME.


INPUT-OUTPUT SECTION.
(defun merge-sort (result-type sequence predicate)
FILE-CONTROL.
SELECT FA-INPUT-FILE ASSIGN FL01.
SELECT FB-OUTPUT-FILE ASSIGN FL02.

DATA DIVISION.
FILE SECTION.
FD FA-INPUT-FILE.
01 FA-INPUT-REC.
03 FA-DATA PIC 9(6).

FD FB-OUTPUT-FILE.
01 FB-OUTPUT-REC PIC 9(6).

WORKING-STORAGE SECTION.
01 WA-IDENTITY.
03 WA-PROGNAME PIC X(10) VALUE "MERGESORT".
03 WA-VERSION PIC X(6) VALUE "000001".

01 WB-TABLE.
03 WB-ENTRY PIC 9(8) COMP SYNC OCCURS 100000
INDEXED BY WB-IX-1
WB-IX-2.

01 WC-VARS.
03 WC-SIZE PIC S9(8) COMP SYNC.
03 WC-TEMP PIC S9(8) COMP SYNC.
03 WC-START PIC S9(8) COMP SYNC.
03 WC-MIDDLE PIC S9(8) COMP SYNC.
03 WC-END PIC S9(8) COMP SYNC.

01 WD-FIRST-HALF.
03 WD-FH-MAX PIC S9(8) COMP SYNC.
03 WD-ENTRY PIC 9(8) COMP SYNC OCCURS 50000
INDEXED BY WD-IX.

01 WF-CONDITION-FLAGS.
03 WF-EOF-FLAG PIC X.
88 END-OF-FILE VALUE "Y".
03 WF-EMPTY-FILE-FLAG PIC X.
88 EMPTY-FILE VALUE "Y".

01 WS-STACK.
* This stack is big enough to sort a list of 1million items.
03 WS-STACK-ENTRY OCCURS 20 INDEXED BY WS-STACK-TOP.
05 WS-START PIC S9(8) COMP SYNC.
05 WS-MIDDLE PIC S9(8) COMP SYNC.
05 WS-END PIC S9(8) COMP SYNC.
05 WS-FS-FLAG PIC X.
88 FIRST-HALF VALUE "F".
88 SECOND-HALF VALUE "S".
88 WS-ALL VALUE "A".
05 WS-IO-FLAG PIC X.
88 WS-IN VALUE "I".
88 WS-OUT VALUE "O".

PROCEDURE DIVISION.
A-MAIN SECTION.
A-000.
PERFORM B-INITIALISE.

IF NOT EMPTY-FILE
PERFORM C-PROCESS.

PERFORM D-FINISH.

A-999.
STOP RUN.

B-INITIALISE SECTION.
B-000.
DISPLAY "*** " WA-PROGNAME " VERSION "
WA-VERSION " STARTING ***".

MOVE ALL "N" TO WF-CONDITION-FLAGS.
OPEN INPUT FA-INPUT-FILE.
SET WB-IX-1 TO 0.

READ FA-INPUT-FILE AT END MOVE "Y" TO WF-EOF-FLAG
WF-EMPTY-FILE-FLAG.

PERFORM BA-READ-INPUT UNTIL END-OF-FILE.

CLOSE FA-INPUT-FILE.

SET WC-SIZE TO WB-IX-1.

B-999.
EXIT.

BA-READ-INPUT SECTION.
BA-000.
SET WB-IX-1 UP BY 1.
MOVE FA-DATA TO WB-ENTRY(WB-IX-1).

READ FA-INPUT-FILE AT END MOVE "Y" TO WF-EOF-FLAG.

BA-999.
EXIT.

C-PROCESS SECTION.
C-000.
DISPLAY "SORT STARTING".

MOVE 1 TO WS-START(1).
MOVE WC-SIZE TO WS-END(1).
MOVE "F" TO WS-FS-FLAG(1).
MOVE "I" TO WS-IO-FLAG(1).
SET WS-STACK-TOP TO 2.

PERFORM E-MERGE-SORT UNTIL WS-OUT(1).

DISPLAY "SORT FINISHED".

C-999.
EXIT.

D-FINISH SECTION.
D-000.
OPEN OUTPUT FB-OUTPUT-FILE.
SET WB-IX-1 TO 1.

PERFORM DA-WRITE-OUTPUT UNTIL WB-IX-1 > WC-SIZE.

CLOSE FB-OUTPUT-FILE.

DISPLAY "*** " WA-PROGNAME " FINISHED ***".

D-999.
EXIT.

DA-WRITE-OUTPUT SECTION.
DA-000.
WRITE FB-OUTPUT-REC FROM WB-ENTRY(WB-IX-1).
SET WB-IX-1 UP BY 1.

DA-999.
EXIT.

******************************************************************
E-MERGE-SORT SECTION.
*===================== *
* This section controls the simulated recursion. *
******************************************************************
E-000.
IF WS-OUT(WS-STACK-TOP - 1)
GO TO E-010.

MOVE WS-START(WS-STACK-TOP - 1) TO WC-START.
MOVE WS-END(WS-STACK-TOP - 1) TO WC-END.

* First check size of part we are dealing with.
IF WC-END - WC-START = 0
* Only 1 number in range, so simply set for output, and move on
MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1)
GO TO E-010.

IF WC-END - WC-START = 1
* 2 numbers, so compare and swap as necessary. Set for output
MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1)
IF WB-ENTRY(WC-START) > WB-ENTRY(WC-END)
MOVE WB-ENTRY(WC-START) TO WC-TEMP
MOVE WB-ENTRY(WC-END) TO WB-ENTRY(WC-START)
MOVE WC-TEMP TO WB-ENTRY(WC-END)
GO TO E-010
ELSE
GO TO E-010.

* More than 2, so split and carry on down
COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2.

MOVE WC-START TO WS-START(WS-STACK-TOP).
MOVE WC-MIDDLE TO WS-END(WS-STACK-TOP).
MOVE "F" TO WS-FS-FLAG(WS-STACK-TOP).
MOVE "I" TO WS-IO-FLAG(WS-STACK-TOP).
SET WS-STACK-TOP UP BY 1.

GO TO E-999.

E-010.
SET WS-STACK-TOP DOWN BY 1.

IF SECOND-HALF(WS-STACK-TOP)
GO TO E-020.

MOVE WS-START(WS-STACK-TOP - 1) TO WC-START.
MOVE WS-END(WS-STACK-TOP - 1) TO WC-END.
COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2 + 1.

MOVE WC-MIDDLE TO WS-START(WS-STACK-TOP).
MOVE WC-END TO WS-END(WS-STACK-TOP).
MOVE "S" TO WS-FS-FLAG(WS-STACK-TOP).
MOVE "I" TO WS-IO-FLAG(WS-STACK-TOP).
SET WS-STACK-TOP UP BY 1.

GO TO E-999.

E-020.
MOVE WS-START(WS-STACK-TOP - 1) TO WC-START.
MOVE WS-END(WS-STACK-TOP - 1) TO WC-END.
COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2.
PERFORM H-PROCESS-MERGE.
MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1).

E-999.
EXIT.

******************************************************************
H-PROCESS-MERGE SECTION.
*======================== *
* This section identifies which data is to be merged, and then *
* merges the two data streams into a single larger data stream. *
******************************************************************
H-000.
INITIALISE WD-FIRST-HALF.
COMPUTE WD-FH-MAX = WC-MIDDLE - WC-START + 1.
SET WD-IX TO 1.

PERFORM HA-COPY-OUT VARYING WB-IX-1 FROM WC-START BY 1
UNTIL WB-IX-1 > WC-MIDDLE.

SET WB-IX-1 TO WC-START.
SET WB-IX-2 TO WC-MIDDLE.
SET WB-IX-2 UP BY 1.
SET WD-IX TO 1.
PERFORM HB-MERGE UNTIL WD-IX > WD-FH-MAX OR WB-IX-2 > WC-END.

PERFORM HC-COPY-BACK UNTIL WD-IX > WD-FH-MAX.

H-999.
EXIT.

HA-COPY-OUT SECTION.
HA-000.
MOVE WB-ENTRY(WB-IX-1) TO WD-ENTRY(WD-IX).
SET WD-IX UP BY 1.

HA-999.
EXIT.

HB-MERGE SECTION.
HB-000.
IF WB-ENTRY(WB-IX-2) < WD-ENTRY(WD-IX)
MOVE WB-ENTRY(WB-IX-2) TO WB-ENTRY(WB-IX-1)
SET WB-IX-2 UP BY 1
ELSE
MOVE WD-ENTRY(WD-IX) TO WB-ENTRY(WB-IX-1)
SET WD-IX UP BY 1.

SET WB-IX-1 UP BY 1.

HB-999.
EXIT.

HC-COPY-BACK SECTION.
HC-000.
MOVE WD-ENTRY(WD-IX) TO WB-ENTRY(WB-IX-1).
SET WD-IX UP BY 1.
SET WB-IX-1 UP BY 1.

HC-999.
EXIT.</syntaxhighlight>

=={{header|CoffeeScript}}==
<syntaxhighlight lang="coffeescript"># This is a simple version of mergesort that returns brand-new arrays.
# A more sophisticated version would do more in-place optimizations.
merge_sort = (arr) ->
if arr.length <= 1
return (elem for elem in arr)
m = Math.floor(arr.length / 2)
arr1 = merge_sort(arr.slice 0, m)
arr2 = merge_sort(arr.slice m)
result = []
p1 = p2 = 0
while true
if p1 >= arr1.length
if p2 >= arr2.length
return result
result.push arr2[p2]
p2 += 1
else if p2 >= arr2.length or arr1[p1] < arr2[p2]
result.push arr1[p1]
p1 += 1
else
result.push arr2[p2]
p2 += 1

do ->
console.log merge_sort [2,4,6,8,1,3,5,7,9,10,11,0,13,12]</syntaxhighlight>
{{out}}
<pre>
> coffee mergesort.coffee
[ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ]
</pre>

=={{header|Common Lisp}}==
<syntaxhighlight lang="lisp">(defun merge-sort (result-type sequence predicate)
(let ((split (floor (length sequence) 2)))
(let ((split (floor (length sequence) 2)))
(if (zerop split)
(if (zerop split)
Line 336: Line 2,862:
(merge result-type (merge-sort result-type (subseq sequence 0 split) predicate)
(merge result-type (merge-sort result-type (subseq sequence 0 split) predicate)
(merge-sort result-type (subseq sequence split) predicate)
(merge-sort result-type (subseq sequence split) predicate)
predicate))))
predicate))))</syntaxhighlight>


<code>merge</code> is a standard Common Lisp function.
<tt>merge</tt> is a standard Common Lisp function.


> (merge-sort 'list (list 1 3 5 7 9 8 6 4 2) #'<)
> (merge-sort 'list (list 1 3 5 7 9 8 6 4 2) #'<)
(1 2 3 4 5 6 7 8 9)
(1 2 3 4 5 6 7 8 9)
=={{header|D}}==
{{works with|Tango}}
<pre>module mergesort ;


=={{header|Component Pascal}}==
version(Tango) {
{{works with|BlackBox Component Builder}}
import tango.io.Stdout ;

import tango.util.collection.LinkSeq ;
Inspired by the approach used by the Modula-2[https://rosettacode.org/wiki/Sorting_algorithms/Merge_sort#Recursive_on_linked_list] application.
alias LinkSeq!(int) LNK ;

</pre>
This an implementation of the stable merge sort algorithm for linked lists.
<pre style="background-color:#ffe"> // Tango LinkSeq version
The merge sort algorithm is often the best choice for sorting a linked list.
void mergesort1(T)(T m) {

if (m.length <= 1)
The `Sort` procedure reduces the number of traversals by calculating the length only once at the beginning of the sorting process.
return m ;
This optimization leads to a more efficient sorting process, making it faster, especially for large input lists.
int mid = m.length / 2 ;

T left = m.subset(0, mid) ;
Two modules are provided - for implementing and for using the merge sort .
T right = m.subset(mid, m.length - mid) ;
<syntaxhighlight lang="oberon2">
mergesort1(left) ;
MODULE RosettaMergeSort;
mergesort1(right) ;

merge1(m, left, right) ;
}

void merge1(T)(T m, T left, T right) {
TYPE Template* = ABSTRACT RECORD END;
m.clear ;

while(left.length > 0 && right.length > 0)
(* Abstract Procedures: *)
if (left.head < right.head)

m.append(left.take()) ;
(* Return TRUE if list item`front` comes before list item `rear` in the sorted order, FALSE otherwise *)
else
(* For the sort to be stable `front` comes before `rear` if they are equal *)
m.append(right.take()) ;
PROCEDURE (IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
while(left.length > 0)

m.append(left.take()) ;
(* Return the next item in the list after `s` *)
while(right.length > 0)
PROCEDURE (IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
m.append(right.take()) ;

}</pre>
(* Update the next pointer of list item `s` to the value of list `next` - Return the modified `s` *)
PROCEDURE (IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;

(* Merge sorted lists `front` and `rear` - Return the merged sorted list *)
PROCEDURE (IN t: Template) Merge (front, rear: ANYPTR): ANYPTR, NEW;
BEGIN
IF front = NIL THEN RETURN rear END;
IF rear = NIL THEN RETURN front END;
IF t.Before(front, rear) THEN
RETURN t.Set(front, t.Merge(t.Next(front), rear))
ELSE
RETURN t.Set(rear, t.Merge(front, t.Next(rear)))
END
END Merge;

(* Sort the first `n` items in the list `s` and drop them from `s` *)
(* Return the sorted `n` items *)
PROCEDURE (IN t: Template) TakeSort (n: INTEGER; VAR s: ANYPTR): ANYPTR, NEW;
VAR k: INTEGER; front, rear: ANYPTR;
BEGIN
IF n = 1 THEN (* base case: if `n` is 1, return the head of `s` *)
front := s; s := t.Next(s); RETURN t.Set(front, NIL)
END;
(* Divide the first `n` items of `s` into two sorted parts *)
k := n DIV 2;
front := t.TakeSort(k, s);
rear := t.TakeSort(n - k, s);
RETURN t.Merge(front, rear) (* Return the merged parts *)
END TakeSort;

(* Perform a merge sort on `s` - Return the sorted list *)
PROCEDURE (IN t: Template) Sort* (s: ANYPTR): ANYPTR, NEW;
VAR n: INTEGER; r: ANYPTR;
BEGIN
IF s = NIL THEN RETURN s END; (* If `s` is empty, return `s` *)
(* Count of items in `s` *)
n := 0; r := s; (* Initialize the item to be counted to `s` *)
WHILE r # NIL DO INC(n); r := t.Next(r) END;
RETURN t.TakeSort(n, s) (* Return the sorted list *)
END Sort;

END RosettaMergeSort.
</syntaxhighlight>
Interface extracted from implementation:
<syntaxhighlight lang="oberon2">
DEFINITION RosettaMergeSort;

TYPE
Template = ABSTRACT RECORD
(IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
(IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
(IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;
(IN t: Template) Sort (s: ANYPTR): ANYPTR, NEW
END;

END RosettaMergeSort.
</syntaxhighlight>
Use the merge sort implementation from `RosettaMergeSort` to sort a linked list of characters:
<syntaxhighlight lang="oberon2">
MODULE RosettaMergeSortUse;

(* Import Modules: *)
IMPORT Sort := RosettaMergeSort, Out;

(* Type Definitions: *)
TYPE
(* a character list *)
List = POINTER TO RECORD
value: CHAR;
next: List
END;

(* Implement the abstract record type Sort.Template *)
Order = ABSTRACT RECORD (Sort.Template) END;
Asc = RECORD (Order) END;
Bad = RECORD (Order) END;
Desc = RECORD (Order) END;

(* Abstract Procedure Implementations: *)

(* Return the next node in the linked list *)
PROCEDURE (IN t: Order) Next (s: ANYPTR): ANYPTR;
BEGIN RETURN s(List).next END Next;

(* Set the next pointer of list item `s` to `next` - Return the updated `s` *)
PROCEDURE (IN t: Order) Set (s, next: ANYPTR): ANYPTR;
BEGIN
IF next = NIL THEN s(List).next := NIL
ELSE s(List).next := next(List) END;
RETURN s
END Set;

(* Ignoring case, compare characters to determine ascending order in the sorted list *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Asc) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) <= CAP(rear(List).value)
END Before;

(* Unstable sort!!! *)
PROCEDURE (IN t: Bad) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) < CAP(rear(List).value)
END Before;

(* Ignoring case, compare characters to determine descending order in the sorted list *)
(* For the sort to be stable `front` comes before `rear` if they are equal *)
PROCEDURE (IN t: Desc) Before (front, rear: ANYPTR): BOOLEAN;
BEGIN
RETURN CAP(front(List).value) >= CAP(rear(List).value)
END Before;

(* Helper Procedures: *)

(* Takes a string and converts it into a linked list of characters *)
PROCEDURE Explode (str: ARRAY OF CHAR): List;
VAR i: INTEGER; h, t: List;
BEGIN
i := LEN(str$);
WHILE i # 0 DO
t := h; NEW(h);
DEC(i); h.value := str[i];
h.next := t
END;
RETURN h
END Explode;

(* Outputs the characters in a linked list as a string in quotes *)
PROCEDURE Show (s: List);
VAR i: INTEGER;
BEGIN
Out.Char('"');
WHILE s # NIL DO Out.Char(s.value); s := s.next END;
Out.Char('"')
END Show;

(* Main Procedure: *)
PROCEDURE Use*;
VAR a: Asc; b: Bad; d: Desc; s: List;
BEGIN
s := Explode("A quick brown fox jumps over the lazy dog");
Out.String("Before:"); Out.Ln; Show(s); Out.Ln;
s := a.Sort(s)(List); (* Ascending stable sort *)
Out.String("After Asc:"); Out.Ln; Show(s); Out.Ln;
s := b.Sort(s)(List); (* Ascending unstable sort *)
Out.String("After Bad:"); Out.Ln; Show(s); Out.Ln;
s := d.Sort(s)(List); (* Descending stable sort *)
Out.String("After Desc:"); Out.Ln; Show(s); Out.Ln
END Use;


END RosettaMergeSortUse.
</syntaxhighlight>
Execute: ^Q RosettaMergeSortUse.Use
{{out}}
<pre>
<pre>
Before:
alias Stdout print ;
"A quick brown fox jumps over the lazy dog"
} else { // not Version Tango
After Asc:
import std.stdio ;
" Aabcdeefghijklmnoooopqrrstuuvwxyz"
alias writef print ;
After Bad:
}
" aAbcdeefghijklmnoooopqrrstuuvwxyz"
After Desc:
"zyxwvuutsrrqpoooonmlkjihgfeedcbaA "
</pre>
</pre>

<pre style="background-color:#ffe">// D array version
=={{header|Crystal}}==
T[] mergesort2(T)(inout T[] m) {
{{trans|Ruby}}
if (m.length <= 1)
<syntaxhighlight lang="ruby">def merge_sort(a : Array(Int32)) : Array(Int32)
return m ;
int mid = m.length / 2 ;
return a if a.size <= 1
m = a.size // 2
T[] left, right;
left = m[0..mid] ;
lt = merge_sort(a[0 ... m])
right = m[mid..$] ;
rt = merge_sort(a[m .. -1])
return merge(lt, rt)
left.mergesort2() ;
end
right.mergesort2() ;
m.merge2(left, right) ;
def merge(lt : Array(Int32), rt : Array(Int32)) : Array(Int32)
return m ;
result = Array(Int32).new
until lt.empty? || rt.empty?
result << (lt.first < rt.first ? lt.shift : rt.shift)
end
return result + lt + rt
end
a = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
puts merge_sort(a) # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</syntaxhighlight>

=={{header|Curry}}==
Copied from [http://www.informatik.uni-kiel.de/~curry/examples/ Curry: Example Programs]
<syntaxhighlight lang="curry">-- merge sort: sorting two lists by merging the sorted first
-- and second half of the list

sort :: ([a] -> [a] -> [a] -> Success) -> [a] -> [a] -> Success

sort merge xs ys =
if length xs < 2 then ys =:= xs
else sort merge (firsthalf xs) us
& sort merge (secondhalf xs) vs
& merge us vs ys
where us,vs free


intMerge :: [Int] -> [Int] -> [Int] -> Success

intMerge [] ys zs = zs =:= ys
intMerge (x:xs) [] zs = zs =:= x:xs
intMerge (x:xs) (y:ys) zs =
if (x > y) then intMerge (x:xs) ys us & zs =:= y:us
else intMerge xs (y:ys) vs & zs =:= x:vs
where us,vs free
firsthalf xs = take (length xs `div` 2) xs
secondhalf xs = drop (length xs `div` 2) xs



goal1 xs = sort intMerge [3,1,2] xs
goal2 xs = sort intMerge [3,1,2,5,4,8] xs
goal3 xs = sort intMerge [3,1,2,5,4,8,6,7,2,9,1,4,3] xs</syntaxhighlight>

=={{header|D}}==
Arrays only, not in-place.
<syntaxhighlight lang="d">import std.stdio, std.algorithm, std.array, std.range;

T[] mergeSorted(T)(in T[] D) /*pure nothrow @safe*/ {
if (D.length < 2)
return D.dup;
return [D[0 .. $ / 2].mergeSorted, D[$ / 2 .. $].mergeSorted]
.nWayUnion.array;
}
}

void merge2(T)(inout T[] merged, inout T[] left, inout T[] right) {
void main() {
T[] m = new T[left.length + right.length];
[3, 4, 2, 5, 1, 6].mergeSorted.writeln;
int headL = 0 ;
}</syntaxhighlight>
int headR = 0 ;

int tailM = 0 ;
===Alternative Version===
while (headL < left.length && headR < right.length)
This in-place version allocates the auxiliary memory on the stack,
if(left[headL] < right[headR])
making life easier for the garbage collector,
m[tailM++] = left[headL++] ;
but with risk of stack overflow (same output):
else
<syntaxhighlight lang="d">import std.stdio, std.algorithm, core.stdc.stdlib, std.exception,
m[tailM++] = right[headR++] ;
if (headL < left.length)
std.range;

m[tailM..$] = left[headL..$] ;
void mergeSort(T)(T[] data) if (hasSwappableElements!(typeof(data))) {
else if (headR < right.length)
m[tailM..$] = right[headR..$] ;
immutable L = data.length;
merged = m ;
if (L < 2) return;
T* ptr = cast(T*)alloca(L * T.sizeof);
}</pre>
enforce(ptr != null);
<pre>void dump(T)(T l) {
ptr[0 .. L] = data[];
foreach(e ; l)
print(e," ") ;
mergeSort(ptr[0 .. L/2]);
mergeSort(ptr[L/2 .. L]);
print("\n") ;
[ptr[0 .. L/2], ptr[L/2 .. L]].nWayUnion().copy(data);
}
}

void main() {
void main() {
int[] arr = [8,6,4,2,1,3,5,7,9] ;
auto a = [3, 4, 2, 5, 1, 6];
a.mergeSort();
writeln(a);
}</syntaxhighlight>
<!-- Missing in-place version for arrays -->
<!-- Missing generic version for Ranges -->

=={{header|Dart}}==
<syntaxhighlight lang="dart">void main() {
MergeSortInDart sampleSort = MergeSortInDart();

List<int> theResultingList = sampleSort.sortTheList([54, 89, 125, 47899, 32, 61, 42, 895647, 215, 345, 6, 21, 2, 78]);

print('Here\'s the sorted list: ${theResultingList}');
}

/////////////////////////////////////

class MergeSortInDart {

List<int> sortedList;

// In Dart we often put helper functions at the bottom.
// You could put them anywhere, we just like it this way
// for organizational purposes. It's nice to be able to
// read them in the order they're called.


// Start here
version(Tango) {
List<int> sortTheList(List<int> sortThis){
LNK lnk = new LNK ;
// My parameters are listed vertically for readability. Dart
foreach(e;arr)
// doesn't care how you list them, vertically or horizontally.
lnk.append(e);
dump(lnk) ;
sortedList = mSort(
sortThis,
mergesort1(lnk) ;
sortThis.sublist(0, sortThis.length),
dump(lnk) ;
sortThis.length,
);
return sortThis;
}
}
dump(arr) ;
mergesort2(arr) ;
dump(arr) ;
}</pre>


mSort(
List<int> sortThisList,
List<int> tempList,
int thisListLength) {

if (thisListLength == 1) {
return;
}

// In Dart using ~/ is more efficient than using .floor()
int middle = (thisListLength ~/ 2);

// If you use something in a try/on/catch/finally block then
// be sure to declare it outside the block (for scope)
List<int> tempLeftList;

// This was used for troubleshooting. It was left here to show
// how a basic block try/on can be better than a debugPrint since
// it won't print unless there's a problem.
try {
tempLeftList = tempList.sublist(0, middle);
} on RangeError {
print(
'tempLeftList length = ${tempList.length}, thisListLength '
'was supposedly $thisListLength and Middle was $middle');
}

// If you see "myList.getRange(x,y)" that's a sign the code is
// from Dart 1 and needs to be updated. It's "myList.sublist" in Dart 2
List<int> tempRightList = tempList.sublist(middle);

// Left side.
mSort(
tempLeftList,
sortThisList.sublist(0, middle),
middle,
);

// Right side.
mSort(
tempRightList,
sortThisList.sublist(middle),
sortThisList.length - middle,
);

// Merge it.
dartMerge(
tempLeftList,
tempRightList,
sortThisList,
);
}

dartMerge(
List<int> leftSide,
List<int> rightSide,
List<int> sortThisList,
) {
int index = 0;
int elementValue;

// This should be human readable.
while (leftSide.isNotEmpty && rightSide.isNotEmpty) {
if (rightSide[0] < leftSide[0]) {
elementValue = rightSide[0];
rightSide.removeRange(0, 1);
} else {
elementValue = leftSide[0];
leftSide.removeRange(0, 1);
}
sortThisList[index++] = elementValue;
}

while (leftSide.isNotEmpty) {
elementValue = leftSide[0];
leftSide.removeRange(0, 1);
sortThisList[index++] = elementValue;
}

while (rightSide.isNotEmpty) {
elementValue = rightSide[0];
rightSide.removeRange(0, 1);
sortThisList[index++] = elementValue;
}
sortedList = sortThisList;
}
}</syntaxhighlight>
=={{header|Delphi}}==
See [https://rosettacode.org/wiki/Sorting_algorithms/Merge_sort#Pascal Pascal].
=={{header|E}}==
=={{header|E}}==
<syntaxhighlight lang="e">def merge(var xs :List, var ys :List) {
var result := []
while (xs =~ [x] + xr && ys =~ [y] + yr) {
if (x <= y) {
result with= x
xs := xr
} else {
result with= y
ys := yr
}
}
return result + xs + ys
}


def merge(var xs :List, var ys :List) {
def sort(list :List) {
if (list.size() <= 1) { return list }
var result := []
def split := list.size() // 2
while (xs =~ [x] + xr && ys =~ [y] + yr) {
return merge(sort(list.run(0, split)),
if (x < y) {
result with= x
sort(list.run(split)))
}</syntaxhighlight>
xs := xr

} else {
=={{header|EasyLang}}==
result with= y

ys := yr
<syntaxhighlight lang="text">
}
}
proc sort . d[] .
len tmp[] len d[]
return result + xs + ys
sz = 1
}
while sz < len d[]
swap tmp[] d[]
def sort(list :List) {
if (list.size() <= 1) { return list }
left = 1
def split := list.size() // 2
while left < len d[]
# merge
return merge(sort(list.run(0, split)),
sort(list.run(split)))
mid = left + sz - 1
if mid > len d[]
}
mid = len d[]
.
right = mid + sz
if right > len d[]
right = len d[]
.
l = left
r = mid + 1
for i = left to right
if r > right or l <= mid and tmp[l] < tmp[r]
d[i] = tmp[l]
l += 1
else
d[i] = tmp[r]
r += 1
.
.
left += 2 * sz
.
sz *= 2
.
.
data[] = [ 29 4 72 44 55 26 27 77 92 5 ]
sort data[]
print data[]
</syntaxhighlight>

=={{header|Eiffel}}==
<syntaxhighlight lang="eiffel">
class
MERGE_SORT [G -> COMPARABLE]

create
sort

feature

sort (ar: ARRAY [G])
-- Sorted array in ascending order.
require
ar_not_empty: not ar.is_empty
do
create sorted_array.make_empty
mergesort (ar, 1, ar.count)
sorted_array := ar
ensure
sorted_array_not_empty: not sorted_array.is_empty
sorted: is_sorted (sorted_array, 1, sorted_array.count)
end

sorted_array: ARRAY [G]

feature {NONE}

mergesort (ar: ARRAY [G]; l, r: INTEGER)
-- Sorting part of mergesort.
local
m: INTEGER
do
if l < r then
m := (l + r) // 2
mergesort (ar, l, m)
mergesort (ar, m + 1, r)
merge (ar, l, m, r)
end
end

merge (ar: ARRAY [G]; l, m, r: INTEGER)
-- Merge part of mergesort.
require
positive_index_l: l >= 1
positive_index_m: m >= 1
positive_index_r: r >= 1
ar_not_empty: not ar.is_empty
local
merged: ARRAY [G]
h, i, j, k: INTEGER
do
i := l
j := m + 1
k := l
create merged.make_filled (ar [1], 1, ar.count)
from
until
i > m or j > r
loop
if ar.item (i) <= ar.item (j) then
merged.force (ar.item (i), k)
i := i + 1
elseif ar.item (i) > ar.item (j) then
merged.force (ar.item (j), k)
j := j + 1
end
k := k + 1
end
if i > m then
from
h := j
until
h > r
loop
merged.force (ar.item (h), k + h - j)
h := h + 1
end
elseif j > m then
from
h := i
until
h > m
loop
merged.force (ar.item (h), k + h - i)
h := h + 1
end
end
from
h := l
until
h > r
loop
ar.item (h) := merged.item (h)
h := h + 1
end
ensure
is_partially_sorted: is_sorted (ar, l, r)
end

is_sorted (ar: ARRAY [G]; l, r: INTEGER): BOOLEAN
-- Is 'ar' sorted in ascending order?
require
ar_not_empty: not ar.is_empty
l_in_range: l >= 1
r_in_range: r <= ar.count
local
i: INTEGER
do
Result := True
from
i := l
until
i = r
loop
if ar [i] > ar [i + 1] then
Result := False
end
i := i + 1
end
end

end
</syntaxhighlight>
Test:
<syntaxhighlight lang="eiffel">
class
APPLICATION

create
make

feature

make
do
test := <<2, 5, 66, -2, 0, 7>>
io.put_string ("unsorted" + "%N")
across
test as ar
loop
io.put_string (ar.item.out + "%T")
end
io.put_string ("%N" + "sorted" + "%N")
create merge.sort (test)
across
merge.sorted_array as ar
loop
io.put_string (ar.item.out + "%T")
end
end

test: ARRAY [INTEGER]

merge: MERGE_SORT [INTEGER]

end
</syntaxhighlight>
{{out}}
<pre>
unsorted
2 5 66 -2 0 7
sorted
-2 0 2 5 7 66
</pre>

=={{header|Elixir}}==
<syntaxhighlight lang="elixir">defmodule Sort do
def merge_sort(list) when length(list) <= 1, do: list
def merge_sort(list) do
{left, right} = Enum.split(list, div(length(list), 2))
:lists.merge( merge_sort(left), merge_sort(right))
end
end</syntaxhighlight>
Example:
<pre>
iex(10)> Sort.merge_sort([5,3,9,4,1,6,8,2,7])
[1, 2, 3, 4, 5, 6, 7, 8, 9]
</pre>

=={{header|Erlang}}==
Below are two versions. Both take advantage of built-in Erlang functions, lists:split and list:merge. The multi-process version spawns a new process each time it splits. This was slightly faster on a test system with only two cores, so it may not be the best implementation, however it does illustrate how easy it can be to add multi-threaded/process capabilities to a program.

Single-threaded version:
<syntaxhighlight lang="erlang">mergeSort(L) when length(L) == 1 -> L;
mergeSort(L) when length(L) > 1 ->
{L1, L2} = lists:split(length(L) div 2, L),
lists:merge(mergeSort(L1), mergeSort(L2)).</syntaxhighlight>

Multi-process version:
<syntaxhighlight lang="erlang">pMergeSort(L) when length(L) == 1 -> L;
pMergeSort(L) when length(L) > 1 ->
{L1, L2} = lists:split(length(L) div 2, L),
spawn(mergesort, pMergeSort2, [L1, self()]),
spawn(mergesort, pMergeSort2, [L2, self()]),
mergeResults([]).

pMergeSort2(L, Parent) when length(L) == 1 -> Parent ! L;
pMergeSort2(L, Parent) when length(L) > 1 ->
{L1, L2} = lists:split(length(L) div 2, L),
spawn(mergesort, pMergeSort2, [L1, self()]),
spawn(mergesort, pMergeSort2, [L2, self()]),
Parent ! mergeResults([]).</syntaxhighlight>


another multi-process version (number of processes == number of processor cores):
<syntaxhighlight lang="erlang">
merge_sort(List) -> m(List, erlang:system_info(schedulers)).

m([L],_) -> [L];
m(L, N) when N > 1 ->
{L1,L2} = lists:split(length(L) div 2, L),
{Parent, Ref} = {self(), make_ref()},
spawn(fun()-> Parent ! {l1, Ref, m(L1, N-2)} end),
spawn(fun()-> Parent ! {l2, Ref, m(L2, N-2)} end),
{L1R, L2R} = receive_results(Ref, undefined, undefined),
lists:merge(L1R, L2R);
m(L, _) -> {L1,L2} = lists:split(length(L) div 2, L), lists:merge(m(L1, 0), m(L2, 0)).

receive_results(Ref, L1, L2) ->
receive
{l1, Ref, L1R} when L2 == undefined -> receive_results(Ref, L1R, L2);
{l2, Ref, L2R} when L1 == undefined -> receive_results(Ref, L1, L2R);
{l1, Ref, L1R} -> {L1R, L2};
{l2, Ref, L2R} -> {L1, L2R}
after 5000 -> receive_results(Ref, L1, L2)
end.
</syntaxhighlight>

=={{header|ERRE}}==
<syntaxhighlight lang="erre">
PROGRAM MERGESORT_DEMO

! Example of merge sort usage.

CONST SIZE%=100,S1%=50

DIM DTA%[SIZE%],FH%[S1%],STACK%[20,2]


PROCEDURE MERGE(START%,MIDDLE%,ENDS%)

LOCAL FHSIZE%

FHSIZE%=MIDDLE%-START%+1

FOR I%=0 TO FHSIZE%-1 DO
FH%[I%]=DTA%[START%+I%]
END FOR

I%=0
J%=MIDDLE%+1
K%=START%

REPEAT
IF FH%[I%]<=DTA%[J%] THEN
DTA%[K%]=FH%[I%]
I%=I%+1
K%=K%+1
ELSE
DTA%[K%]=DTA%[J%]
J%=J%+1
K%=K%+1
END IF
UNTIL I%=FHSIZE% OR J%>ENDS%

WHILE I%<FHSIZE% DO
DTA%[K%]=FH%[I%]
I%=I%+1
K%=K%+1
END WHILE

END PROCEDURE

PROCEDURE MERGE_SORT(LEV->LEV)

! *****************************************************************
! This procedure Merge Sorts the chunk of DTA% bounded by
! Start% & Ends%.
! *****************************************************************

LOCAL MIDDLE%

IF ENDS%=START% THEN LEV=LEV-1 EXIT PROCEDURE END IF

IF ENDS%-START%=1 THEN
IF DTA%[ENDS%]<DTA%[START%] THEN
SWAP(DTA%[START%],DTA%[ENDS%])
END IF
LEV=LEV-1
EXIT PROCEDURE
END IF

MIDDLE%=START%+(ENDS%-START%)/2

STACK%[LEV,0]=START% STACK%[LEV,1]=ENDS% STACK%[LEV,2]=MIDDLE%
START%=START% ENDS%=MIDDLE%
MERGE_SORT(LEV+1->LEV)
START%=STACK%[LEV,0] ENDS%=STACK%[LEV,1] MIDDLE%=STACK%[LEV,2]

STACK%[LEV,0]=START% STACK%[LEV,1]=ENDS% STACK%[LEV,2]=MIDDLE%
START%=MIDDLE%+1 ENDS%=ENDS%
MERGE_SORT(LEV+1->LEV)
START%=STACK%[LEV,0] ENDS%=STACK%[LEV,1] MIDDLE%=STACK%[LEV,2]

MERGE(START%,MIDDLE%,ENDS%)

LEV=LEV-1
END PROCEDURE

BEGIN
FOR I%=1 TO SIZE% DO
DTA%[I%]=RND(1)*10000
END FOR

START%=1 ENDS%=SIZE%
MERGE_SORT(0->LEV)

FOR I%=1 TO SIZE% DO
WRITE("#####";DTA%[I%];)
END FOR
PRINT
END PROGRAM
</syntaxhighlight>

=={{header|Euphoria}}==
<syntaxhighlight lang="euphoria">function merge(sequence left, sequence right)
sequence result
result = {}
while length(left) > 0 and length(right) > 0 do
if compare(left[1], right[1]) <= 0 then
result = append(result, left[1])
left = left[2..$]
else
result = append(result, right[1])
right = right[2..$]
end if
end while
return result & left & right
end function

function mergesort(sequence m)
sequence left, right
integer middle
if length(m) <= 1 then
return m
else
middle = floor(length(m)/2)
left = mergesort(m[1..middle])
right = mergesort(m[middle+1..$])
if compare(left[$], right[1]) <= 0 then
return left & right
elsif compare(right[$], left[1]) <= 0 then
return right & left
else
return merge(left, right)
end if
end if
end function

constant s = rand(repeat(1000,10))
? s
? mergesort(s)</syntaxhighlight>
{{out}}
<pre>{385,599,284,650,457,804,724,300,434,722}
{284,300,385,434,457,599,650,722,724,804}
</pre>

=={{header|F Sharp|F#}}==
<syntaxhighlight lang="fsharp">let split list =
let rec aux l acc1 acc2 =
match l with
| [] -> (acc1,acc2)
| [x] -> (x::acc1,acc2)
| x::y::tail ->
aux tail (x::acc1) (y::acc2)
in aux list [] []

let rec merge l1 l2 =
match (l1,l2) with
| (x,[]) -> x
| ([],y) -> y
| (x::tx,y::ty) ->
if x <= y then x::merge tx l2
else y::merge l1 ty
let rec mergesort list =
match list with
| [] -> []
| [x] -> [x]
| _ -> let (l1,l2) = split list
in merge (mergesort l1) (mergesort l2)</syntaxhighlight>

=={{header|Factor}}==
<syntaxhighlight lang="factor">: mergestep ( accum seq1 seq2 -- accum seq1 seq2 )
2dup [ first ] bi@ <
[ [ [ first ] [ rest-slice ] bi [ suffix ] dip ] dip ]
[ [ first ] [ rest-slice ] bi [ swap [ suffix ] dip ] dip ]
if ;

: merge ( seq1 seq2 -- merged )
[ { } ] 2dip
[ 2dup [ length 0 > ] bi@ and ]
[ mergestep ] while
append append ;

: mergesort ( seq -- sorted )
dup length 1 >
[ dup length 2 / floor [ head ] [ tail ] 2bi [ mergesort ] bi@ merge ]
[ ] if ;</syntaxhighlight>

<syntaxhighlight lang="factor">( scratchpad ) { 4 2 6 5 7 1 3 } mergesort .
{ 1 2 3 4 5 6 7 }</syntaxhighlight>

=={{header|Forth}}==
This is an in-place mergesort which works on arrays of integers.
<syntaxhighlight lang="forth">: merge-step ( right mid left -- right mid+ left+ )
over @ over @ < if
over @ >r
2dup - over dup cell+ rot move
r> over !
>r cell+ 2dup = if rdrop dup else r> then
then cell+ ;
: merge ( right mid left -- right left )
dup >r begin 2dup > while merge-step repeat 2drop r> ;

: mid ( l r -- mid ) over - 2/ cell negate and + ;

: mergesort ( right left -- right left )
2dup cell+ <= if exit then
swap 2dup mid recurse rot recurse merge ;
: sort ( addr len -- ) cells over + swap mergesort 2drop ;

create test 8 , 1 , 5 , 3 , 9 , 0 , 2 , 7 , 6 , 4 ,

: .array ( addr len -- ) 0 do dup i cells + @ . loop drop ;

test 10 2dup sort .array \ 0 1 2 3 4 5 6 7 8 9</syntaxhighlight>

=={{header|Fortran}}==
{{works with|Fortran|95 and later and with both free or fixed form syntax.}}
<syntaxhighlight lang="fortran"> program TestMergeSort
implicit none
integer, parameter :: N = 8
integer :: A(N) = (/ 1, 5, 2, 7, 3, 9, 4, 6 /)
integer :: work((size(A) + 1) / 2)
write(*,'(A,/,10I3)')'Unsorted array :',A
call MergeSort(A, work)
write(*,'(A,/,10I3)')'Sorted array :',A
contains

subroutine merge(A, B, C)
implicit none
! The targe attribute is necessary, because A .or. B might overlap with C.
integer, target, intent(in) :: A(:), B(:)
integer, target, intent(inout) :: C(:)
integer :: i, j, k

if (size(A) + size(B) > size(C)) stop(1)

i = 1; j = 1
do k = 1, size(C)
if (i <= size(A) .and. j <= size(B)) then
if (A(i) <= B(j)) then
C(k) = A(i)
i = i + 1
else
C(k) = B(j)
j = j + 1
end if
else if (i <= size(A)) then
C(k) = A(i)
i = i + 1
else if (j <= size(B)) then
C(k) = B(j)
j = j + 1
end if
end do
end subroutine merge

subroutine swap(x, y)
implicit none
integer, intent(inout) :: x, y
integer :: tmp
tmp = x; x = y; y = tmp
end subroutine

recursive subroutine MergeSort(A, work)
implicit none
integer, intent(inout) :: A(:)
integer, intent(inout) :: work(:)
integer :: half
half = (size(A) + 1) / 2
if (size(A) < 2) then
continue
else if (size(A) == 2) then
if (A(1) > A(2)) then
call swap(A(1), A(2))
end if
else
call MergeSort(A( : half), work)
call MergeSort(A(half + 1 :), work)
if (A(half) > A(half + 1)) then
work(1 : half) = A(1 : half)
call merge(work(1 : half), A(half + 1:), A)
endif
end if
end subroutine MergeSort
end program TestMergeSort
</syntaxhighlight>

=={{header|FreeBASIC}}==
Uses 'top down' C-like algorithm in Wikipedia article:
<syntaxhighlight lang="freebasic">' FB 1.05.0 Win64

Sub copyArray(a() As Integer, iBegin As Integer, iEnd As Integer, b() As Integer)
Redim b(iBegin To iEnd - 1) As Integer
For k As Integer = iBegin To iEnd - 1
b(k) = a(k)
Next
End Sub

' Left source half is a(iBegin To iMiddle-1).
' Right source half is a(iMiddle To iEnd-1).
' Result is b(iBegin To iEnd-1).
Sub topDownMerge(a() As Integer, iBegin As Integer, iMiddle As Integer, iEnd As Integer, b() As Integer)
Dim i As Integer = iBegin
Dim j As Integer = iMiddle
' While there are elements in the left or right runs...
For k As Integer = iBegin To iEnd - 1
' If left run head exists and is <= existing right run head.
If i < iMiddle AndAlso (j >= iEnd OrElse a(i) <= a(j)) Then
b(k) = a(i)
i += 1
Else
b(k) = a(j)
j += 1
End If
Next
End Sub

' Sort the given run of array a() using array b() as a source.
' iBegin is inclusive; iEnd is exclusive (a(iEnd) is not in the set).
Sub topDownSplitMerge(b() As Integer, iBegin As Integer, iEnd As Integer, a() As Integer)
If (iEnd - iBegin) < 2 Then Return '' If run size = 1, consider it sorted
' split the run longer than 1 item into halves
Dim iMiddle As Integer = (iEnd + iBegin) \ 2 '' iMiddle = mid point
' recursively sort both runs from array a() into b()
topDownSplitMerge(a(), iBegin, iMiddle, b()) '' sort the left run
topDownSplitMerge(a(), iMiddle, iEnd, b()) '' sort the right run
' merge the resulting runs from array b() into a()
topDownMerge(b(), iBegin, iMiddle, iEnd, a())
End Sub

' Array a() has the items to sort; array b() is a work array (empty initially).
Sub topDownMergeSort(a() As Integer, b() As Integer, n As Integer)
copyArray(a(), 0, n, b()) '' duplicate array a() into b()
topDownSplitMerge(b(), 0, n, a()) '' sort data from b() into a()
End Sub

Sub printArray(a() As Integer)
For i As Integer = LBound(a) To UBound(a)
Print Using "####"; a(i);
Next
Print
End Sub

Dim a(0 To 9) As Integer = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1}

Dim b() As Integer
Print "Unsorted : ";
printArray(a())
topDownMergeSort a(), b(), 10
Print "Sorted : ";
printArray(a())
Print
Dim a2(0 To 8) As Integer = {7, 5, 2, 6, 1, 4, 2, 6, 3}
Erase b
Print "Unsorted : ";
printArray(a2())
topDownMergeSort a2(), b(), 9
Print "Sorted : ";
printArray(a2())
Print
Print "Press any key to quit"
Sleep</syntaxhighlight>

{{out}}
<pre>
Unsorted : 4 65 2 -31 0 99 2 83 782 1
Sorted : -31 0 1 2 2 4 65 83 99 782

Unsorted : 7 5 2 6 1 4 2 6 3
Sorted : 1 2 2 3 4 5 6 6 7
</pre>

=={{header|FunL}}==
<syntaxhighlight lang="funl">def
sort( [] ) = []
sort( [x] ) = [x]
sort( xs ) =
val (l, r) = xs.splitAt( xs.length()\2 )
merge( sort(l), sort(r) )

merge( [], xs ) = xs
merge( xs, [] ) = xs
merge( x:xs, y:ys )
| x <= y = x : merge( xs, y:ys )
| otherwise = y : merge( x:xs, ys )
println( sort([94, 37, 16, 56, 72, 48, 17, 27, 58, 67]) )
println( sort(['Sofía', 'Alysha', 'Sophia', 'Maya', 'Emma', 'Olivia', 'Emily']) )</syntaxhighlight>

{{out}}

<pre>
[16, 17, 27, 37, 48, 56, 58, 67, 72, 94]
[Alysha, Emily, Emma, Maya, Olivia, Sofía, Sophia]
</pre>

=={{header|Go}}==
<syntaxhighlight lang="go">package main

import "fmt"

var a = []int{170, 45, 75, -90, -802, 24, 2, 66}
var s = make([]int, len(a)/2+1) // scratch space for merge step

func main() {
fmt.Println("before:", a)
mergeSort(a)
fmt.Println("after: ", a)
}

func mergeSort(a []int) {
if len(a) < 2 {
return
}
mid := len(a) / 2
mergeSort(a[:mid])
mergeSort(a[mid:])
if a[mid-1] <= a[mid] {
return
}
// merge step, with the copy-half optimization
copy(s, a[:mid])
l, r := 0, mid
for i := 0; ; i++ {
if s[l] <= a[r] {
a[i] = s[l]
l++
if l == mid {
break
}
} else {
a[i] = a[r]
r++
if r == len(a) {
copy(a[i+1:], s[l:mid])
break
}
}
}
return
}</syntaxhighlight>

=={{header|Groovy}}==
This is the standard algorithm, except that in the looping phase of the merge we work backwards through the left and right lists to construct the merged list, to take advantage of the [[Groovy]] ''List.pop()'' method. However, this results in a partially merged list in reverse sort order; so we then reverse it to put in back into correct order. This could play havoc with the sort stability, but we compensate by picking aggressively from the right list (ties go to the right), rather than aggressively from the left as is done in the standard algorithm.
<syntaxhighlight lang="groovy">def merge = { List left, List right ->
List mergeList = []
while (left && right) {
print "."
mergeList << ((left[-1] > right[-1]) ? left.pop() : right.pop())
}
mergeList = mergeList.reverse()
mergeList = left + right + mergeList
}

def mergeSort;
mergeSort = { List list ->

def n = list.size()
if (n < 2) return list
def middle = n.intdiv(2)
def left = [] + list[0..<middle]
def right = [] + list[middle..<n]
left = mergeSort(left)
right = mergeSort(right)
if (left[-1] <= right[0]) return left + right
merge(left, right)
}</syntaxhighlight>
Test:
<syntaxhighlight lang="groovy">println (mergeSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4]))
println (mergeSort([88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1]))
println ()
println (mergeSort([10, 10.0, 10.00, 1]))
println (mergeSort([10, 10.00, 10.0, 1]))
println (mergeSort([10.0, 10, 10.00, 1]))
println (mergeSort([10.0, 10.00, 10, 1]))
println (mergeSort([10.00, 10, 10.0, 1]))
println (mergeSort([10.00, 10.0, 10, 1]))</syntaxhighlight>
The presence of decimal and integer versions of the same numbers, demonstrates, but of course does not '''prove''', that the sort remains stable.
{{out}}
<pre>.............................................................[4, 12, 14, 23, 24, 24, 31, 35, 38, 46, 51, 57, 57, 58, 76, 78, 89, 92, 95, 97, 99]
....................................................................[0, 1, 4, 5, 7, 8, 12, 14, 18, 20, 31, 33, 44, 62, 70, 73, 75, 76, 78, 81, 82, 84, 88]

....[1, 10, 10.0, 10.00]
....[1, 10, 10.00, 10.0]
....[1, 10.0, 10, 10.00]
....[1, 10.0, 10.00, 10]
....[1, 10.00, 10, 10.0]
....[1, 10.00, 10.0, 10]</pre>

===Tail recursion version===
It is possible to write a version based on tail recursion, similar to that written in Haskell, OCaml or F#.
This version also takes into account stack overflow problems induced by recursion for large lists using closure trampolines:
<syntaxhighlight lang="groovy">split = { list ->
list.collate((list.size()+1)/2 as int)
}

merge = { left, right, headBuffer=[] ->
if(left.size() == 0) headBuffer+right
else if(right.size() == 0) headBuffer+left
else if(left.head() <= right.head()) merge.trampoline(left.tail(), right, headBuffer+left.head())
else merge.trampoline(right.tail(), left, headBuffer+right.head())
}.trampoline()

mergesort = { List list ->
if(list.size() < 2) list
else merge(split(list).collect {mergesort it})
}

assert mergesort((500..1)) == (1..500)
assert mergesort([5,4,6,3,1,2]) == [1,2,3,4,5,6]
assert mergesort([3,3,1,4,6,78,9,1,3,5]) == [1,1,3,3,3,4,5,6,9,78]
</syntaxhighlight>

which uses <code>List.collate()</code>, alternatively one could write a purely recursive <code>split()</code> closure as:
<syntaxhighlight lang="groovy">
split = { list, left=[], right=[] ->
if(list.size() <2) [list+left, right]
else split.trampoline(list.tail().tail(), [list.head()]+left,[list.tail().head()]+right)
}.trampoline()
</syntaxhighlight>


=={{header|Haskell}}==
=={{header|Haskell}}==
Splitting in half in the middle like the normal merge sort does would be inefficient on the singly-linked lists used in Haskell (since you would have to do one pass just to determine the length, and then another half-pass to do the splitting). Instead, the algorithm here splits the list in half in a different way -- by alternately assigning elements to one list and the other. That way we (lazily) construct both sublists in parallel as we traverse the original list. Unfortunately, under this way of splitting we cannot do a stable sort.
<syntaxhighlight lang="haskell">merge [] ys = ys
merge xs [] = xs
merge xs@(x:xt) ys@(y:yt) | x <= y = x : merge xt ys
| otherwise = y : merge xs yt


split (x:y:zs) = let (xs,ys) = split zs in (x:xs,y:ys)
merge [] ys = ys
merge xs [] = xs
split [x] = ([x],[])
split [] = ([],[])
merge xs@(x:xs') ys@(y:ys') | x < y = x : merge xs' ys
| otherwise = y : merge xs ys'


mergeSort [] = []
mergeSort [] = []
mergeSort [x] = [x]
mergeSort [x] = [x]
mergeSort xs = merge (mergeSort $ take n xs)
mergeSort xs = let (as,bs) = split xs
(mergeSort $ drop n xs)
in merge (mergeSort as) (mergeSort bs)</syntaxhighlight>
Alternatively, we can use bottom-up mergesort. This starts with lots of tiny sorted lists, and repeatedly merges pairs of them, building a larger and larger sorted list
where n = length xs `div` 2
<syntaxhighlight lang="haskell">mergePairs (sorted1 : sorted2 : sorteds) = merge sorted1 sorted2 : mergePairs sorteds
mergePairs sorteds = sorteds

mergeSortBottomUp list = mergeAll (map (\x -> [x]) list)

mergeAll [sorted] = sorted
mergeAll sorteds = mergeAll (mergePairs sorteds)</syntaxhighlight>
The standard library's sort function in GHC takes a similar approach to the bottom-up code, the differece being that, instead of starting with lists of size one, which are sorted by default, it detects runs in original list and uses those:
<syntaxhighlight lang="haskell">sort = sortBy compare
sortBy cmp = mergeAll . sequences
where
sequences (a:b:xs)
| a `cmp` b == GT = descending b [a] xs
| otherwise = ascending b (a:) xs
sequences xs = [xs]

descending a as (b:bs)
| a `cmp` b == GT = descending b (a:as) bs
descending a as bs = (a:as): sequences bs

ascending a as (b:bs)
| a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
ascending a as bs = as [a]: sequences bs</syntaxhighlight>
In this code, mergeAll, mergePairs, and merge are as above, except using the specialized cmp function in merge.

=={{header|Icon}} and {{header|Unicon}}==
<syntaxhighlight lang="icon">procedure main() #: demonstrate various ways to sort a list and string
demosort(mergesort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end

procedure mergesort(X,op,lower,upper) #: return sorted list ascending(or descending)
local middle

if /lower := 1 then { # top level call setup
upper := *X
op := sortop(op,X) # select how and what we sort
}
if upper ~= lower then { # sort all sections with 2 or more elements
X := mergesort(X,op,lower,middle := lower + (upper - lower) / 2)
X := mergesort(X,op,middle+1,upper)
if op(X[middle+1],X[middle]) then # @middle+1 < @middle merge if halves reversed
X := merge(X,op,lower,middle,upper)
}
return X
end

procedure merge(X,op,lower,middle,upper) # merge two list sections within a larger list
local p1,p2,add

p1 := lower
p2 := middle + 1
add := if type(X) ~== "string" then put else "||" # extend X, strings require X := add (until ||:= is invocable)
while p1 <= middle & p2 <= upper do
if op(X[p1],X[p2]) then { # @p1 < @p2
X := add(X,X[p1]) # extend X temporarily (rather than use a separate temporary list)
p1 +:= 1
}
else {
X := add(X,X[p2]) # extend X temporarily
p2 +:= 1
}
while X := add(X,X[middle >= p1]) do p1 +:= 1 # and rest of lower or ...
while X := add(X,X[upper >= p2]) do p2 +:= 1 # ... upper trailers if any
if type(X) ~== "string" then # pull section's sorted elements from extension
every X[upper to lower by -1] := pull(X)
else
(X[lower+:(upper-lower+1)] := X[0-:(upper-lower+1)])[0-:(upper-lower+1)] := ""
return X
end</syntaxhighlight>

Note: This example relies on [[Sorting_algorithms/Bubble_sort#Icon| the supporting procedures 'sortop', and 'demosort' in Bubble Sort]].
The full demosort exercises the named sort of a list with op = "numeric", "string", ">>" (lexically gt, descending),">" (numerically gt, descending), a custom comparator, and also a string.

{{out}} Abbreviated sample
<pre>Sorting Demo using procedure mergesort
on list : [ 3 14 1 5 9 2 6 3 ]
with op = &null: [ 1 2 3 3 5 6 9 14 ] (0 ms)
...
on string : "qwerty"
with op = &null: "eqrtwy" (0 ms)</pre>

=={{header|Io}}==
<syntaxhighlight lang="io">List do (
merge := method(lst1, lst2,
result := list()
while(lst1 isNotEmpty or lst2 isNotEmpty,
if(lst1 first <= lst2 first) then(
result append(lst1 removeFirst)
) else (
result append(lst2 removeFirst)
)
)
result)

mergeSort := method(
if (size > 1) then(
half_size := (size / 2) ceil
return merge(slice(0, half_size) mergeSort,
slice(half_size, size) mergeSort)
) else (return self)
)

mergeSortInPlace := method(
copy(mergeSort)
)
)

lst := list(9, 5, 3, -1, 15, -2)
lst mergeSort println # ==> list(-2, -1, 3, 5, 9, 15)
lst mergeSortInPlace println # ==> list(-2, -1, 3, 5, 9, 15)</syntaxhighlight>

=={{header|Isabelle}}==
<syntaxhighlight lang="isabelle">theory Mergesort
  imports Main
begin

fun merge :: "int list ⇒ int list ⇒ int list" where
  "merge [] ys = ys"
| "merge xs [] = xs"
| "merge (x#xs) (y#ys) = (if x ≤ y
                          then x # merge xs (y#ys)
                          else y # merge (x # xs) ys)"

text‹example:›
lemma "merge [1,3,6] [1,2,5,8] = [1,1,2,3,5,6,8]" by simp

lemma merge_set: "set (merge xs ys) = set xs ∪ set ys"
  by(induction xs ys rule: merge.induct) auto

lemma merge_sorted:
  "sorted xs ⟹ sorted ys ⟹ sorted (merge xs ys)"
proof(induction xs ys rule: merge.induct)
  case (1 ys)
  then show "sorted (merge [] ys)" by simp
next
  case (2 x xs)
  then show "sorted (merge (x # xs) [])" by simp
next
  case (3 x xs y ys)
  assume premx: "sorted (x # xs)"
     and premy: "sorted (y # ys)"
     and IHx: "x ≤ y ⟹ sorted xs ⟹ sorted (y # ys) ⟹
                 sorted (merge xs (y # ys))"
     and IHy: "¬ x ≤ y ⟹ sorted (x # xs) ⟹ sorted ys ⟹
                 sorted (merge (x # xs) ys)"
  then show "sorted (merge (x # xs) (y # ys))"
  proof(cases "x ≤ y")
    case True
    with premx IHx premy have IH: "sorted (merge xs (y # ys))" by simp
    from ‹x ≤ y› premx premy merge_set have
      "∀z ∈ set (merge xs (y # ys)). x ≤ z" by fastforce
    with ‹x ≤ y› IH show "sorted (merge (x # xs) (y # ys))" by(simp)
  next
    case False
    with premy IHy premx have IH: "sorted (merge (x # xs) ys)" by simp
    from ‹¬x ≤ y› premx premy merge_set have
      "∀z ∈ set (merge (x # xs) ys). y ≤ z" by fastforce
    with ‹¬x ≤ y› IH show "sorted (merge (x # xs) (y # ys))" by(simp)
  qed
qed

fun mergesort :: "int list ⇒ int list" where
  "mergesort [] = []"
| "mergesort [x] = [x]"
| "mergesort xs = merge (mergesort (take (length xs div 2) xs))
                        (mergesort (drop (length xs div 2) xs))"

theorem mergesort_set: "set xs = set (mergesort xs)"
proof(induction xs rule: mergesort.induct)
  case 1
  show "set [] = set (mergesort [])" by simp
next
  case (2 x)
  show "set [x] = set (mergesort [x])" by simp
next
  case (3 x1 x2 xs)
  from 3 have IH_simplified_take:
    "set (mergesort (x1 # take (length xs div 2) (x2 # xs))) =
     insert x1 (set (take (length xs div 2) (x2 # xs)))"
  and IH_simplified_drop:
    "set (mergesort (drop (length xs div 2) (x2 # xs))) =
     set (drop (length xs div 2) (x2 # xs))" by simp+

  have "(set (take n as) ∪ set (drop n as)) = set as"
    for n and as::"int list"
  proof -
    from set_append[of "take n as" "drop n as"] have
      "(set (take n as) ∪ set (drop n as)) =
       set (take n as @ drop n as)" by simp
    moreover have
      "set (take n as @ drop n as) =
       set as" using append_take_drop_id by simp
    ultimately show ?thesis by simp
  qed
  hence "(set (take (length xs div 2) (x2 # xs)) ∪
        set (drop (length xs div 2) (x2 # xs))) =
        set (x2 # xs)"by(simp)
  with IH_simplified_take IH_simplified_drop show
    "set (x1 # x2 # xs) = set (mergesort (x1 # x2 # xs))"
    by(simp add: merge_set)
qed

theorem mergesort_sorted: "sorted (mergesort xs)"
  by(induction xs rule: mergesort.induct) (simp add: merge_sorted)+

text‹example:›
lemma "mergesort [42, 5, 1, 3, 67, 3, 9, 0, 33, 32] =
                 [0, 1, 3, 3, 5, 9, 32, 33, 42, 67]" by simp
end
</syntaxhighlight>

=={{header|J}}==
{{eff note|J|/:~}}
'''Recursive Solution'''
<syntaxhighlight lang="j">mergesort=: {{
if. 2>#y do. y return.end.
middle=. <.-:#y
X=. mergesort middle{.y
Y=. mergesort middle}.y
X merge Y
}}

merge=: {{ r=. y#~ i=. j=. 0
while. (i<#x)*(j<#y) do. a=. i{x [b=. j{y
if. a<b do. r=. r,a [i=. i+1
else. r=. r,b [j=. j+1 end.
end.
if. i<#x do. r=. r, i}.x end.
if. j<#y do. r=. r, j}.y end.
}}</syntaxhighlight>

'''Non-Recursive Solution'''

(This uses the same merge):

<syntaxhighlight lang="j">mergesort=: {{ r=. y [ stride=. 1
while. stride < #r do. stride=. 2*mid=. stride
r=. ;(-stride) (mid&}. <@merge (mid<.#) {.])\ r
end.
}}</syntaxhighlight>

Example use:
<syntaxhighlight lang="j"> mergesort 18 2 8 1 5 14 9 19 11 13 16 0 3 10 17 15 12 4 7 6
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19</syntaxhighlight>

But use J's /:~ if you really need this function.

<syntaxhighlight lang="j"> (/:~ -: mergesort) ?~?10000
1</syntaxhighlight>

'''Tacit Recursive Solution'''
<syntaxhighlight lang="j">case=. (0 = # x=. @:[) + 2 * (0 = # y=. @:])
merge=. ({.x , }.x $: ])`(({.y , }.y $: [))@.({.x > {.y)`]`[@.case
mergesort=. (<. o -: o # ($: o {. merge $: (o=. @:) }.) ]) ^:(1 < #)</syntaxhighlight>

Example use:
<syntaxhighlight lang="j"> mergesort 18 2 8 1 5 14 9 19 11 13 16 0 3 10 17 15 12 4 7 6
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19</syntaxhighlight>


=={{header|Java}}==
=={{header|Java}}==
{{works with|Java|1.5+}}
{{works with|Java|1.5+}}
<java>import java.util.LinkedList;
<syntaxhighlight lang="java5">import java.util.List;
import java.util.ArrayList;
public class Merge<E extends Comparable<E>> {
import java.util.Iterator;
public LinkedList<E> mergeSort(LinkedList<E> m){
if(m.size() <= 1) return m;


public class Merge{
int middle= m.size() / 2;
public static <E extends Comparable<? super E>> List<E> mergeSort(List<E> m){
LinkedList<E> left= new LinkedList<E>();
if(m.size() <= 1) return m;
for(int i= 0;i < middle;i++) left.add(m.get(i));
LinkedList<E> right= new LinkedList<E>();
for(int i= middle;i < m.size();i++) right.add(m.get(i));


int middle = m.size() / 2;
right= mergeSort(right);
left= mergeSort(left);
List<E> left = m.subList(0, middle);
LinkedList<E> result= merge(left, right);
List<E> right = m.subList(middle, m.size());


right = mergeSort(right);
return result;
left = mergeSort(left);
}
List<E> result = merge(left, right);


return result;
public LinkedList<E> merge(LinkedList<E> left, LinkedList<E> right){
}
LinkedList<E> result= new LinkedList<E>();


public static <E extends Comparable<? super E>> List<E> merge(List<E> left, List<E> right){
while(left.size() > 0 && right.size() > 0){
List<E> result = new ArrayList<E>();
//change the direction of this comparison to change the direction of the sort
Iterator<E> it1 = left.iterator();
if(left.peek().compareTo(right.peek()) <= 0) result.add(left.remove());
Iterator<E> it2 = right.iterator();
else result.add(right.remove());

E x = it1.next();
E y = it2.next();
while (true){
//change the direction of this comparison to change the direction of the sort
if(x.compareTo(y) <= 0){
result.add(x);
if(it1.hasNext()){
x = it1.next();
}else{
result.add(y);
while(it2.hasNext()){
result.add(it2.next());
}
break;
}
}
}else{

if(left.size() > 0) result.addAll(left);
result.add(y);
if(it2.hasNext()){
if(right.size() > 0) result.addAll(right);
y = it2.next();
return result;
}else{
}
result.add(x);
}</java>
while (it1.hasNext()){
result.add(it1.next());
}
break;
}
}
}
return result;
}
}</syntaxhighlight>


=={{header|JavaScript}}==
=={{header|JavaScript}}==
<javascript>
<syntaxhighlight lang="javascript">
function sort(a) {
function mergeSort(v) {
var mid = a.length>>1;
if (v.length <= 1) {
if (mid==0) return a;
return v;
}
var less = sort(a.slice(0,mid));

var more = sort(a.slice(mid));
let m = Math.floor(v.length / 2);
var merged = [];
let l = mergeSort(v.slice(0, m));
do {
let r = mergeSort(v.slice(m));
if (more[0] < less[0]) { var t=less; less=more; more=t; }
merged.push(less.shift());
return merge(l, r);

} while (less.length > 0);
function merge(a, b) {
return merged.concat(more);
let i = 0, j = 0;
}</javascript>
let n = a.length + b.length;
let c = [];
while (c.length < n) {
if (i < a.length && (j >= b.length || a[i] < b[j])) {
c.push(a[i++]);
} else {
c.push(b[j++]);
}
}
return c;
}
}

function mergeSortInPlace(v) {
if (v.length <= 1) {
return;
}

let m = Math.floor(v.length / 2);
let l = v.slice(0, m);
let r = v.slice(m);
mergeSortInPlace(l);
mergeSortInPlace(r);
merge(l, r, v);

// merge a + b -> c
function merge(a, b, c) {
let i = 0, j = 0;
for (let k = 0; k < c.length; k++) {
if (i < a.length && (j >= b.length || a[i] < b[j])) {
c[k] = a[i++];
} else {
c[k] = b[j++];
}
}
}
}

// even faster
function mergeSortInPlaceFast(v) {
sort(v, 0, v.length, v.slice());

function sort(v, lo, hi, t) {
let n = hi - lo;
if (n <= 1) {
return;
}
let mid = lo + Math.floor(n / 2);
sort(v, lo, mid, t);
sort(v, mid, hi, t);
for (let i = lo; i < hi; i++) {
t[i] = v[i];
}
let i = lo, j = mid;
for (let k = lo; k < hi; k++) {
if (i < mid && (j >= hi || t[i] < t[j])) {
v[k] = t[i++];
} else {
v[k] = t[j++];
}
}
}
}
</syntaxhighlight>

<syntaxhighlight lang="javascript">function merge(left, right, arr) {
var a = 0;

while (left.length && right.length) {
arr[a++] = (right[0] < left[0]) ? right.shift() : left.shift();
}
while (left.length) {
arr[a++] = left.shift();
}
while (right.length) {
arr[a++] = right.shift();
}
}

function mergeSort(arr) {
var len = arr.length;

if (len === 1) { return; }

var mid = Math.floor(len / 2),
left = arr.slice(0, mid),
right = arr.slice(mid);

mergeSort(left);
mergeSort(right);
merge(left, right, arr);
}

var arr = [1, 5, 2, 7, 3, 9, 4, 6, 8];
mergeSort(arr); // arr will now: 1, 2, 3, 4, 5, 6, 7, 8, 9

// here is improved faster version, also often faster than QuickSort!

function mergeSort2(a) {
if (a.length <= 1) return
const mid = Math.floor(a.length / 2), left = a.slice(0, mid), right = a.slice(mid)
mergeSort2(left)
mergeSort2(right)
let ia = 0, il = 0, ir = 0
while (il < left.length && ir < right.length)
a[ia++] = left[il] < right[ir] ? left[il++] : right[ir++]
while (il < left.length)
a[ia++] = left[il++]
while (ir < right.length)
a[ia++] = right[ir++]
}
</syntaxhighlight>

=={{header|jq}}==
The sort function defined here will sort any JSON array.
<syntaxhighlight lang="jq"># Input: [x,y] -- the two arrays to be merged
# If x and y are sorted as by "sort", then the result will also be sorted:
def merge:
def m: # state: [x, y, array] (array being the answer)
.[0] as $x
| .[1] as $y
| if 0 == ($x|length) then .[2] + $y
elif 0 == ($y|length) then .[2] + $x
else
(if $x[0] <= $y[0] then [$x[1:], $y, .[2] + [$x[0] ]]
else [$x, $y[1:], .[2] + [$y[0] ]]
end) | m
end;
[.[0], .[1], []] | m;

def merge_sort:
if length <= 1 then .
else
(length/2 |floor) as $len
| . as $in
| [ ($in[0:$len] | merge_sort), ($in[$len:] | merge_sort) ] | merge
end;</syntaxhighlight>
'''Example''':
<syntaxhighlight lang="jq">
( [1, 3, 8, 9, 0, 0, 8, 7, 1, 6],
[170, 45, 75, 90, 2, 24, 802, 66],
[170, 45, 75, 90, 2, 24, -802, -66] )
| (merge_sort == sort)</syntaxhighlight>
{{Out}}
true
true
true

=={{header|Julia}}==
<syntaxhighlight lang="julia">function mergesort(arr::Vector)
if length(arr) ≤ 1 return arr end
mid = length(arr) ÷ 2
lpart = mergesort(arr[1:mid])
rpart = mergesort(arr[mid+1:end])
rst = similar(arr)
i = ri = li = 1
@inbounds while li ≤ length(lpart) && ri ≤ length(rpart)
if lpart[li] ≤ rpart[ri]
rst[i] = lpart[li]
li += 1
else
rst[i] = rpart[ri]
ri += 1
end
i += 1
end
if li ≤ length(lpart)
copyto!(rst, i, lpart, li)
else
copyto!(rst, i, rpart, ri)
end
return rst
end

v = rand(-10:10, 10)
println("# unordered: $v\n -> ordered: ", mergesort(v))</syntaxhighlight>

{{out}}
<pre># unordered: [8, 6, 7, 1, -1, 0, -4, 7, -7, 0]
-> ordered: [-7, -4, -1, 0, 0, 1, 6, 7, 7, 8]</pre>

=={{header|Kotlin}}==
<syntaxhighlight lang="kotlin">fun mergeSort(list: List<Int>): List<Int> {
if (list.size <= 1) {
return list
}

val left = mutableListOf<Int>()
val right = mutableListOf<Int>()

val middle = list.size / 2
list.forEachIndexed { index, number ->
if (index < middle) {
left.add(number)
} else {
right.add(number)
}
}

fun merge(left: List<Int>, right: List<Int>): List<Int> = mutableListOf<Int>().apply {
var indexLeft = 0
var indexRight = 0

while (indexLeft < left.size && indexRight < right.size) {
if (left[indexLeft] <= right[indexRight]) {
add(left[indexLeft])
indexLeft++
} else {
add(right[indexRight])
indexRight++
}
}

while (indexLeft < left.size) {
add(left[indexLeft])
indexLeft++
}

while (indexRight < right.size) {
add(right[indexRight])
indexRight++
}
}

return merge(mergeSort(left), mergeSort(right))
}

fun main(args: Array<String>) {
val numbers = listOf(5, 2, 3, 17, 12, 1, 8, 3, 4, 9, 7)
println("Unsorted: $numbers")
println("Sorted: ${mergeSort(numbers)}")
}</syntaxhighlight>

{{out}}
<pre>Unsorted: [5, 2, 3, 17, 12, 1, 8, 3, 4, 9, 7]
Sorted: [1, 2, 3, 3, 4, 5, 7, 8, 9, 12, 17]</pre>

=={{header|Lambdatalk}}==
A close translation from Picolisp. In lambdatalk lists are implemented as dynamical arrays with list-like functions, cons is A.addfirst!, car is A.first, cdr is A.rest, nil is A.new and so on.

<syntaxhighlight lang="scheme">
{def alt
{lambda {:list}
{if {A.empty? :list}
then {A.new}
else {A.addfirst! {A.first :list}
{alt {A.rest {A.rest :list}}}} }}}
-> alt

{def merge
{lambda {:l1 :l2}
{if {A.empty? :l2}
then :l1
else {if {< {A.first :l1} {A.first :l2}}
then {A.addfirst! {A.first :l1} {merge :l2 {A.rest :l1}}}
else {A.addfirst! {A.first :l2} {merge :l1 {A.rest :l2}}} }}}}
-> merge

{def mergesort
{lambda {:list}
{if {A.empty? {A.rest :list}}
then :list
else {merge {mergesort {alt :list}}
{mergesort {alt {A.rest :list}}}} }}}
-> mergesort

{mergesort {A.new 8 1 5 3 9 0 2 7 6 4}}
-> [0,1,2,3,4,5,6,7,8,9]
</syntaxhighlight>

=={{header|Liberty BASIC}}==
<syntaxhighlight lang="lb"> itemCount = 20
dim A(itemCount)
dim tmp(itemCount) 'merge sort needs additionally same amount of storage

for i = 1 to itemCount
A(i) = int(rnd(1) * 100)
next i

print "Before Sort"
call printArray itemCount

call mergeSort 1,itemCount

print "After Sort"
call printArray itemCount
end

'------------------------------------------
sub mergeSort start, theEnd
if theEnd-start < 1 then exit sub
if theEnd-start = 1 then
if A(start)>A(theEnd) then
tmp=A(start)
A(start)=A(theEnd)
A(theEnd)=tmp
end if
exit sub
end if
middle = int((start+theEnd)/2)
call mergeSort start, middle
call mergeSort middle+1, theEnd
call merge start, middle, theEnd
end sub

sub merge start, middle, theEnd
i = start: j = middle+1: k = start
while i<=middle OR j<=theEnd
select case
case i<=middle AND j<=theEnd
if A(i)<=A(j) then
tmp(k)=A(i)
i=i+1
else
tmp(k)=A(j)
j=j+1
end if
k=k+1
case i<=middle
tmp(k)=A(i)
i=i+1
k=k+1
case else 'j<=theEnd
tmp(k)=A(j)
j=j+1
k=k+1
end select
wend

for i = start to theEnd
A(i)=tmp(i)
next
end sub

'===========================================
sub printArray itemCount
for i = 1 to itemCount
print using("###", A(i));
next i
print
end sub</syntaxhighlight>


=={{header|Logo}}==
=={{header|Logo}}==
{{works with|UCB Logo}}
{{works with|UCB Logo}}
to split :size :front :list
<syntaxhighlight lang="logo">to split :size :front :list
if :size < 1 [output list :front :list]
if :size < 1 [output list :front :list]
output split :size-1 (lput first :list :front) (butfirst :list)
output split :size-1 (lput first :list :front) (butfirst :list)
end
end

to merge :small :large
to merge :small :large
if empty? :small [output :large]
if empty? :small [output :large]
ifelse less? first :small first :large ~
ifelse lessequal? first :small first :large ~
[output fput first :small merge butfirst :small :large] ~
[output fput first :small merge butfirst :small :large] ~
[output fput first :large merge butfirst :large :small]
[output fput first :large merge butfirst :large :small]
end
end

to mergesort :list
to mergesort :list
localmake "half split (count :list) / 2 [] :list
localmake "half split (count :list) / 2 [] :list
if empty? first :half [output :list]
if empty? first :half [output :list]
output merge mergesort first :half mergesort last :half
output merge mergesort first :half mergesort last :half
end</syntaxhighlight>
end

=={{header|Logtalk}}==
<syntaxhighlight lang="logtalk">msort([], []) :- !.
msort([X], [X]) :- !.
msort([X, Y| Xs], Ys) :-
split([X, Y| Xs], X1s, X2s),
msort(X1s, Y1s),
msort(X2s, Y2s),
merge(Y1s, Y2s, Ys).

split([], [], []).
split([X| Xs], [X| Ys], Zs) :-
split(Xs, Zs, Ys).

merge([X| Xs], [Y| Ys], [X| Zs]) :-
X @=< Y, !,
merge(Xs, [Y| Ys], Zs).
merge([X| Xs], [Y| Ys], [Y| Zs]) :-
X @> Y, !,
merge([X | Xs], Ys, Zs).
merge([], Xs, Xs) :- !.
merge(Xs, [], Xs).</syntaxhighlight>

=={{header|Lua}}==
<syntaxhighlight lang="lua">local function merge(left_container, left_container_begin, left_container_end, right_container, right_container_begin, right_container_end, result_container, result_container_begin, comparator)
while left_container_begin <= left_container_end do
if right_container_begin > right_container_end then
for i = left_container_begin, left_container_end do
result_container[result_container_begin] = left_container[i]
result_container_begin = result_container_begin + 1
end

return
end

if comparator(right_container[right_container_begin], left_container[left_container_begin]) then
result_container[result_container_begin] = right_container[right_container_begin]
right_container_begin = right_container_begin + 1
else
result_container[result_container_begin] = left_container[left_container_begin]
left_container_begin = left_container_begin + 1
end

result_container_begin = result_container_begin + 1
end

for i = right_container_begin, right_container_end do
result_container[result_container_begin] = right_container[i]
result_container_begin = result_container_begin + 1
end
end

local function mergesort_impl(container, container_begin, container_end, comparator)
local range_length = (container_end - container_begin) + 1
if range_length < 2 then return end
local copy = {}
local copy_len = 0

for it = container_begin, container_end do
copy_len = copy_len + 1
copy[copy_len] = container[it]
end

local middle = bit.rshift(range_length, 1) -- or math.floor(range_length / 2)
mergesort_impl(copy, 1, middle, comparator)
mergesort_impl(copy, middle + 1, copy_len, comparator)
merge(copy, 1, middle, copy, middle + 1, copy_len, container, container_begin, comparator)
end

local function mergesort_default_comparator(a, b)
return a < b
end

function table.mergesort(container, comparator)
if not comparator then
comparator = mergesort_default_comparator
end

mergesort_impl(container, 1, #container, comparator)
end</syntaxhighlight>

<syntaxhighlight lang="lua">function getLower(a,b)
local i,j=1,1
return function()
if not b[j] or a[i] and a[i]<b[j] then
i=i+1; return a[i-1]
else
j=j+1; return b[j-1]
end
end
end

function merge(a,b)
local res={}
for v in getLower(a,b) do res[#res+1]=v end
return res
end

function mergesort(list)
if #list<=1 then return list end
local s=math.floor(#list/2)
return merge(mergesort{unpack(list,1,s)}, mergesort{unpack(list,s+1)})
end</syntaxhighlight>


=={{header|Lucid}}==
=={{header|Lucid}}==
[http://i.csc.uvic.ca/home/hei/lup/06.html]
[http://i.csc.uvic.ca/home/hei/lup/06.html]
msort(a) = if iseod(first next a) then a else merge(msort(b0),msort(b1)) fi
<syntaxhighlight lang="lucid">msort(a) = if iseod(first next a) then a else merge(msort(b0),msort(b1)) fi
where
where
p = false fby not p;
p = false fby not p;
b0 = a whenever p;
b0 = a whenever p;
b1 = a whenever not p;
b1 = a whenever not p;
just(a) = ja
just(a) = ja
where
ja = a fby if iseod ja then eod else next a fi;
end;
merge(x,y) = if takexx then xx else yy fi
where
where
xx = (x) upon takexx;
ja = a fby if iseod ja then eod else next a fi;
yy = (y) upon not takexx;
takexx = if iseod(yy) then true elseif
iseod(xx) then false else xx < yy fi;
end;
end;
merge(x,y) = if takexx then xx else yy fi
end;
where
xx = (x) upon takexx;
yy = (y) upon not takexx;
takexx = if iseod(yy) then true elseif
iseod(xx) then false else xx <= yy fi;
end;
end;</syntaxhighlight>


=={{header|OCaml}}==
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
module checkit {
\\ merge sort
group merge {
function sort(right as stack) {
if len(right)<=1 then =right : exit
left=.sort(stack up right, len(right) div 2 )
right=.sort(right)
\\ stackitem(right) is same as stackitem(right,1)
if stackitem(left, len(left))<=stackitem(right) then
\\ !left take items from left for merging
\\ so after this left and right became empty stacks
=stack:=!left, !right
exit
end if
=.merge(left, right)
}
function sortdown(right as stack) {
if len(right)<=1 then =right : exit
left=.sortdown(stack up right, len(right) div 2 )
right=.sortdown(right)
if stackitem(left, len(left))>stackitem(right) then
=stack:=!left, !right : exit
end if
=.mergedown(left, right)
}
\\ left and right are pointers to stack objects
\\ here we pass by value the pointer not the data
function merge(left as stack, right as stack) {
result=stack
while len(left) > 0 and len(right) > 0
if stackitem(left,1) <= stackitem(right) then
result=stack:=!result, !(stack up left, 1)
else
result=stack:=!result, !(stack up right, 1)
end if
end while
if len(right) > 0 then result=stack:= !result,!right
if len(left) > 0 then result=stack:= !result,!left
=result
}
function mergedown(left as stack, right as stack) {
result=stack
while len(left) > 0 and len(right) > 0
if stackitem(left,1) > stackitem(right) then
result=stack:=!result, !(stack up left, 1)
else
result=stack:=!result, !(stack up right, 1)
end if
end while
if len(right) > 0 then result=stack:= !result,!right
if len(left) > 0 then result=stack:= !result,!left
=result
}
}
k=stack:=7, 5, 2, 6, 1, 4, 2, 6, 3
print merge.sort(k)
print len(k)=0 ' we have to use merge.sort(stack(k)) to pass a copy of k
\\ input array (arr is a pointer to array)
arr=(10,8,9,7,5,6,2,3,0,1)
\\ stack(array pointer) return a stack with a copy of array items
\\ array(stack pointer) return an array, empty the stack
arr2=array(merge.sort(stack(arr)))
Print type$(arr2)
Dim a()
\\ a() is an array as a value, so we just copy arr2 to a()
a()=arr2
\\ to prove we add 1 to each element of arr2
arr2++
Print a() ' 0,1,2,3,4,5,6,7,8,9
Print arr2 ' 1,2,3,4,5,6,7,8,9,11
p=a() ' we get a pointer
\\ a() has a double pointer inside
\\ so a() get just the inner pointer
a()=array(merge.sortdown(stack(p)))
\\ so now p (which use the outer pointer)
\\ still points to a()
print p ' p point to a()
}
checkit
</syntaxhighlight>


=={{header|Maple}}==
<ocaml>let rec split_at n xs =
<syntaxhighlight lang="text">merge := proc(arr, left, mid, right)
local i, j, k, n1, n2, L, R;
n1 := mid-left+1:
n2 := right-mid:
L := Array(1..n1):
R := Array(1..n2):
for i from 0 to n1-1 do
L(i+1) :=arr(left+i):
end do:
for j from 0 to n2-1 do
R(j+1) := arr(mid+j+1):
end do:
i := 1:
j := 1:
k := left:
while(i <= n1 and j <= n2) do
if (L[i] <= R[j]) then
arr[k] := L[i]:
i++:
else
arr[k] := R[j]:
j++:
end if:
k++:
end do:
while(i <= n1) do
arr[k] := L[i]:
i++:
k++:
end do:
while(j <= n2) do
arr[k] := R[j]:
j++:
k++:
end do:
end proc:
arr := Array([17,3,72,0,36,2,3,8,40,0]);
mergeSort(arr,1,numelems(arr)):
arr;</syntaxhighlight>
{{Out|Output}}
<pre>[0,0,2,3,3,8,17,36,40,72]</pre>

=={{header|Mathematica}} / {{header|Wolfram Language}}==
{{works with|Mathematica|7.0}}
<syntaxhighlight lang="mathematica">MergeSort[m_List] := Module[{middle},
If[Length[m] >= 2,
middle = Ceiling[Length[m]/2];
Apply[Merge,
Map[MergeSort, Partition[m, middle, middle, {1, 1}, {}]]],
m
]
]
Merge[left_List, right_List] := Module[
{leftIndex = 1, rightIndex = 1},
Table[
Which[
leftIndex > Length[left], right[[rightIndex++]],
rightIndex > Length[right], left[[leftIndex++]],
left[[leftIndex]] <= right[[rightIndex]], left[[leftIndex++]],
True, right[[rightIndex++]]],
{Length[left] + Length[right]}]
]</syntaxhighlight>

=={{header|MATLAB}}==
<syntaxhighlight lang="matlab">function list = mergeSort(list)

if numel(list) <= 1
return
else
middle = ceil(numel(list) / 2);
left = list(1:middle);
right = list(middle+1:end);
left = mergeSort(left);
right = mergeSort(right);
if left(end) <= right(1)
list = [left right];
return
end
%merge(left,right)
counter = 1;
while (numel(left) > 0) && (numel(right) > 0)
if(left(1) <= right(1))
list(counter) = left(1);
left(1) = [];
else
list(counter) = right(1);
right(1) = [];
end
counter = counter + 1;
end

if numel(left) > 0
list(counter:end) = left;
elseif numel(right) > 0
list(counter:end) = right;
end
%end merge
end %if
end %mergeSort</syntaxhighlight>
Sample Usage:
<syntaxhighlight lang="matlab">>> mergeSort([4 3 1 5 6 2])

ans =

1 2 3 4 5 6</syntaxhighlight>

=={{header|Maxima}}==
<syntaxhighlight lang="maxima">merge(a, b) := block(
[c: [ ], i: 1, j: 1, p: length(a), q: length(b)],
while i <= p and j <= q do (
if a[i] < b[j] then (
c: endcons(a[i], c),
i: i + 1
) else (
c: endcons(b[j], c),
j: j + 1
)
),
if i > p then append(c, rest(b, j - 1)) else append(c, rest(a, i - 1))
)$

mergesort(u) := block(
[n: length(u), k, a, b],
if n <= 1 then u else (
a: rest(u, k: quotient(n, 2)),
b: rest(u, k - n),
merge(mergesort(a), mergesort(b))
)
)$</syntaxhighlight>

=={{header|MAXScript}}==
<syntaxhighlight lang="maxscript">fn mergesort arr =
(
local left = #()
local right = #()
local result = #()
if arr.count < 2 then return arr
else
(
local mid = arr.count/2
for i = 1 to mid do
(
append left arr[i]
)
for i = (mid+1) to arr.count do
(
append right arr[i]
)
left = mergesort left
right = mergesort right
if left[left.count] <= right[1] do
(
join left right
return left
)
result = _merge left right
return result
)
)

fn _merge a b =
(
local result = #()
while a.count > 0 and b.count > 0 do
(
if a[1] <= b[1] then
(
append result a[1]
a = for i in 2 to a.count collect a[i]
)
else
(
append result b[1]
b = for i in 2 to b.count collect b[i]
)
)
if a.count > 0 do
(
join result a
)
if b.count > 0 do
(
join result b
)
return result
)</syntaxhighlight>
Output:
<syntaxhighlight lang="maxscript">
a = for i in 1 to 15 collect random -5 20
#(-3, 13, 2, -2, 13, 9, 17, 7, 16, 19, 0, 0, 20, 18, 1)
mergeSort a
#(-3, -2, 0, 0, 1, 2, 7, 9, 13, 13, 16, 17, 18, 19, 20)
</syntaxhighlight>

=={{header|Mercury}}==
This version of a sort will sort a list of any type for which there is an ordering predicate defined. Both a function form and a predicate form are defined here with the function implemented in terms of the predicate. Some of the ceremony has been elided.
<syntaxhighlight lang="mercury">
:- module merge_sort.

:- interface.

:- import_module list.

:- type split_error ---> split_error.

:- func merge_sort(list(T)) = list(T).
:- pred merge_sort(list(T)::in, list(T)::out) is det.

:- implementation.

:- import_module int, exception.

merge_sort(U) = S :- merge_sort(U, S).
merge_sort(U, S) :- merge_sort(list.length(U), U, S).
:- pred merge_sort(int::in, list(T)::in, list(T)::out) is det.
merge_sort(L, U, S) :-
( L > 1 ->
H = L // 2,
( split(H, U, F, B) ->
merge_sort(H, F, SF),
merge_sort(L - H, B, SB),
merge_sort.merge(SF, SB, S)
; throw(split_error) )
; S = U ).
:- pred split(int::in, list(T)::in, list(T)::out, list(T)::out) is semidet.
split(N, L, S, E) :-
( N = 0 -> S = [], E = L
; N > 0, L = [H | L1], S = [H | S1],
split(N - 1, L1, S1, E) ).
:- pred merge(list(T)::in, list(T)::in, list(T)::out) is det.
merge([], [], []).
merge([X|Xs], [], [X|Xs]).
merge([], [Y|Ys], [Y|Ys]).
merge([X|Xs], [Y|Ys], M) :-
( compare(>, X, Y) ->
merge_sort.merge([X|Xs], Ys, M0),
M = [Y|M0]
; merge_sort.merge(Xs, [Y|Ys], M0),
M = [X|M0] ).
</syntaxhighlight>

=={{header|Miranda}}==
<syntaxhighlight lang="miranda">main :: [sys_message]
main = [Stdout ("Before: " ++ show testlist ++ "\n"),
Stdout ("After: " ++ show (mergesort testlist) ++ "\n")]
where testlist = [4,65,2,-31,0,99,2,83,782,1]

mergesort :: [*]->[*]
mergesort [] = []
mergesort [x] = [x]
mergesort xs = merge (mergesort l) (mergesort r)
where (l, r) = split [] [] xs
split l r [] = (l,r)
split l r [x] = (x:l,r)
split l r (x:y:xs) = split (x:l) (y:r) xs
merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys) = x:y:merge xs ys, if x<y
= y:x:merge xs ys, if x>=y</syntaxhighlight>
{{out}}
<pre>Before: [4,65,2,-31,0,99,2,83,782,1]
After: [-31,0,1,2,2,83,4,99,65,782]</pre>

=={{header|Modula-2}}==
===Iterative===
{{works with|TopSpeed (JPI) Modula-2 under DOSBox-X}}
Divides the input into blocks of 2 entries, and sorts each block by swapping if necessary. Then merges blocks of 2 into blocks of 4, blocks of 4 into blocks of 8, and so on.
<syntaxhighlight lang="modula2">
DEFINITION MODULE MSIterat;

PROCEDURE IterativeMergeSort( VAR a : ARRAY OF INTEGER);

END MSIterat.
</syntaxhighlight>
<syntaxhighlight lang="modula2">
IMPLEMENTATION MODULE MSIterat;

IMPORT Storage;

PROCEDURE IterativeMergeSort( VAR a : ARRAY OF INTEGER);
VAR
n, bufLen, len, endBuf : CARDINAL;
k, nL, nR, b, h, i, j, startR, endR: CARDINAL;
temp : INTEGER; (* array element *)
pbuf : POINTER TO ARRAY CARDINAL OF INTEGER;
BEGIN
n := HIGH(a) + 1; (* length of array *)
IF (n < 2) THEN RETURN; END;
(* Sort blocks of length 2 by swapping elements if necessary.
Start at high end of array; ignore a[0] if n is odd.*)
k := n;
REPEAT
DEC(k, 2);
IF (a[k] > a[k + 1]) THEN
temp := a[k]; a[k] := a[k + 1]; a[k + 1] := temp;
END;
UNTIL (k < 2);
IF (n = 2) THEN RETURN; END;

(* Set up a buffer for temporary storage when merging. *)
(* TopSpeed Modula-2 doesn't seem to have dynamic arrays,
so we use a workaround *)
bufLen := n DIV 2;
Storage.ALLOCATE( pbuf, bufLen*SIZE(INTEGER));

nR := 2; (* length of right-hand block when merging *)
REPEAT
len := 2*nR; (* maximum length of a merged block in this iteration *)
k := n; (* start at the high end of the array *)
WHILE (k > nR) DO
IF (k >= len) THEN
nL := nR; DEC(k, len);
ELSE
nL := k - nR; k := 0; END;

(* Merging 2 adjacent blocks, already sorted.
k = start index of left block;
nL, nR = lengths of left and right blocks *)
startR := k + nL; endR := startR + nR;

(* Skip elements in left block that are already in correct place *)
temp := a[startR]; (* first (smallest) element in right block *)
j := k;
WHILE (j < startR) AND (a[j] <= temp) DO INC(j); END;

endBuf := startR - j; (* length of buffer actually used *)
IF (endBuf > 0) THEN (* if endBuf = 0 then already sorted *)
(* Copy from left block to buffer, omitting elements
that are already in correct place *)
h := j;
FOR b := 0 TO endBuf - 1 DO
pbuf^[b] := a[h]; INC(h);
END;
(* Fill in values from right block or buffer *)
b := 0;
i := startR;
(* j = startR - endBuf from above *)
WHILE (b < endBuf) AND (i < endR) DO
IF (pbuf^[b] <= a[i]) THEN
a[j] := pbuf^[b]; INC(b)
ELSE
a[j] := a[i]; INC(i); END;
INC(j);
END;
(* If now b = endBuf then the merge is complete.
Else just copy the remaining elements in the buffer. *)
WHILE (b < endBuf) DO
a[j] := pbuf^[b]; INC(j); INC(b);
END;
END;
END;
nR := len;
UNTIL (nR >= n);
Storage.DEALLOCATE( pbuf, bufLen*SIZE(INTEGER));
END IterativeMergeSort;

END MSIterat.
</syntaxhighlight>
<syntaxhighlight lang="modula2">
MODULE MSItDemo;
(* Demo of iterative merge sort *)

IMPORT IO, Lib;
FROM MSIterat IMPORT IterativeMergeSort;

(* Procedure to display the values in the demo array *)
PROCEDURE Display( VAR a : ARRAY OF INTEGER);
VAR
j, nrInLine : CARDINAL;
BEGIN
nrInLine := 0;
FOR j := 0 TO HIGH(a) DO
IO.WrCard( a[j], 5); INC( nrInLine);
IF (nrInLine = 10) THEN IO.WrLn; nrInLine := 0; END;
END;
IF (nrInLine > 0) THEN IO.WrLn; END;
END Display;

(* Main routine *)
CONST
ArrayLength = 50;
VAR
arr : ARRAY [0..ArrayLength - 1] OF INTEGER;
m : CARDINAL;
BEGIN
Lib.RANDOMIZE;
FOR m := 0 TO ArrayLength - 1 DO arr[m] := Lib.RANDOM( 1000); END;
IO.WrStr( 'Before:'); IO.WrLn; Display( arr);
IterativeMergeSort( arr);
IO.WrStr( 'After:'); IO.WrLn; Display( arr);
END MSItDemo.
</syntaxhighlight>
{{out}}
<pre>
Before:
236 542 526 549 869 632 446 518 909 270
826 562 469 258 681 604 921 772 548 328
147 679 71 239 772 106 477 556 451 64
941 207 87 486 280 206 380 689 964 376
298 635 552 887 387 70 287 77 610 605
After:
64 70 71 77 87 106 147 206 207 236
239 258 270 280 287 298 328 376 380 387
446 451 469 477 486 518 526 542 548 549
552 556 562 604 605 610 632 635 679 681
689 772 772 826 869 887 909 921 941 964
</pre>

===Recursive on linked list===
{{works with|TopSpeed (JPI) Modula-2 under DOSBox-X}}
According to Wikipedia, "merge sort is often the best choice for sorting a linked list". The code below shows a general procedure for merge-sorting a linked list. As in the improved Delphi version, only the pointers are moved. To carry out the Rosetta Code task, the demo program sorts an array of records on an integer-valued field.

The method for splitting a linked list is taken from "Merge sort algorithm for a singly linked list" on Techie Delight. Two pointers step through the list, one at twice the speed of the other. When the fast pointer reaches the end, the slow pointer marks the halfway point.
<syntaxhighlight lang="modula2">
DEFINITION MODULE MergSort;

TYPE MSCompare = PROCEDURE( ADDRESS, ADDRESS) : INTEGER;
TYPE MSGetNext = PROCEDURE( ADDRESS) : ADDRESS;
TYPE MSSetNext = PROCEDURE( ADDRESS, ADDRESS);

PROCEDURE DoMergeSort( VAR start : ADDRESS;
Compare : MSCompare;
GetNext : MSGetNext;
SetNext : MSSetNext);
(*
Procedures to be supplied by the caller:
Compare(a1, a2) returns -1 if a1^ is to be placed before a2^;
+1 if after; 0 if no priority.
GetNext(a) returns address of next item after a^.
SetNext(a, n) sets address of next item after a^ to n.
If a^ is last item, then address of next item is NIL.
It can be assumed that a, a1, a2 are not NIL.
*)
END MergSort.
</syntaxhighlight>
<syntaxhighlight lang="modula2">
IMPLEMENTATION MODULE MergSort;

PROCEDURE DoMergeSort( VAR start : ADDRESS;
Compare : MSCompare;
GetNext : MSGetNext;
SetNext : MSSetNext);
VAR
p1, p2, q : ADDRESS;
BEGIN
(* If list has < 2 items, do nothing *)
IF (start = NIL) THEN RETURN; END;
p1 := GetNext( start); IF (p1 = NIL) THEN RETURN; END;

(* If list has only 2 items, we'll not use recursion *)
p2 := GetNext( p1);
IF (p2 = NIL) THEN
IF (Compare( start, p1) > 0) THEN
q := start; SetNext( p1, q); SetNext( q, NIL);
start := p1;
END;
RETURN;
END;

(* List has > 2 items: split list in half *)
p1 := start;
REPEAT
p1 := GetNext( p1);
p2 := GetNext( p2);
IF (p2 <> NIL) THEN p2 := GetNext( p2); END;
UNTIL (p2 = NIL);
(* Now p1 points to last item in first half of list *)
p2 := GetNext( p1); SetNext( p1, NIL);
p1 := start;

(* Recursive calls to sort each half; p1 and p2 will be updated *)
DoMergeSort( p1, Compare, GetNext, SetNext);
DoMergeSort( p2, Compare, GetNext, SetNext);

(* Merge the sorted halves *)
IF Compare( p1, p2) < 0 THEN
start := p1; p1 := GetNext( p1);
ELSE
start := p2; p2 := GetNext( p2);
END;
q := start;
WHILE (p1 <> NIL) AND (p2 <> NIL) DO
IF Compare( p1, p2) < 0 THEN
SetNext( q, p1); q := p1; p1 := GetNext( p1);
ELSE
SetNext( q, p2); q := p2; p2 := GetNext( p2);
END;
END;
IF (p1 = NIL) THEN SetNext( q, p2) ELSE SetNext( q, p1) END;
END DoMergeSort;
END MergSort.
</syntaxhighlight>
<syntaxhighlight lang="modula2">
MODULE MergDemo;

IMPORT IO, Lib, MergSort;

TYPE PTestRec = POINTER TO TestRec;
TYPE TestRec = RECORD
Value : INTEGER;
Next : PTestRec;
END;

PROCEDURE Compare( a1, a2 : ADDRESS) : INTEGER;
VAR
p1, p2 : PTestRec;
BEGIN
p1 := a1; p2 := a2;
IF (p1^.Value < p2^.Value) THEN RETURN -1
ELSIF (p1^.Value > p2^.Value) THEN RETURN 1
ELSE RETURN 0; END;
END Compare;

PROCEDURE GetNext( a : ADDRESS) : ADDRESS;
VAR
p : PTestRec;
BEGIN
p := a; RETURN p^.Next;
END GetNext;

PROCEDURE SetNext( a, n : ADDRESS);
VAR
p : PTestRec;
BEGIN
p := a; p^.Next := n;
END SetNext;

(* Display the values in the linked list *)
PROCEDURE Display( p : PTestRec);
VAR
nrInLine : CARDINAL;
BEGIN
nrInLine := 0;
WHILE (p <> NIL) DO
IO.WrCard( p^.Value, 5);
p := p^.Next;
INC( nrInLine);
IF (nrInLine = 10) THEN IO.WrLn; nrInLine := 0; END;
END;
IF (nrInLine > 0) THEN IO.WrLn; END;
END Display;

(* Main routine *)
CONST ArraySize = 50;
VAR
arr : ARRAY [0..ArraySize - 1] OF TestRec;
j : CARDINAL;
start, p : PTestRec;
BEGIN
(* Fill values with random integers *)
FOR j := 0 TO ArraySize - 1 DO
arr[j].Value := Lib.RANDOM( 1000);
END;
(* Set up the links *)
IF (ArraySize > 1) THEN (* FOR loop 0 TO -1 crashes program *)
FOR j := 0 TO ArraySize - 2 DO
arr[j].Next := ADR( arr[j + 1]);
END;
END;
arr[ArraySize - 1].Next := NIL;
(* Demonstrate merge sort on the linked list *)
start := ADR( arr[0]);
IO.WrStr( 'Before:'); IO.WrLn;
Display( start);
MergSort.DoMergeSort( start, Compare, GetNext, SetNext);
IO.WrStr( 'After:'); IO.WrLn;
Display( start);
END MergDemo.
</syntaxhighlight>
{{out}}
<pre>
Before:
683 68 458 645 223 801 485 101 255 590
381 149 29 298 226 937 866 130 297 153
551 159 760 403 380 770 296 701 399 775
236 758 249 314 230 106 626 804 956 149
706 625 651 727 323 38 66 534 85 663
After:
29 38 66 68 85 101 106 130 149 149
153 159 223 226 230 236 249 255 296 297
298 314 323 380 381 399 403 458 485 534
551 590 625 626 645 651 663 683 701 706
727 758 760 770 775 801 804 866 937 956
</pre>

=={{header|Nemerle}}==
This is a translation of a Standard ML example from [[wp:Standard_ML#Mergesort|Wikipedia]].
<syntaxhighlight lang="nemerle">using System;
using System.Console;
using Nemerle.Collections;

module Mergesort
{
MergeSort[TEnu, TItem] (sort_me : TEnu) : list[TItem]
where TEnu : Seq[TItem]
where TItem : IComparable
{
def split(xs) {
def loop (zs, xs, ys) {
|(x::y::zs, xs, ys) => loop(zs, x::xs, y::ys)
|(x::[], xs, ys) => (x::xs, ys)
|([], xs, ys) => (xs, ys)
}
loop(xs, [], [])
}
def merge(xs, ys) {
def loop(res, xs, ys) {
|(res, [], []) => res.Reverse()
|(res, x::xs, []) => loop(x::res, xs, [])
|(res, [], y::ys) => loop(y::res, [], ys)
|(res, x::xs, y::ys) => if (x.CompareTo(y) < 0) loop(x::res, xs, y::ys)
else loop(y::res, x::xs, ys)
}
loop ([], xs, ys)
}
def ms(xs) {
|[] => []
|[x] => [x]
|_ => { def (left, right) = split(xs); merge(ms(left), ms(right)) }
}
ms(sort_me.NToList())
}
Main() : void
{
def test1 = MergeSort([1, 5, 9, 2, 7, 8, 4, 6, 3]);
def test2 = MergeSort(array['a', 't', 'w', 'f', 'c', 'y', 'l']);
WriteLine(test1);
WriteLine(test2);
}
}</syntaxhighlight>
{{out}}
<pre>[1, 2, 3, 4, 5, 6, 7, 8, 9]
[a, c, f, l, t, w, y]</pre>

=={{header|NetRexx}}==
<syntaxhighlight lang="netrexx">/* NetRexx */
options replace format comments java crossref savelog symbols binary

import java.util.List

placesList = [String -
"UK London", "US New York", "US Boston", "US Washington" -
, "UK Washington", "US Birmingham", "UK Birmingham", "UK Boston" -
]

lists = [ -
placesList -
, mergeSort(String[] Arrays.copyOf(placesList, placesList.length)) -
]

loop ln = 0 to lists.length - 1
cl = lists[ln]
loop ct = 0 to cl.length - 1
say cl[ct]
end ct
say
end ln

return

method mergeSort(m = String[]) public constant binary returns String[]

rl = String[m.length]
al = List mergeSort(Arrays.asList(m))
al.toArray(rl)

return rl

method mergeSort(m = List) public constant binary returns ArrayList

result = ArrayList(m.size)
left = ArrayList()
right = ArrayList()
if m.size > 1 then do
middle = m.size % 2
loop x_ = 0 to middle - 1
left.add(m.get(x_))
end x_
loop x_ = middle to m.size - 1
right.add(m.get(x_))
end x_
left = mergeSort(left)
right = mergeSort(right)
if (Comparable left.get(left.size - 1)).compareTo(Comparable right.get(0)) <= 0 then do
left.addAll(right)
result.addAll(m)
end
else do
result = merge(left, right)
end
end
else do
result.addAll(m)
end

return result

method merge(left = List, right = List) public constant binary returns ArrayList

result = ArrayList()
loop label mx while left.size > 0 & right.size > 0
if (Comparable left.get(0)).compareTo(Comparable right.get(0)) <= 0 then do
result.add(left.get(0))
left.remove(0)
end
else do
result.add(right.get(0))
right.remove(0)
end
end mx
if left.size > 0 then do
result.addAll(left)
end
if right.size > 0 then do
result.addAll(right)
end

return result
</syntaxhighlight>
{{out}}
<pre>
UK London
US New York
US Boston
US Washington
UK Washington
US Birmingham
UK Birmingham
UK Boston

UK Birmingham
UK Boston
UK London
UK Washington
US Birmingham
US Boston
US New York
US Washington
</pre>

=={{header|Nim}}==
<syntaxhighlight lang="nim">proc merge[T](a, b: var openarray[T]; left, middle, right: int) =
let
leftLen = middle - left
rightLen = right - middle
var
l = 0
r = leftLen
for i in left ..< middle:
b[l] = a[i]
inc l
for i in middle ..< right:
b[r] = a[i]
inc r
l = 0
r = leftLen
var i = left
while l < leftLen and r < leftLen + rightLen:
if b[l] < b[r]:
a[i] = b[l]
inc l
else:
a[i] = b[r]
inc r
inc i
while l < leftLen:
a[i] = b[l]
inc l
inc i
while r < leftLen + rightLen:
a[i] = b[r]
inc r
inc i
proc mergeSort[T](a, b: var openarray[T]; left, right: int) =
if right - left <= 1: return
let middle = (left + right) div 2
mergeSort(a, b, left, middle)
mergeSort(a, b, middle, right)
merge(a, b, left, middle, right)
proc mergeSort[T](a: var openarray[T]) =
var b = newSeq[T](a.len)
mergeSort(a, b, 0, a.len)
var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
mergeSort a
echo a</syntaxhighlight>
{{out}}
<pre>@[-31, 0, 2, 2, 4, 65, 83, 99, 782]</pre>

=={{header|OCaml}}==
<syntaxhighlight lang="ocaml">let rec split_at n xs =
match n, xs with
match n, xs with
0, xs ->
0, xs ->
Line 565: Line 5,830:
| _, [] ->
| _, [] ->
failwith "index too large"
failwith "index too large"
| n, x::xs when x > 0 ->
| n, x::xs when n > 0 ->
let xs', xs'' = split_at (pred n) xs in
let xs', xs'' = split_at (pred n) xs in
x::xs', xs''
x::xs', xs''
Line 579: Line 5,844:


let _ =
let _ =
merge_sort compare [8;6;4;2;1;3;5;7;9]</ocaml>
merge_sort compare [8;6;4;2;1;3;5;7;9]</syntaxhighlight>

=={{header|Oz}}==
<syntaxhighlight lang="oz">declare
fun {MergeSort Xs}
case Xs
of nil then nil
[] [X] then [X]
else
Middle = {Length Xs} div 2
Left Right
{List.takeDrop Xs Middle ?Left ?Right}
in
{List.merge {MergeSort Left} {MergeSort Right} Value.'<'}
end
end
in
{Show {MergeSort [3 1 4 1 5 9 2 6 5]}}</syntaxhighlight>

=={{header|PARI/GP}}==
Note also that the built-in <code>vecsort</code> and <code>listsort</code> use a merge sort internally.
<syntaxhighlight lang="parigp">mergeSort(v)={
if(#v<2, return(v));
my(m=#v\2,left=vector(m,i,v[i]),right=vector(#v-m,i,v[m+i]));
left=mergeSort(left);
right=mergeSort(right);
merge(left, right)
};
merge(u,v)={
my(ret=vector(#u+#v),i=1,j=1);
for(k=1,#ret,
if(i<=#u & (j>#v | u[i]<v[j]),
ret[k]=u[i];
i++
,
ret[k]=v[j];
j++
)
);
ret
};</syntaxhighlight>

=={{header|Pascal}}==
{{works with|FPC}}
<syntaxhighlight lang="pascal">
program MergeSortDemo;

{$mode objfpc}{$h+}

procedure MergeSort(var A: array of Integer);
var
Buf: array of Integer;
procedure Merge(L, M, R: Integer);
var
I, J, K: Integer;
begin
I := L;
J := Succ(M);
for K := 0 to R - L do
if (J > R) or (I <= M) and (A[I] <= A[J]) then begin
Buf[K] := A[I];
Inc(I);
end else begin
Buf[K] := A[J];
Inc(J);
end;
Move(Buf[0], A[L], Succ(R - L) * SizeOf(Integer));
end;
procedure MSort(L, R: Integer);
var
M: Integer;
begin
if R > L then begin
{$push}{$q-}{$r-}M := (L + R) shr 1;{$pop}
MSort(L, M);
MSort(M + 1, R);
if A[M] > A[M + 1] then
Merge(L, M, R);
end;
end;
begin
if Length(A) > 1 then begin
SetLength(Buf, Length(A));
MSort(0, High(A));
end;
end;

procedure PrintArray(const Name: string; const A: array of Integer);
var
I: Integer;
begin
Write(Name, ': [');
for I := 0 to High(A) - 1 do
Write(A[I], ', ');
WriteLn(A[High(A)], ']');
end;

var
a1: array[-7..5] of Integer = (27, -47, 14, 39, 47, -2, -8, 20, 18, 22, -49, -40, -8);
a2: array of Integer = (9, -25, -16, 24, 39, 42, 20, 20, 39, 10, -47, 28);
begin
MergeSort(a1);
PrintArray('a1', a1);
MergeSort(a2);
PrintArray('a2', a2);
end.
</syntaxhighlight>
{{out}}
<pre>
a1: [-49, -47, -40, -8, -8, -2, 14, 18, 20, 22, 27, 39, 47]
a2: [-47, -25, -16, 9, 10, 20, 20, 24, 28, 39, 39, 42]
</pre>
===improvement===
uses "only" one halfsized temporary array for merging, which are set to the right size in before.
small sized fields are sorted via insertion sort.
Only an array of Pointers is sorted, so no complex data transfers are needed.Sort for X,Y or whatever is easy to implement.

Works with ( Turbo -) Delphi too.
<syntaxhighlight lang="pascal">{$IFDEF FPC}
{$MODE DELPHI}
{$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils; //for timing
type
tDataElem = record
myText : AnsiString;
myX,
myY : double;
myTag,
myOrgIdx : LongInt;
end;
tpDataElem = ^tDataElem;
tData = array of tDataElem;
tSortData = array of tpDataElem;
tCompFunc = function(A,B:tpDataElem):integer;
var
Data : tData;
Sortdata,
tmpData : tSortData;
procedure InitData(var D:tData;cnt: LongWord);
var
i,k: LongInt;
begin
Setlength(D,cnt);
Setlength(SortData,cnt);
Setlength(tmpData,cnt shr 1 +1 );
k := 10*cnt;
For i := cnt-1 downto 0 do
Begin
Sortdata[i] := @D[i];
with D[i] do
Begin
myText := Format('_%.9d',[random(cnt)+1]);
myX := Random*k;
myY := Random*k;
myTag := Random(k);
myOrgIdx := i;
end;
end;
end;
procedure FreeData(var D:tData);
begin
Setlength(tmpData,0);
Setlength(SortData,0);
Setlength(D,0);
end;

function CompLowercase(A,B:tpDataElem):integer;
var
lcA,lcB: String;
Begin
lcA := lowercase(A^.myText);
lcB := lowercase(B^.myText);
result := ORD(lcA > lcB)-ORD(lcA < lcB);
end;

function myCompText(A,B:tpDataElem):integer;
{sort an array (or list) of strings in order of descending length,
and in ascending lexicographic order for strings of equal length.}
var
lA,lB:integer;
Begin
lA := Length(A^.myText);
lB := Length(B^.myText);
result := ORD(lA<lB)-ORD(lA>lB);
IF result = 0 then
result := CompLowercase(A,B);
end;
function myCompX(A,B:tpDataElem):integer;
//same as sign without jumps in assembler code
begin
result := ORD(A^.myX > B^.myX)-ORD(A^.myX < B^.myX);
end;
function myCompY(A,B:tpDataElem):integer;
Begin
result := ORD(A^.myY > B^.myY)-ORD(A^.myY < B^.myY);
end;
function myCompTag(A,B:tpDataElem):integer;
Begin
result := ORD(A^.myTag > B^.myTag)-ORD(A^.myTag < B^.myTag);
end;
procedure InsertionSort(left,right:integer;var a: tSortData;CompFunc: tCompFunc);
var
Pivot : tpDataElem;
i,j : LongInt;
begin
for i:=left+1 to right do
begin
j :=i;
Pivot := A[j];
while (j>left) AND (CompFunc(A[j-1],Pivot)>0) do
begin
A[j] := A[j-1];
dec(j);
end;
A[j] :=PiVot;// s.o.
end;
end;
procedure mergesort(left,right:integer;var a: tSortData;CompFunc: tCompFunc);
var
i,j,k,mid :integer;
begin
{// without insertion sort
If right>left then
}
//{ test insertion sort
If right-left<=14 then
InsertionSort(left,right,a,CompFunc)
else
//}
begin
//recursion
mid := (right+left) div 2;
mergesort(left, mid,a,CompFunc);
mergesort(mid+1, right,a,CompFunc);
//already sorted ?
IF CompFunc(A[Mid],A[Mid+1])<0 then
exit;
//########## Merge ##########
//copy lower half to temporary array
move(A[left],tmpData[0],(mid-left+1)*SizeOf(Pointer));
i := 0;
j := mid+1;
k := left;
// re-integrate
while (k<j) AND (j<=right) do
begin
IF CompFunc(tmpData[i],A[j])<=0 then
begin
A[k] := tmpData[i];
inc(i);
end
else
begin
A[k]:= A[j];
inc(j);
end;
inc(k);
end;
//the rest of tmpdata a move should do too, in next life
while (k<j) do
begin
A[k] := tmpData[i];
inc(i);
inc(k);
end;
end;
end;
var
T1,T0: TDateTime;
i : integer;
Begin
randomize;
InitData(Data,1*1000*1000);
T0 := Time;
mergesort(Low(SortData),High(SortData),SortData,@myCompText);
T1 := Time;
Writeln('myText ',FormatDateTime('NN:SS.ZZZ',T1-T0));
// For i := 0 to High(Data) do Write(SortData[i].myText); writeln;
T0 := Time;
mergesort(Low(SortData),High(SortData),SortData,@myCompX);
T1 := Time;
Writeln('myX ',FormatDateTime('NN:SS.ZZZ',T1-T0));
//check
For i := 1 to High(Data) do
IF myCompX(SortData[i-1],SortData[i]) = 1 then
Write(i:8);
T0 := Time;
mergesort(Low(SortData),High(SortData),SortData,@myCompY);
T1 := Time;
Writeln('myY ',FormatDateTime('NN:SS.ZZZ',T1-T0));
T0 := Time;
mergesort(Low(SortData),High(SortData),SortData,@myCompTag);
T1 := Time;
Writeln('myTag ',FormatDateTime('NN:SS.ZZZ',T1-T0));
FreeData (Data);
end.
</syntaxhighlight>
;output:
<pre>Free pascal 2.6.4 32bit / Win7 / i 4330 3.5 Ghz
myText 00:03.158 / nearly worst case , all strings same sized and starting with '_000..'
myX 00:00.360
myY 00:00.363
myTag 00:00.283
</pre>

=={{header|Perl}}==
<syntaxhighlight lang="perl">sub merge_sort {
my @x = @_;
return @x if @x < 2;
my $m = int @x / 2;
my @a = merge_sort(@x[0 .. $m - 1]);
my @b = merge_sort(@x[$m .. $#x]);
for (@x) {
$_ = !@a ? shift @b
: !@b ? shift @a
: $a[0] <= $b[0] ? shift @a
: shift @b;
}
@x;
}

my @a = (4, 65, 2, -31, 0, 99, 83, 782, 1);
@a = merge_sort @a;
print "@a\n";</syntaxhighlight>
Also note, the built-in function [http://perldoc.perl.org/functions/sort.html sort] uses mergesort.

=={{header|Phix}}==
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">merge</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{}</span>
<span style="color: #008080;">while</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">left</span><span style="color: #0000FF;">)></span><span style="color: #000000;">0</span> <span style="color: #008080;">and</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">right</span><span style="color: #0000FF;">)></span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]<=</span><span style="color: #000000;">right</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">result</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">left</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">result</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">result</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">right</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">..$]</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">result</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">left</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">right</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">mergesort</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">m</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">)<=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span> <span style="color: #008080;">return</span> <span style="color: #000000;">m</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">middle</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">2</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">left</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">mergesort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">middle</span><span style="color: #0000FF;">]),</span>
<span style="color: #000000;">right</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">mergesort</span><span style="color: #0000FF;">(</span><span style="color: #000000;">m</span><span style="color: #0000FF;">[</span><span style="color: #000000;">middle</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..$])</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">left</span><span style="color: #0000FF;">[$]<=</span><span style="color: #000000;">right</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">left</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">right</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">[$]<=</span><span style="color: #000000;">left</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">right</span> <span style="color: #0000FF;">&</span> <span style="color: #000000;">left</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">merge</span><span style="color: #0000FF;">(</span><span style="color: #000000;">left</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">right</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">shuffle</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">10</span><span style="color: #0000FF;">))</span>
<span style="color: #0000FF;">?</span> <span style="color: #000000;">s</span>
<span style="color: #0000FF;">?</span> <span style="color: #000000;">mergesort</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">))</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
{8,1,2,5,10,3,9,6,7,4}
{1,2,3,4,5,6,7,8,9,10}
</pre>

=={{header|PHP}}==
<syntaxhighlight lang="php">function mergesort($arr){
if(count($arr) == 1 ) return $arr;
$mid = count($arr) / 2;
$left = array_slice($arr, 0, $mid);
$right = array_slice($arr, $mid);
$left = mergesort($left);
$right = mergesort($right);
return merge($left, $right);
}

function merge($left, $right){
$res = array();
while (count($left) > 0 && count($right) > 0){
if($left[0] > $right[0]){
$res[] = $right[0];
$right = array_slice($right , 1);
}else{
$res[] = $left[0];
$left = array_slice($left, 1);
}
}
while (count($left) > 0){
$res[] = $left[0];
$left = array_slice($left, 1);
}
while (count($right) > 0){
$res[] = $right[0];
$right = array_slice($right, 1);
}
return $res;
}

$arr = array( 1, 5, 2, 7, 3, 9, 4, 6, 8);
$arr = mergesort($arr);
echo implode(',',$arr);</syntaxhighlight>
{{out}}
<pre>1,2,3,4,5,6,7,8,9</pre>

=={{header|Picat}}==
{{trans|Prolog}}
<syntaxhighlight lang="picat">% True if S is a sorted copy of L, using merge sort
msort([],[]).
msort([X],[X]).
msort(U,S) :-
split(U, L, R),
msort(L, SL),
msort(R, SR),
merge(SL, SR, S).
% split(LIST,L,R)
% Alternate elements of LIST in L and R
split([],[],[]).
split([X],[X],[]).
split([L,R|T],[L|LT],[R|RT]) :-
split( T, LT, RT ).
% merge( LS, RS, M )
% Assuming LS and RS are sorted, True if M is the sorted merge of the two
merge([],RS,RS).
merge(LS,[],LS).
merge([L|LS],[R|RS],[L|T]) :-
L @=< R,
merge(LS,[R|RS],T).
merge([L|LS],[R|RS],[R|T]) :-
L @> R,
merge([L|LS],RS,T).</syntaxhighlight>


=={{header|PicoLisp}}==
PicoLisp's built-in sort routine uses merge sort. This is a high level implementation.
<syntaxhighlight lang="lisp">(de alt (List)
(if List (cons (car List) (alt (cddr List))) ()) )

(de merge (L1 L2)
(cond
((not L2) L1)
((< (car L1) (car L2))
(cons (car L1) (merge L2 (cdr L1))))
(T (cons (car L2) (merge L1 (cdr L2)))) ) )

(de mergesort (List)
(if (cdr List)
(merge (mergesort (alt List)) (mergesort (alt (cdr List))))
List) )

(mergesort (8 1 5 3 9 0 2 7 6 4))</syntaxhighlight>

=={{header|PL/I}}==
<syntaxhighlight lang="pli">MERGE: PROCEDURE (A,LA,B,LB,C);

/* Merge A(1:LA) with B(1:LB), putting the result in C
B and C may share the same memory, but not with A.
*/
DECLARE (A(*),B(*),C(*)) BYADDR POINTER;
DECLARE (LA,LB) BYVALUE NONASGN FIXED BIN(31);
DECLARE (I,J,K) FIXED BIN(31);
DECLARE (SX) CHAR(58) VAR BASED (PX);
DECLARE (SY) CHAR(58) VAR BASED (PY);
DECLARE (PX,PY) POINTER;

I=1; J=1; K=1;
DO WHILE ((I <= LA) & (J <= LB));
PX=A(I); PY=B(J);
IF(SX <= SY) THEN
DO; C(K)=A(I); K=K+1; I=I+1; END;
ELSE
DO; C(K)=B(J); K=K+1; J=J+1; END;
END;
DO WHILE (I <= LA);
C(K)=A(I); I=I+1; K=K+1;
END;
RETURN;
END MERGE;

MERGESORT: PROCEDURE (AP,N) RECURSIVE ;

/* Sort the array AP containing N pointers to strings */

DECLARE (AP(*)) BYADDR POINTER;
DECLARE (N) BYVALUE NONASGN FIXED BINARY(31);
DECLARE (M,I) FIXED BINARY;
DECLARE AMP1(1) POINTER BASED(PAM);
DECLARE (pX,pY,PAM) POINTER;
DECLARE SX CHAR(58) VAR BASED(pX);
DECLARE SY CHAR(58) VAR BASED(pY);

IF (N=1) THEN RETURN;
M = trunc((N+1)/2);
IF (M>1) THEN CALL MERGESORT(AP,M);
PAM=ADDR(AP(M+1));
IF (N-M > 1) THEN CALL MERGESORT(AMP1,N-M);
pX=AP(M); pY=AP(M+1);
IF SX <= SY then return; /* Skip Merge */
DO I=1 to M; TP(I)=AP(I); END;
CALL MERGE(TP,M,AMP1,N-M,AP);
RETURN;
END MERGESORT;</syntaxhighlight>

=={{header|PowerShell}}==
<syntaxhighlight lang="powershell">
function MergeSort([object[]] $SortInput)
{
# The base case exits for minimal lists that are sorted by definition
if ($SortInput.Length -le 1) {return $SortInput}
# Divide and conquer
[int] $midPoint = $SortInput.Length/2
# The @() operators ensure a single result remains typed as an array
[object[]] $left = @(MergeSort @($SortInput[0..($midPoint-1)]))
[object[]] $right = @(MergeSort @($SortInput[$midPoint..($SortInput.Length-1)]))

# Merge
[object[]] $result = @()
while (($left.Length -gt 0) -and ($right.Length -gt 0))
{
if ($left[0] -lt $right[0])
{
$result += $left[0]
# Use an if/else rather than accessing the array range as $array[1..0]
if ($left.Length -gt 1){$left = $left[1..$($left.Length-1)]}
else {$left = @()}
}
else
{
$result += $right[0]
# Without the if/else, $array[1..0] would return the whole array when $array.Length == 1
if ($right.Length -gt 1){$right = $right[1..$($right.Length-1)]}
else {$right = @()}
}
}
# If we get here, either $left or $right is an empty array (or both are empty!). Since the
# rest of the unmerged array is already sorted, we can simply string together what we have.
# This line outputs the concatenated result. An explicit 'return' statement is not needed.
$result + $left + $right
}
</syntaxhighlight>

=={{header|Prolog}}==
<syntaxhighlight lang="prolog">% msort( L, S )
% True if S is a sorted copy of L, using merge sort
msort( [], [] ).
msort( [X], [X] ).
msort( U, S ) :- split(U, L, R), msort(L, SL), msort(R, SR), merge(SL, SR, S).

% split( LIST, L, R )
% Alternate elements of LIST in L and R
split( [], [], [] ).
split( [X], [X], [] ).
split( [L,R|T], [L|LT], [R|RT] ) :- split( T, LT, RT ).

% merge( LS, RS, M )
% Assuming LS and RS are sorted, True if M is the sorted merge of the two
merge( [], RS, RS ).
merge( LS, [], LS ).
merge( [L|LS], [R|RS], [L|T] ) :- L =< R, merge( LS, [R|RS], T).
merge( [L|LS], [R|RS], [R|T] ) :- L > R, merge( [L|LS], RS, T).</syntaxhighlight>

=={{header|PureBasic}}==
A non-optimized version with lists.
<syntaxhighlight lang="purebasic">Procedure display(List m())
ForEach m()
Print(LSet(Str(m()), 3," "))
Next
PrintN("")
EndProcedure

;overwrites list m() with the merger of lists ma() and mb()
Procedure merge(List m(), List ma(), List mb())
FirstElement(m())
Protected ma_elementExists = FirstElement(ma())
Protected mb_elementExists = FirstElement(mb())
Repeat
If ma() <= mb()
m() = ma(): NextElement(m())
ma_elementExists = NextElement(ma())
Else
m() = mb(): NextElement(m())
mb_elementExists = NextElement(mb())
EndIf
Until Not (ma_elementExists And mb_elementExists)

If ma_elementExists
Repeat
m() = ma(): NextElement(m())
Until Not NextElement(ma())
ElseIf mb_elementExists
Repeat
m() = mb(): NextElement(m())
Until Not NextElement(mb())
EndIf
EndProcedure

Procedure mergesort(List m())
Protected NewList ma()
Protected NewList mb()
If ListSize(m()) > 1
Protected current, middle = (ListSize(m()) / 2 ) - 1
FirstElement(m())
While current <= middle
AddElement(ma())
ma() = m()
NextElement(m()): current + 1
Wend
PreviousElement(m())
While NextElement(m())
AddElement(mb())
mb() = m()
Wend
mergesort(ma())
mergesort(mb())
LastElement(ma()): FirstElement(mb())
If ma() <= mb()
FirstElement(m())
FirstElement(ma())
Repeat
m() = ma(): NextElement(m())
Until Not NextElement(ma())
Repeat
m() = mb(): NextElement(m())
Until Not NextElement(mb())
Else
merge(m(), ma(), mb())
EndIf
EndIf
EndProcedure
If OpenConsole()
Define i
NewList x()
For i = 1 To 21: AddElement(x()): x() = Random(60): Next
display(x())
mergesort(x())
display(x())
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
Input()
CloseConsole()
EndIf</syntaxhighlight>
{{out|Sample output}}
<pre>22 51 31 59 58 45 11 2 16 56 38 42 2 10 23 41 42 25 45 28 42
2 2 10 11 16 22 23 25 28 31 38 41 42 42 42 45 45 51 56 58 59</pre>


=={{header|Python}}==
=={{header|Python}}==
{{works with|Python|2.6+}}
<python>def merge_sort(m):
<syntaxhighlight lang="python">from heapq import merge

def merge_sort(m):
if len(m) <= 1:
if len(m) <= 1:
return m
return m


middle = len(m) / 2
middle = len(m) // 2
left = m[:middle]
left = m[:middle]
right = m[middle:]
right = m[middle:]
Line 592: Line 6,535:
left = merge_sort(left)
left = merge_sort(left)
right = merge_sort(right)
right = merge_sort(right)
return merge(left, right)
return list(merge(left, right))</syntaxhighlight>
Pre-2.6, merge() could be implemented like this:

def merge(left, right):
<syntaxhighlight lang="python">def merge(left, right):
result = []
result = []
left_idx, right_idx = 0, 0

while left and right:
while left_idx < len(left) and right_idx < len(right):
# change the direction of this comparison to change the direction of the sort
# change the direction of this comparison to change the direction of the sort
if left[0] <= right[0]:
if left[left_idx] <= right[right_idx]:
result.append(left.pop(0))
result.append(left[left_idx])
left_idx += 1
else:
else:
result.append(right.pop(0))
result.append(right[right_idx])
right_idx += 1


if left:
if left_idx < len(left):
result.extend(left)
result.extend(left[left_idx:])
if right:
if right_idx < len(right):
result.extend(right)
result.extend(right[right_idx:])
return result</python>
return result</syntaxhighlight>

using only recursions
<syntaxhighlight lang="python">def merge(x, y):
if x==[]: return y
if y==[]: return x
return [x[0]] + merge(x[1:], y) if x[0]<y[0] else [y[0]] + merge(x, y[1:])

def sort(a, n):
m = n//2
return a if n<=1 else merge(sort(a[:m], m), sort(a[m:], n-m))

a = list(map(int, input().split()))
print(sort(a, len(a)))</syntaxhighlight>

=={{header|Quackery}}==
<syntaxhighlight lang="quackery">[ [] temp put
[ dup [] != while
over [] != while
over 0 peek
over 0 peek
> not if dip
[ 1 split
temp take
rot join
temp put ]
again ]
join
temp take swap join ] is merge ( [ [ --> [ )

[ dup size 2 < if done
dup size 2 / split
swap recurse
swap recurse
merge ] is mergesort ( [ --> [ )</syntaxhighlight>

=={{header|R}}==
<syntaxhighlight lang="r">mergesort <- function(m)
{
merge_ <- function(left, right)
{
result <- c()
while(length(left) > 0 && length(right) > 0)
{
if(left[1] <= right[1])
{
result <- c(result, left[1])
left <- left[-1]
} else
{
result <- c(result, right[1])
right <- right[-1]
}
}
if(length(left) > 0) result <- c(result, left)
if(length(right) > 0) result <- c(result, right)
result
}
len <- length(m)
if(len <= 1) m else
{
middle <- length(m) / 2
left <- m[1:floor(middle)]
right <- m[floor(middle+1):len]
left <- mergesort(left)
right <- mergesort(right)
if(left[length(left)] <= right[1])
{
c(left, right)
} else
{
merge_(left, right)
}
}
}
mergesort(c(4, 65, 2, -31, 0, 99, 83, 782, 1)) # -31 0 1 2 4 65 83 99 782</syntaxhighlight>

=={{header|Racket}}==
<syntaxhighlight lang="racket">
#lang racket

(define (merge xs ys)
(cond [(empty? xs) ys]
[(empty? ys) xs]
[(match* (xs ys)
[((list* a as) (list* b bs))
(cond [(<= a b) (cons a (merge as ys))]
[ (cons b (merge xs bs))])])]))

(define (merge-sort xs)
(match xs
[(or (list) (list _)) xs]
[_ (define-values (ys zs) (split-at xs (quotient (length xs) 2)))
(merge (merge-sort ys) (merge-sort zs))]))
</syntaxhighlight>
This variation is bottom up:
<syntaxhighlight lang="racket">
#lang racket

(define (merge-sort xs)
(merge* (map list xs)))

(define (merge* xss)
(match xss
[(list) '()]
[(list xs) xss]
[(list xs ys zss ...)
(merge* (cons (merge xs ys) (merge* zss)))]))

(define (merge xs ys)
(cond [(empty? xs) ys]
[(empty? ys) xs]
[(match* (xs ys)
[((list* a as) (list* b bs))
(cond [(<= a b) (cons a (merge as ys))]
[ (cons b (merge xs bs))])])]))
</syntaxhighlight>

=={{header|Raku}}==
<syntaxhighlight lang="raku" line>
#| Recursive, single-thread, mergesort implementation
sub mergesort ( @a ) {
return @a if @a <= 1;

# recursion step
my $m = @a.elems div 2;
my @l = samewith @a[ 0 ..^ $m ];
my @r = samewith @a[ $m ..^ @a ];

# short cut - in case of no overlapping in left and right parts
return flat @l, @r if @l[*-1] !after @r[0];
return flat @r, @l if @r[*-1] !after @l[0];

# merge step
return flat gather {
take @l[0] before @r[0]
?? @l.shift
!! @r.shift
while @l and @r;

take @l, @r;
}
}</syntaxhighlight>
Some intial testing

<syntaxhighlight lang="raku" line>
my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
say 'input = ' ~ @data;
say 'output = ' ~ @data.&merge_sort;</syntaxhighlight>
{{out}}
<pre>input = 6 7 2 1 8 9 5 3 4
output = 1 2 3 4 5 6 7 8 9</pre>

===concurrent implementation===

Let's implement it using parallel sorting.

<syntaxhighlight lang="raku" line>
#| Recursive, naive multi-thread, mergesort implementation
sub mergesort-parallel-naive ( @a ) {
return @a if @a <= 1;

my $m = @a.elems div 2;

# recursion step launching new thread
my @l = start { samewith @a[ 0 ..^ $m ] };
# meanwhile recursively sort right side
my @r = samewith @a[ $m ..^ @a ] ;

# as we went parallel on left side, we need to await the result
await @l[0] andthen @l = @l[0].result;

# short cut - in case of no overlapping left and right parts
return flat @l, @r if @l[*-1] !after @r[0];
return flat @r, @l if @r[*-1] !after @l[0];

# merge step
return flat gather {
take @l[0] before @r[0]
?? @l.shift
!! @r.shift
while @l and @r;

take @l, @r;
}
}
</syntaxhighlight>

and tune the batch size required to launch a new thread.

<syntaxhighlight lang="raku" line>
#| Recursive, batch tuned multi-thread, mergesort implementation
sub mergesort-parallel ( @a, $batch = 2**9 ) {
return @a if @a <= 1;

my $m = @a.elems div 2;

# recursion step
my @l = $m >= $batch
?? start { samewith @a[ 0 ..^ $m ], $batch }
!! samewith @a[ 0 ..^ $m ], $batch ;

# meanwhile recursively sort right side
my @r = samewith @a[ $m ..^ @a ], $batch;

# if we went parallel on left side, we need to await the result
await @l[0] andthen @l = @l[0].result if @l[0] ~~ Promise;

# short cut - in case of no overlapping left and right parts
return flat @l, @r if @l[*-1] !after @r[0];
return flat @r, @l if @r[*-1] !after @l[0];

# merge step
return flat gather {
take @l[0] before @r[0]
?? @l.shift
!! @r.shift
while @l and @r;

take @l, @r;
}
}
</syntaxhighlight>

===testing===

Let's run some tests ...

<syntaxhighlight lang="raku" line>
say "x" x 10 ~ " Testing " ~ "x" x 10;
use Test;
my @functions-under-test = &mergesort, &mergesort-parallel-naive, &mergesort-parallel;
my @testcases =
() => (),
<a>.List => <a>.List,
<a a> => <a a>,
("b", "a", 3) => (3, "a", "b"),
<h b a c d f e g> => <a b c d e f g h>,
<a 🎮 3 z 4 🐧> => <a 🎮 3 z 4 🐧>.sort
;

plan @testcases.elems * @functions-under-test.elems;
for @functions-under-test -> &fun {
say &fun.name;
is-deeply &fun(.key), .value, .key ~ " => " ~ .value for @testcases;
}
done-testing;
</syntaxhighlight>
{{out}}
<pre>xxxxxxxxxx Testing xxxxxxxxxx
1..18
mergesort
ok 1 - =>
ok 2 - a => a
ok 3 - a a => a a
ok 4 - b a 3 => 3 a b
ok 5 - h b a c d f e g => a b c d e f g h
ok 6 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
mergesort-parallel-naive
ok 7 - =>
ok 8 - a => a
ok 9 - a a => a a
ok 10 - b a 3 => 3 a b
ok 11 - h b a c d f e g => a b c d e f g h
ok 12 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧
mergesort-parallel
ok 13 - =>
ok 14 - a => a
ok 15 - a a => a a
ok 16 - b a 3 => 3 a b
ok 17 - h b a c d f e g => a b c d e f g h
ok 18 - a 🎮 3 z 4 🐧 => 3 4 a z 🎮 🐧</pre>

===benchmarking===
and some Benchmarking.

<syntaxhighlight lang="raku" line>
use Benchmark;
my $runs = 5;
my $elems = 10 * Kernel.cpu-cores * 2**10;
my @unsorted of Str = ('a'..'z').roll(8).join xx $elems;
my UInt $l-batch = 2**13;
my UInt $m-batch = 2**11;
my UInt $s-batch = 2**9;
my UInt $t-batch = 2**7;

say "elements: $elems, runs: $runs, cpu-cores: {Kernel.cpu-cores}, large/medium/small/tiny-batch: $l-batch/$m-batch/$s-batch/$t-batch";

my %results = timethese $runs, {
single-thread => { mergesort(@unsorted) },
parallel-naive => { mergesort-parallel-naive(@unsorted) },
parallel-tiny-batch => { mergesort-parallel(@unsorted, $t-batch) },
parallel-small-batch => { mergesort-parallel(@unsorted, $s-batch) },
parallel-medium-batch => { mergesort-parallel(@unsorted, $m-batch) },
parallel-large-batch => { mergesort-parallel(@unsorted, $l-batch) },
}, :statistics;

my @metrics = <mean median sd>;
my $msg-row = "%.4f\t" x @metrics.elems ~ '%s';

say @metrics.join("\t");
for %results.kv -> $name, %m {
say sprintf($msg-row, %m{@metrics}, $name);
}
</syntaxhighlight>

<pre>
elements: 40960, runs: 5, cpu-cores: 4, large/medium/small/tiny-batch: 8192/2048/512/128
mean median sd
7.7683 8.0265 0.5724 parallel-naive
3.1354 3.1272 0.0602 parallel-tiny-batch
2.6932 2.6599 0.1831 parallel-medium-batch
2.8139 2.7832 0.0641 parallel-large-batch
3.0908 3.0593 0.0675 parallel-small-batch
5.9989 5.9450 0.1518 single-thread
</pre>

=={{header|REBOL}}==
<pre>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
]</pre>

=={{header|Refal}}==
<syntaxhighlight lang="refal">$ENTRY Go {
, 7 6 5 9 8 4 3 1 2 0: e.Arr
= <Prout e.Arr>
<Prout <Sort e.Arr>>;
};

Sort {
= ;
s.N = s.N;
e.X, <Split e.X>: (e.L) (e.R) = <Merge (<Sort e.L>) (<Sort e.R>)>;
};

Split {
(e.L) (e.R) = (e.L) (e.R);
(e.L) (e.R) s.X = (e.L s.X) (e.R);
(e.L) (e.R) s.X s.Y e.Z = <Split (e.L s.X) (e.R s.Y) e.Z>;
e.X = <Split () () e.X>;
};

Merge {
(e.L) () = e.L;
() (e.R) = e.R;
(s.X e.L) (s.Y e.R), <Compare s.X s.Y>: {
'-' = s.X <Merge (e.L) (s.Y e.R)>;
s.Z = s.Y <Merge (s.X e.L) (e.R)>;
};
};</syntaxhighlight>
{{out}}
<pre>7 6 5 9 8 4 3 1 2 0
0 1 2 3 4 5 6 7 8 9</pre>

=={{header|REXX}}==
Note: &nbsp; the array elements can be anything: &nbsp; integers, floating point (exponentiated), character strings ···
<syntaxhighlight lang="rexx">/*REXX pgm sorts a stemmed array (numbers and/or chars) using the merge─sort algorithm.*/
call init /*sinfully initialize the @ array. */
call show 'before sort' /*show the "before" array elements. */
say copies('▒', 75) /*display a separator line to the term.*/
call merge # /*invoke the merge sort for the array*/
call show ' after sort' /*show the "after" array elements. */
exit 0 /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
init: @.=; @.1= '---The seven deadly sins---' ; @.4= "avarice" ; @.7= 'gluttony'
@.2= '===========================' ; @.5= "wrath" ; @.8= 'sloth'
@.3= 'pride' ; @.6= "envy" ; @.9= 'lust'
do #=1 until @.#==''; end; #= #-1; return /*#: # of entries in @ array.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do j=1 for #; say right('element',20) right(j,length(#)) arg(1)":" @.j; end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
merge: procedure expose @. !.; parse arg n, L; if L=='' then do; !.=; L= 1; end
if n==1 then return; h= L + 1
if n==2 then do; if @.L>@.h then do; _=@.h; @.h=@.L; @.L=_; end; return; end
m= n % 2 /* [↑] handle case of two items.*/
call merge n-m, L+m /*divide items to the left ···*/
call merger m, L, 1 /* " " " " right ···*/
i= 1; j= L + m
do k=L while k<j /*whilst items on right exist ···*/
if j==L+n | !.i<=@.j then do; @.k= !.i; i= i + 1; end
else do; @.k= @.j; j= j + 1; end
end /*k*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
merger: procedure expose @. !.; parse arg n,L,T
if n==1 then do; !.T= @.L; return; end
if n==2 then do; h= L + 1; q= T + 1; !.q= @.L; !.T= @.h; return; end
m= n % 2 /* [↑] handle case of two items.*/
call merge m, L /*divide items to the left ···*/
call merger n-m, L+m, m+T /* " " " " right ···*/
i= L; j= m + T
do k=T while k<j /*whilst items on left exist ···*/
if j==T+n | @.i<=!.j then do; !.k= @.i; i= i + 1; end
else do; !.k= !.j; j= j + 1; end
end /*k*/
return</syntaxhighlight>
{{out|output|text=&nbsp; when using the default input:}}
(Shown at three-quarter size.)

<pre style="font-size:75%">
element 1 before sort: ---The seven deadly sins---
element 2 before sort: ===========================
element 3 before sort: pride
element 4 before sort: avarice
element 5 before sort: wrath
element 6 before sort: envy
element 7 before sort: gluttony
element 8 before sort: sloth
element 9 before sort: lust
▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
element 1 after sort: ---The seven deadly sins---
element 2 after sort: ===========================
element 3 after sort: avarice
element 4 after sort: envy
element 5 after sort: gluttony
element 6 after sort: lust
element 7 after sort: pride
element 8 after sort: sloth
element 9 after sort: wrath
</pre>

=={{header|Ruby}}==
<syntaxhighlight lang="ruby">def merge_sort(m)
return m if m.length <= 1
middle = m.length / 2
left = merge_sort(m[0...middle])
right = merge_sort(m[middle..-1])
merge(left, right)
end

def merge(left, right)
result = []
until left.empty? || right.empty?
result << (left.first<=right.first ? left.shift : right.shift)
end
result + left + right
end

ary = [7,6,5,9,8,4,3,1,2,0]
p merge_sort(ary) # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]</syntaxhighlight>

Here's a version that monkey patches the Array class, with an example that demonstrates it's a stable sort
<syntaxhighlight lang="ruby">class Array
def mergesort(&comparitor)
return self if length <= 1
comparitor ||= proc{|a, b| a <=> b}
middle = length / 2
left = self[0...middle].mergesort(&comparitor)
right = self[middle..-1].mergesort(&comparitor)
merge(left, right, comparitor)
end
private
def merge(left, right, comparitor)
result = []
until left.empty? || right.empty?
# change the direction of this comparison to change the direction of the sort
if comparitor[left.first, right.first] <= 0
result << left.shift
else
result << right.shift
end
end
result + left + right
end
end

ary = [7,6,5,9,8,4,3,1,2,0]
p ary.mergesort # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
p ary.mergesort {|a, b| b <=> a} # => [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]

ary = [["UK", "London"], ["US", "New York"], ["US", "Birmingham"], ["UK", "Birmingham"]]
p ary.mergesort
# => [["UK", "Birmingham"], ["UK", "London"], ["US", "Birmingham"], ["US", "New York"]]
p ary.mergesort {|a, b| a[1] <=> b[1]}
# => [["US", "Birmingham"], ["UK", "Birmingham"], ["UK", "London"], ["US", "New York"]]</syntaxhighlight>

=={{header|Rust}}==
{{works with|rustc|1.9.0}}
Recursive with buffer equal to the size of the sort vector
<syntaxhighlight lang="rust">
pub fn merge_sort1<T: Copy + Ord>(v: &mut [T]) {
sort(v, &mut Vec::new());

fn sort<T: Copy + Ord>(v: &mut [T], t: &mut Vec<T>) {
match v.len() {
0 | 1 => (),
// n if n <= 20 => insertion_sort(v),
n => {
if t.is_empty() {
t.reserve_exact(n);
t.resize(n, v[0]);
}
let m = n / 2;
sort(&mut v[..m], t);
sort(&mut v[m..], t);
if v[m - 1] <= v[m] {
return;
}
copy(v, t);
merge(&t[..m], &t[m..n], v);
}
}
}

// merge a + b -> c
#[inline(always)]
fn merge<T: Copy + Ord>(a: &[T], b: &[T], c: &mut [T]) {
let (mut i, mut j) = (0, 0);
for k in 0..c.len() {
if i < a.len() && (j >= b.len() || a[i] <= b[j]) {
c[k] = a[i];
i += 1;
} else {
c[k] = b[j];
j += 1;
}
}
}

#[inline(always)]
fn copy<T: Copy>(src: &[T], dst: &mut [T]) {
for i in 0..src.len() {
dst[i] = src[i];
}
}

#[inline(always)]
fn insertion_sort<T: Ord>(v: &mut [T]) {
for i in 1..v.len() {
let mut j = i;
while j > 0 && v[j] < v[j - 1] {
v.swap(j, j - 1);
j -= 1;
}
}
}
}
</syntaxhighlight>
Recursive with buffer equal to half the size of the sort vector
<syntaxhighlight lang="rust">
pub fn merge_sort2<T: Copy + Ord>(v: &mut [T]) {
sort(v, &mut Vec::new());

fn sort<T: Copy + Ord>(v: &mut [T], t: &mut Vec<T>) {
match v.len() {
0 | 1 => (),
// n if n <= 20 => insertion_sort(v),
n => {
let m = n / 2;
if t.is_empty() {
t.reserve_exact(m);
t.resize(m, v[0]);
}
sort(&mut v[..m], t);
sort(&mut v[m..], t);
if v[m - 1] <= v[m] {
return;
}
copy(&v[..m], t);
merge(&t[..m], v);
}
}
}

// merge a + b[a.len..] -> b
#[inline(always)]
fn merge<T: Copy + Ord>(a: &[T], b: &mut [T]) {
let (mut i, mut j) = (0, a.len());
for k in 0..b.len() {
if i < a.len() && (j >= b.len() || a[i] <= b[j]) {
b[k] = a[i];
i += 1;
} else {
b[k] = b[j];
j += 1;
}
}
}

#[inline(always)]
fn copy<T: Copy>(src: &[T], dst: &mut [T]) {
for i in 0..src.len() {
dst[i] = src[i];
}
}
}
</syntaxhighlight>

Version without recursion call:
<syntaxhighlight lang="rust">
pub fn merge_sort3<T: Copy + Ord>(v: &mut [T]) {
match v.len() {
0 | 1 => (),
n => {
let mut t = Vec::with_capacity(n);
t.resize(n, v[0]);
let mut p = 1;
while p < n {
p = merge_blocks(v, &mut t, p, n);
if p >= n {
copy(&t, v);
return;
}
p = merge_blocks(&t, v, p, n);
}
}
}

#[inline(always)]
fn merge_blocks<T: Copy + Ord>(a: &[T], b: &mut [T], p: usize, n: usize) -> usize {
let mut i = 0;
while i < n {
if i + p >= n {
copy(&a[i..], &mut b[i..])
} else if i + p * 2 > n {
merge(&a[i..i + p], &a[i + p..], &mut b[i..]);
} else {
merge(&a[i..i + p], &a[i + p..i + p * 2], &mut b[i..i + p * 2]);
}
i += p * 2;
}
p * 2
}

// merge a + b -> c
#[inline(always)]
fn merge<T: Copy + Ord>(a: &[T], b: &[T], c: &mut [T]) {
let (mut i, mut j, mut k) = (0, 0, 0);
while i < a.len() && j < b.len() {
if a[i] < b[j] {
c[k] = a[i];
i += 1;
} else {
c[k] = b[j];
j += 1;
}
k += 1;
}
if i < a.len() {
copy(&a[i..], &mut c[k..]);
}
if j < b.len() {
copy(&b[j..], &mut c[k..]);
}
}

#[inline(always)]
fn copy<T: Copy>(src: &[T], dst: &mut [T]) {
for i in 0..src.len() {
dst[i] = src[i];
}
}
}
</syntaxhighlight>

=={{header|Scala}}==
The use of LazyList as the merge result avoids stack overflows without resorting to
tail recursion, which would typically require reversing the result, as well as being
a bit more convoluted.
<syntaxhighlight lang="scala">
import scala.language.implicitConversions

object MergeSort extends App {

def mergeSort(input: List[Int]): List[Int] = {
def merge(left: List[Int], right: List[Int]): LazyList[Int] = (left, right) match {
case (x :: xs, y :: ys) if x <= y => x #:: merge(xs, right)
case (x :: xs, y :: ys) => y #:: merge(left, ys)
case _ => if (left.isEmpty) right.to(LazyList) else left.to(LazyList)
}

def sort(input: List[Int], length: Int): List[Int] = input match {
case Nil | List(_) => input
case _ =>
val middle = length / 2
val (left, right) = input splitAt middle
merge(sort(left, middle), sort(right, middle + length % 2)).toList
}

sort(input, input.length)
}

}
</syntaxhighlight>


=={{header|Scheme}}==
=={{header|Scheme}}==
(define (merge-sort l gt?)
<syntaxhighlight lang="scheme">(define (merge-sort l gt?)
(define (merge left right)
(letrec
(
(cond
(merge
((null? left)
(lambda (left right)
right)
(cond
((null? right)
((null? left) right)
left)
((null? right) left)
((gt? (car left) (car right))
((gt? (car left) (car right))
(cons (car right)
(cons (car right) (merge left (cdr right))))
(merge left (cdr right))))
(else
(else
(cons (car left) (merge (cdr left) right))))))
(cons (car left)
(merge (cdr left) right)))))
(define (take l n)
(take
(lambda (l num)
(if (zero? n)
(if (zero? num)
(list)
(list)
(cons (car l)
(cons (car l) (take (cdr l) (- num 1))))))
(take (cdr l) (- n 1)))))
(let ((half (quotient (length l) 2)))
(half (quotient (length l) 2)))
(if (zero? half)
l
(if (zero? half)
(merge (merge-sort (take l half) gt?)
(merge-sort (list-tail l half) gt?)))))</syntaxhighlight>
l

(merge
(merge-sort (take l half) gt?)
(merge-sort '(1 3 5 7 9 8 6 4 2) >)

(merge-sort (list-tail l half) gt?)))))
=={{header|Seed7}}==
<syntaxhighlight lang="seed7">const proc: mergeSort2 (inout array elemType: arr, in integer: lo, in integer: hi, inout array elemType: scratch) is func
local
var integer: mid is 0;
var integer: k is 0;
var integer: t_lo is 0;
var integer: t_hi is 0;
begin
if lo < hi then
mid := (lo + hi) div 2;
mergeSort2(arr, lo, mid, scratch);
mergeSort2(arr, succ(mid), hi, scratch);
t_lo := lo;
t_hi := succ(mid);
for k range lo to hi do
if t_lo <= mid and (t_hi > hi or arr[t_lo] <= arr[t_hi]) then
scratch[k] := arr[t_lo];
incr(t_lo);
else
scratch[k] := arr[t_hi];
incr(t_hi);
end if;
end for;
for k range lo to hi do
arr[k] := scratch[k];
end for;
end if;
end func;

const proc: mergeSort2 (inout array elemType: arr) is func
local
var array elemType: scratch is 0 times elemType.value;
begin
scratch := length(arr) times elemType.value;
mergeSort2(arr, 1, length(arr), scratch);
end func;</syntaxhighlight>
Original source: [http://seed7.sourceforge.net/algorith/sorting.htm#mergeSort2]

=={{header|SETL}}==
<syntaxhighlight lang="setl">program merge_sort;
test := [-8, 241, 9, 316, -6, 3, 413, 9, 10];
print(test, '=>', mergesort(test));

proc mergesort(m);
if #m <= 1 then
return m;
end if;

middle := #m div 2;
left := mergesort(m(..middle));
right := mergesort(m(middle+1..));
if left(#left) <= right(1) then
return left + right;
end if;
return merge(left, right);
end proc;

proc merge(left, right);
result := [];
loop while left /= [] and right /= [] do
if left(1) <= right(1) then
item fromb left;
else
item fromb right;
end if;
result with:= item;
end loop;
return result + left + right;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>[-8 241 9 316 -6 3 413 9 10] => [-8 -6 3 9 9 10 241 316 413]</pre>

=={{header|Sidef}}==
<syntaxhighlight lang="ruby">func merge(left, right) {
var result = []
while (left && right) {
result << [right,left].min_by{.first}.shift
}
result + left + right
}
 
func mergesort(array) {
var len = array.len
len < 2 && return array
 
var (left, right) = array.part(len//2)
 
left = __FUNC__(left)
right = __FUNC__(right)
 
merge(left, right)
}
 
# Numeric sort
var nums = rand(1..100, 10)
say mergesort(nums)
 
# String sort
var strings = rand('a'..'z', 10)
say mergesort(strings)</syntaxhighlight>

=={{header|Standard ML}}==
<syntaxhighlight lang="sml">fun merge cmp ([], ys) = ys
| merge cmp (xs, []) = xs
| merge cmp (xs as x::xs', ys as y::ys') =
case cmp (x, y) of
GREATER => y :: merge cmp (xs, ys')
| _ => x :: merge cmp (xs', ys)

fun merge_sort cmp [] = []
| merge_sort cmp [x] = [x]
| merge_sort cmp xs = let
val ys = List.take (xs, length xs div 2)
val zs = List.drop (xs, length xs div 2)
in
merge cmp (merge_sort cmp ys, merge_sort cmp zs)
end</syntaxhighlight>
{{out|Poly/ML}}
<pre>
> merge_sort Int.compare [8,6,4,2,1,3,5,7,9];
val it = [1, 2, 3, 4, 5, 6, 7, 8, 9]: int list
> merge_sort String.compare ["Plum", "Pear", "Peach", "Each"];
val it = ["Each", "Peach", "Pear", "Plum"]: string list
>
</syntaxhighlight>

=={{header|Swift}}==
<syntaxhighlight lang="swift">// Merge Sort in Swift 4.2
// Source: https://github.com/raywenderlich/swift-algorithm-club/tree/master/Merge%20Sort
// NOTE: by use of generics you can make it sort arrays of any type that conforms to
// Comparable protocol, however this is not always optimal

import Foundation

func mergeSort(_ array: [Int]) -> [Int] {
guard array.count > 1 else { return array }

let middleIndex = array.count / 2

let leftPart = mergeSort(Array(array[0..<middleIndex]))
let rightPart = mergeSort(Array(array[middleIndex..<array.count]))

func merge(left: [Int], right: [Int]) -> [Int] {
var leftIndex = 0
var rightIndex = 0
var merged = [Int]()
merged.reserveCapacity(left.count + right.count)
while leftIndex < left.count && rightIndex < right.count {
if left[leftIndex] < right[rightIndex] {
merged.append(left[leftIndex])
leftIndex += 1
} else if left[leftIndex] > right[rightIndex] {
merged.append(right[rightIndex])
rightIndex += 1
} else {
merged.append(left[leftIndex])
leftIndex += 1
merged.append(right[rightIndex])
rightIndex += 1
}
}
while leftIndex < left.count {
merged.append(left[leftIndex])
leftIndex += 1
}
while rightIndex < right.count {
merged.append(right[rightIndex])
rightIndex += 1
}
return merged
}

return merge(left: leftPart, right: rightPart)
}</syntaxhighlight>

=={{header|Tailspin}}==
The standard recursive merge sort
<syntaxhighlight lang="tailspin">
templates mergesort
templates merge
@: $(2);
[ $(1)... -> #, $@...] !

when <?($@ <[](0)>)
| ..$@(1)> do
$ !
otherwise
^@(1) !
$ -> #
end merge
$ -> #

when <[](0..1)> do $!
otherwise
def half: $::length ~/ 2;
[$(1..$half) -> mergesort, $($half+1..last) -> mergesort] -> merge !
end mergesort

[4,5,3,8,1,2,6,7,9,8,5] -> mergesort -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
[1, 2, 3, 4, 5, 5, 6, 7, 8, 8, 9]
</pre>

A little different spin where the array is first split into a list of single-element lists and then merged.
<syntaxhighlight lang="tailspin">
templates mergesort
templates merge
@: $(2);
$(1)... -> \(
when <?($@merge<[](0)>)
| ..$@merge(1)> do
$ !
otherwise
^@merge(1) !
$ -> #
\) !
$@... !
end merge

templates mergePairs
when <[](1)> do
$(1) !
when <[](2..)> do
[$(1..2) -> merge] !
$(3..last) -> #
end mergePairs

templates mergeAll
when <[](0)> do
$ !
when <[](1)> do
$(1) !
otherwise
[ $ -> mergePairs ] -> #
end mergeAll

$ -> [ $... -> [ $ ] ] -> mergeAll !
end mergesort

[4,5,3,8,1,2,6,7,9,8,5] -> mergesort -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
[1, 2, 3, 4, 5, 5, 6, 7, 8, 8, 9]
</pre>

=={{header|Tcl}}==
<syntaxhighlight lang="tcl">package require Tcl 8.5

proc mergesort m {
set len [llength $m]
if {$len <= 1} {
return $m
}
set middle [expr {$len / 2}]
set left [lrange $m 0 [expr {$middle - 1}]]
set right [lrange $m $middle end]
return [merge [mergesort $left] [mergesort $right]]
}

proc merge {left right} {
set result [list]
while {[set lleft [llength $left]] > 0 && [set lright [llength $right]] > 0} {
if {[lindex $left 0] <= [lindex $right 0]} {
set left [lassign $left value]
} else {
set right [lassign $right value]
}
lappend result $value
}
if {$lleft > 0} {
lappend result {*}$left
}
if {$lright > 0} {
set result [concat $result $right] ;# another way append elements
}
return $result
}

puts [mergesort {8 6 4 2 1 3 5 7 9}] ;# => 1 2 3 4 5 6 7 8 9</syntaxhighlight>
Also note that Tcl's built-in <tt>lsort</tt> command uses the mergesort algorithm.


=={{header|Unison}}==
(merge-sort (list 1 3 5 7 9 8 6 4 2) >)
<syntaxhighlight lang="unison">mergeSortBy : (i ->{𝕖} i ->{𝕖} Boolean) ->{𝕖} [i] ->{𝕖} [i]
mergeSortBy cmp =
merge l1 l2 =
match (l1, l2) with
(xs, []) -> xs
([], ys) -> ys
(x +: xs, y +: ys) -> if cmp x y then x +: merge xs l2 else y +: merge l1 ys
([], []) -> []
cases
[] -> []
[x] -> [x]
lst ->
match halve lst with
(left, right) -> merge (mergeSortBy cmp left) (mergeSortBy cmp right)</syntaxhighlight>


=={{header|UnixPipes}}==
=={{header|UnixPipes}}==
{{works with|Zsh}}
{{works with|Zsh}}
<syntaxhighlight lang="bash">split() {
(while read a b ; do
echo $a > $1 ; echo $b > $2
done)
}


split() {
mergesort() {
(while read a b ; do
xargs -n 2 | (read a b; test -n "$b" && (
echo $a > $1 ; echo $b > $2
lc="1.$1" ; gc="2.$1"
(echo $a $b;cat)|split >(mergesort $lc >$lc) >( mergesort $gc >$gc)
done)
sort -m $lc $gc
}
rm -f $lc $gc;
) || echo $a)
}


cat to.sort | mergesort</syntaxhighlight>
mergesort() {
xargs -n 2 | (read a b; test -n "$b" && (
lc="1.$1" ; gc="2.$1"
(echo $a $b;cat)|split >(mergesort $lc >$lc) >( mergesort $gc >$gc)
sort -m $lc $gc
rm -f $lc $gc;
) || echo $a)
}


=={{header|Ursala}}==
<syntaxhighlight lang="ursala">#import std


mergesort "p" = @iNCS :-0 ~&B^?a\~&YaO "p"?abh/~&alh2faltPrXPRC ~&arh2falrtPXPRC
cat to.sort | mergesort

#show+

example = mergesort(lleq) <'zoh','zpb','hhh','egi','bff','cii','yid'></syntaxhighlight>
{{out}}
<pre>
bff
cii
egi
hhh
yid
zoh
zpb</pre>
The mergesort function could also have been defined using the built in sorting operator, -<, because the same algorithm is used.
<syntaxhighlight lang="ursala">mergesort "p" = "p"-<</syntaxhighlight>


=={{header|V}}==
=={{header|V}}==
merge uses the helper mergei to merge two lists. The mergei takes a stack of the form [mergedlist] [list1] [list2]
merge uses the helper mergei to merge two lists. The mergei takes a stack of the form [mergedlist] [list1] [list2]
it then extracts one element from list2, splits the list1 with it, joins the older merged list, first part of list1 and the element that was used for splitting (taken from list2) into the new merged list. the new list1 is the second part of the split on older list1. new list2 is the list remaining after the element e2 was extracted from it.
it then extracts one element from list2, splits the list1 with it, joins the older merged list, first part of list1 and the element that was used for splitting (taken from list2) into the new merged list. the new list1 is the second part of the split on older list1. new list2 is the list remaining after the element e2 was extracted from it.
<syntaxhighlight lang="v">[merge
[mergei
uncons [swap [>] split] dip
[[*m] e2 [*a1] b1 a2 : [*m *a1 e2] b1 a2] view].
[a b : [] a b] view
[size zero?] [pop concat]
[mergei]
tailrec].


[msort
[merge
[splitat [arr a : [arr a take arr a drop]] view i].
[mergei
[splitarr dup size 2 / >int splitat].
uncons [swap [>] split] dip

[[*m] e2 [*a1] b1 a2 : [*m *a1 e2] b1 a2] view].
[small?] []
[a b : [] a b] view
[splitarr]
[size zero?] [pop concat]
[merge]
binrec].</syntaxhighlight>
[mergei]

tailrec].
[8 7 6 5 4 2 1 3 9] msort puts

=={{header|V (Vlang)}}==
<syntaxhighlight lang="v (vlang)">fn main() {
mut a := [170, 45, 75, -90, -802, 24, 2, 66]
println("before: $a")
a = merge_sort(a)
println("after: $a")
}
fn merge_sort(m []int) []int {
[msort
if m.len <= 1{
[splitat [arr a : [arr a take arr a drop]] view i].
[splitarr dup size 2 / >int splitat].
return m
} else {
mid := m.len / 2
mut left := merge_sort(m[..mid])
mut right := merge_sort(m[mid..])
if m[mid-1] <= m[mid] {
left << right
return left
}
return merge(mut left, mut right)
}
}

fn merge(mut left []int,mut right []int) []int {
mut result := []int{}
for left.len > 0 && right.len > 0 {
if left[0] <= right[0]{
result << left[0]
left = left[1..]
} else {
result << right[0]
right = right[1..]
}
}
if left.len > 0 {
result << left
}
if right.len > 0 {
result << right
}
return result
}</syntaxhighlight>

=={{header|Wren}}==
<syntaxhighlight lang="wren">var merge = Fn.new { |left, right|
var result = []
while (left.count > 0 && right.count > 0) {
if (left[0] <= right[0]) {
result.add(left[0])
left = left[1..-1]
} else {
result.add(right[0])
right = right[1..-1]
}
}
if (left.count > 0) result.addAll(left)
if (right.count > 0) result.addAll(right)
return result
}

var mergeSort // recursive
mergeSort = Fn.new { |m|
var len = m.count
if (len <= 1) return m
var middle = (len/2).floor
var left = m[0...middle]
var right = m[middle..-1]
left = mergeSort.call(left)
right = mergeSort.call(right)
if (left[-1] <= right[0]) {
left.addAll(right)
return left
}
return merge.call(left, right)
}

var array = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in array) {
System.print("Before: %(a)")
a = mergeSort.call(a)
System.print("After : %(a)")
System.print()
}</syntaxhighlight>

{{out}}
<pre>
Before: [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]
After : [-31, 0, 1, 2, 2, 4, 65, 83, 99, 782]

Before: [7, 5, 2, 6, 1, 4, 2, 6, 3]
After : [1, 2, 2, 3, 4, 5, 6, 6, 7]
</pre>
<br>
Alternatively we can just call a library method.
{{libheader|Wren-sort}}
<syntaxhighlight lang="wren">import "./sort" for Sort

var array = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in array) {
System.print("Before: %(a)")
a = Sort.merge(a)
System.print("After : %(a)")
System.print()
}</syntaxhighlight>

{{out}}
<pre>
As above.
</pre>

=={{header|XPL0}}==
This is based on an example in "Fundamentals of Computer Algorithms" by
Horowitz & Sahni.
<syntaxhighlight lang="xpl0">code Reserve=3, ChOut=8, IntOut=11;

proc MergeSort(A, Low, High); \Sort array A from Low to High
int A, Low, High;
int B, Mid, H, I, J, K;
[if Low >= High then return;
Mid:= (Low+High) >> 1; \split array in half (roughly)
MergeSort(A, Low, Mid); \sort left half
MergeSort(A, Mid+1, High); \sort right half
\Merge the two halves in to sorted order
B:= Reserve((High-Low+1)*4); \reserve space for working array (4 bytes/int)
H:= Low; I:= Low; J:= Mid+1;
while H<=Mid & J<=High do \merge while both halves have items
if A(H) <= A(J) then [B(I):= A(H); I:= I+1; H:= H+1]
else [B(I):= A(J); I:= I+1; J:= J+1];
if H > Mid then \copy any remaining elements
for K:= J to High do [B(I):= A(K); I:= I+1]
else for K:= H to Mid do [B(I):= A(K); I:= I+1];
for K:= Low to High do A(K):= B(K);
];

int A, I;
[A:= [3, 1, 4, 1, -5, 9, 2, 6, 5, 4];
MergeSort(A, 0, 10-1);
for I:= 0 to 10-1 do [IntOut(0, A(I)); ChOut(0, ^ )];
]</syntaxhighlight>

{{out}}
<pre>
-5 1 1 2 3 4 4 5 6 9
</pre>

{{omit from|GUISS}}


=={{header|Yabasic}}==
{{trans|FreeBASIC}}
<syntaxhighlight lang="yabasic">
dim b(9)

sub copyArray(a(), inicio, final, b())
dim b(final - 1)
for k = inicio to final - 1
b(k) = a(k)
next
end sub

// La mitad izquierda es a(inicio to mitad-1).
// La mitad derecha es a(mitad to final-1).
// El resultado es b(inicio to final-1).
sub topDownMerge(a(), inicio, mitad, final, b())
i = inicio
j = mitad
// Si bien hay elementos en los recorridos izquierdo o derecho ...
for k = inicio to final - 1
// Si existe un inicio de recorrido izquierdo y es <= inicio de recorrido derecho existente.
if (i < mitad) and (j >= final or a(i) <= a(j)) then
b(k) = a(i)
i = i + 1
else
b(k) = a(j)
j = j + 1
end if
next
end sub

// Ordenar la matriz a() usando la matriz b() como fuente.
// inicio es inclusivo; final es exclusivo (a(final) no está en el conjunto).
sub topDownSplitMerge(b(), inicio, final, a())
if (final - inicio) < 2 then return : fi // Si la diferencia = 1, considérelo ordenado
// dividir la ejecución de más de 1 elemento en mitades
mitad = int((final + inicio) / 2) // mitad = punto medio
// recursively sort both runs from array a() into b()
topDownSplitMerge(a(), inicio, mitad, b()) // ordenar la parte izquierda
topDownSplitMerge(a(), mitad, final, b()) // ordenar la parte derecha
// fusionar las ejecuciones resultantes de la matriz b() en a()
topDownMerge(b(), inicio, mitad, final, a())
end sub

// El array a() tiene los elementos para ordenar; array b() es una matriz de trabajo (inicialmente vacía).
sub topDownMergeSort(a(), b(), n)
copyArray(a(), 0, n, b()) // duplicar la matriz a() en b()
topDownSplitMerge(b(), 0, n, a()) // ordenar los datos de b() en a()
end sub

sub printArray(a())
for i = 1 to arraysize(a(),1)
print a(i) using "####";
next
print
end sub


//--------------------------
label a1
data 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
label a2
data 7, 5, 2, 6, 1, 4, 2, 6, 3

dim a(9)
restore a1
for i = 0 to 9
read p
a(i) = p
next i
dim a2(8)
[small?] []
restore a2
[splitarr]
[merge]
for i = 0 to 8
binrec].
read p
a2(i) = p
next i


print "unsort ";
[8 7 6 5 4 2 1 3 9] msort puts
printArray(a())
topDownMergeSort (a(), b(), 10)
print " sort ";
printArray(a())
print
print "unsort ";
printArray(a2())
topDownMergeSort (a2(), b(), 9)
print " sort ";
printArray(a2())
end
</syntaxhighlight>


=={{header|ZED}}==
Source -> http://ideone.com/uZEPL4
Compiled -> http://ideone.com/SJ5EGu

This is a bottom up version of merge sort:
<syntaxhighlight lang="zed">(append) list1 list2
comment:
#true
(003) "append" list1 list2

(car) pair
comment:
#true
(002) "car" pair

(cdr) pair
comment:
#true
(002) "cdr" pair

(cons) one two
comment:
#true
(003) "cons" one two

(map) function list
comment:
#true
(003) "map" function list

(merge) comparator list1 list2
comment:
#true
(merge1) comparator list1 list2 nil

(merge1) comparator list1 list2 collect
comment:
(null?) list2
(append) (reverse) collect list1

(merge1) comparator list1 list2 collect
comment:
(null?) list1
(append) (reverse) collect list2

(merge1) comparator list1 list2 collect
comment:
(003) comparator (car) list2 (car) list1
(merge1) comparator list1 (cdr) list2 (cons) (car) list2 collect

(merge1) comparator list1 list2 collect
comment:
#true
(merge1) comparator (cdr) list1 list2 (cons) (car) list1 collect

(null?) value
comment:
#true
(002) "null?" value

(reverse) list
comment:
#true
(002) "reverse" list

(sort) comparator jumble
comment:
#true
(car) (sort11) comparator (sort1) jumble

(sort1) jumble
comment:
#true
(map) "list" jumble

(sort11) comparator jumble
comment:
(null?) jumble
nil

(sort11) comparator jumble
comment:
(null?) (cdr) jumble
jumble

(sort11) comparator jumble
comment:
#true
(sort11) comparator
(cons) (merge) comparator (car) jumble (002) "cadr" jumble
(sort11) comparator (002) "cddr" jumble</syntaxhighlight>

=={{header|zkl}}==
Pretty wasteful memory wise, probably not suitable for large sorts.
{{trans|Clojure}}
<syntaxhighlight lang="zkl">fcn _merge(left,right){
if (not left) return(right);
if (not right) return(left);
l:=left[0]; r:=right[0];
if (l<=r) return(L(l).extend(self.fcn(left[1,*],right)));
else return(L(r).extend(self.fcn(left,right[1,*])));
}

fcn merge_sort(L){
if (L.len()<2) return(L);
n:=L.len()/2;
return(_merge(self.fcn(L[0,n]), self.fcn(L[n,*])));
}</syntaxhighlight>
<syntaxhighlight lang="zkl">merge_sort(T(1,3,5,7,9,8,6,4,2)).println();
merge_sort("big fjords vex quick waltz nymph").concat().println();</syntaxhighlight>
{{out}}
<pre>
L(1,2,3,4,5,6,7,8,9)
abcdefghiijklmnopqrstuvwxyz
</pre>
Or, for lists only:
<syntaxhighlight lang="zkl">fcn mergeSort(L){
if (L.len()<2) return(L.copy());
n:=L.len()/2;
self.fcn(L[0,n]).merge(self.fcn(L[n,*]));
}</syntaxhighlight>
<syntaxhighlight lang="zkl">mergeSort(T(1,3,5,7,9,8,6,4,2)).println();
mergeSort("big fjords vex quick waltz nymph".split("")).concat().println();</syntaxhighlight>
{{out}}
<pre>
L(1,2,3,4,5,6,7,8,9)
abcdefghiijklmnopqrstuvwxyz
</pre>

Latest revision as of 18:46, 21 April 2024

Task
Sorting algorithms/Merge sort
You are encouraged to solve this task according to the task description, using any language you may know.

Sorting Algorithm
This is a sorting algorithm.   It may be applied to a set of data in order to sort it.     For comparing various sorts, see compare sorts.   For other sorting algorithms,   see sorting algorithms,   or:

O(n logn) sorts

Heap sort | Merge sort | Patience sort | Quick sort

O(n log2n) sorts
Shell Sort

O(n2) sorts
Bubble sort | Cocktail sort | Cocktail sort with shifting bounds | Comb sort | Cycle sort | Gnome sort | Insertion sort | Selection sort | Strand sort

other sorts
Bead sort | Bogo sort | Common sorted list | Composite structures sort | Custom comparator sort | Counting sort | Disjoint sublist sort | External sort | Jort sort | Lexicographical sort | Natural sorting | Order by pair comparisons | Order disjoint list items | Order two numerical lists | Object identifier (OID) sort | Pancake sort | Quickselect | Permutation sort | Radix sort | Ranking methods | Remove duplicate elements | Sleep sort | Stooge sort | [Sort letters of a string] | Three variable sort | Topological sort | Tree sort

The   merge sort   is a recursive sort of order   n*log(n).

It is notable for having a worst case and average complexity of   O(n*log(n)),   and a best case complexity of   O(n)   (for pre-sorted input).

The basic idea is to split the collection into smaller groups by halving it until the groups only have one element or no elements   (which are both entirely sorted groups).

Then merge the groups back together so that their elements are in order.

This is how the algorithm gets its   divide and conquer   description.


Task

Write a function to sort a collection of integers using the merge sort.


The merge sort algorithm comes in two parts: 

   a sort function     and 
   a merge function

The functions in pseudocode look like this: 

function mergesort(m)
   var list left, right, result
   if length(m) ≤ 1
       return m
   else
       var middle = length(m) / 2
       for each x in m up to middle - 1
           add x to left
       for each x in m at and after middle
           add x to right
       left = mergesort(left)
       right = mergesort(right)
       if last(left) ≤ first(right) 
          append right to left
          return left
       result = merge(left, right)
       return result

function merge(left,right)
   var list result
   while length(left) > 0 and length(right) > 0
       if first(left) ≤ first(right)
           append first(left) to result
           left = rest(left)
       else
           append first(right) to result
           right = rest(right)
   if length(left) > 0 
       append rest(left) to result
   if length(right) > 0 
       append rest(right) to result
   return result


See also


Note:   better performance can be expected if, rather than recursing until   length(m) ≤ 1,   an insertion sort is used for   length(m)   smaller than some threshold larger than   1.   However, this complicates the example code, so it is not shown here.

11l

Translation of: Python
F merge(left, right)
   [Int] result
   V left_idx = 0
   V right_idx = 0
   L left_idx < left.len & right_idx < right.len
      I left[left_idx] <= right[right_idx]
         result.append(left[left_idx])
         left_idx++
      E
         result.append(right[right_idx])
         right_idx++

   I left_idx < left.len
      result.extend(left[left_idx ..])
   I right_idx < right.len
      result.extend(right[right_idx ..])
   R result

F merge_sort(m)
   I m.len <= 1
      R m

   V middle = m.len I/ 2
   V left = m[0.<middle]
   V right = m[middle..]

   left = merge_sort(left)
   right = merge_sort(right)
   R Array(merge(left, right))

V arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
print(merge_sort(arr))
Output:
[0, 1, 2, 3, 4, 5, 6, 7, 8, 9]

360 Assembly

Translation of: BBC BASIC

The program uses ASM structured macros and two ASSIST macros (XDECO, XPRNT) to keep the code as short as possible. 

*      Merge sort                  19/06/2016
MAIN   CSECT
       STM     R14,R12,12(R13)     save caller's registers
       LR      R12,R15             set R12 as base register
       USING   MAIN,R12            notify assembler
       LA      R11,SAVEXA          get the address of my savearea
       ST      R13,4(R11)          save caller's save area pointer
       ST      R11,8(R13)          save my save area pointer
       LR      R13,R11             set R13 to point to my save area
       LA      R1,1                1
       LA      R2,NN               hbound(a)
       BAL     R14,SPLIT           call split(1,hbound(a))
       LA      RPGI,PG             pgi=0
       LA      RI,1                i=1
       DO WHILE=(C,RI,LE,=A(NN))   do i=1 to hbound(a)
         LR    R1,RI                 i
         SLA   R1,2                  .
         L     R2,A-4(R1)            a(i)
         XDECO R2,XDEC               edit a(i)
         MVC   0(4,RPGI),XDEC+8      output a(i) 
         LA    RPGI,4(RPGI)          pgi=pgi+4
         LA    RI,1(RI)              i=i+1
       ENDDO   ,                   end do
       XPRNT   PG,80               print buffer
       L       R13,SAVEXA+4        restore caller's savearea address
       LM      R14,R12,12(R13)     restore caller's registers
       XR      R15,R15             set return code to 0
       BR      R14                 return to caller
*      split(istart,iend)          ------recursive---------------------
SPLIT  STM     R14,R12,12(R13)     save all registers
       LR      R9,R1               save R1
       LA      R1,72               amount of storage required
       GETMAIN RU,LV=(R1)          allocate storage for stack
       USING   STACK,R10           make storage addressable
       LR      R10,R1              establish stack addressability
       LA      R11,SAVEXB          get the address of my savearea
       ST      R13,4(R11)          save caller's save area pointer
       ST      R11,8(R13)          save my save area pointer
       LR      R13,R11             set R13 to point to my save area
       LR      R1,R9               restore R1
       LR      RSTART,R1           istart=R1
       LR      REND,R2             iend=R2
       IF CR,REND,EQ,RSTART THEN   if iend=istart
         B     RETURN                return
       ENDIF   ,                   end if
       BCTR    R2,0                iend-1
       IF C,R2,EQ,RSTART THEN      if iend-istart=1
         LR    R1,REND               iend
         SLA   R1,2                  .
         L     R2,A-4(R1)            a(iend)
         LR    R1,RSTART             istart
         SLA   R1,2                  .
         L     R3,A-4(R1)            a(istart)
         IF CR,R2,LT,R3 THEN         if a(iend)<a(istart)
           LR  R1,RSTART               istart
           SLA R1,2                    .
           LA  R2,A-4(R1)              @a(istart)
           LR  R1,REND                 iend
           SLA R1,2                    .
           LA  R3,A-4(R1)              @a(iend)
           MVC TEMP,0(R2)              temp=a(istart)
           MVC 0(4,R2),0(R3)           a(istart)=a(iend)
           MVC 0(4,R3),TEMP            a(iend)=temp
         ENDIF ,                     end if
         B     RETURN                return
       ENDIF   ,                   end if 
       LR      RMIDDL,REND         iend
       SR      RMIDDL,RSTART       iend-istart
       SRA     RMIDDL,1            (iend-istart)/2
       AR      RMIDDL,RSTART       imiddl=istart+(iend-istart)/2
       LR      R1,RSTART           istart
       LR      R2,RMIDDL           imiddl
       BAL     R14,SPLIT           call split(istart,imiddl)
       LA      R1,1(RMIDDL)        imiddl+1
       LR      R2,REND             iend
       BAL     R14,SPLIT           call split(imiddl+1,iend)
       LR      R1,RSTART           istart
       LR      R2,RMIDDL           imiddl
       LR      R3,REND             iend
       BAL     R14,MERGE           call merge(istart,imiddl,iend)
RETURN L       R13,SAVEXB+4        restore caller's savearea address
       XR      R15,R15             set return code to 0        
       LA      R0,72               amount of storage to free
       FREEMAIN A=(R10),LV=(R0)    free allocated storage
       L       R14,12(R13)         restore caller's return address
       LM      R2,R12,28(R13)      restore registers R2 to R12
       BR      R14                 return to caller
       DROP    R10                 base no longer needed
*      merge(jstart,jmiddl,jend)   ------------------------------------
MERGE  STM     R1,R3,JSTART        jstart=r1,jmiddl=r2,jend=r3
       SR      R2,R1               jmiddl-jstart
       LA      RBS,2(R2)           bs=jmiddl-jstart+2
       LA      RI,1                i=1
       LR      R3,RBS              bs
       BCTR    R3,0                bs-1
       DO WHILE=(CR,RI,LE,R3)      do i=0 to bs-1
         L     R2,JSTART             jstart
         AR    R2,RI                 jstart+i
         SLA   R2,2                  .
         L     R2,A-8(R2)            a(jstart+i-1)
         LR    R1,RI                 i
         SLA   R1,2                  .
         ST    R2,B-4(R1)            b(i)=a(jstart+i-1)
         LA    RI,1(RI)              i=i+1
       ENDDO   ,                   end do
       LA      RI,1                i=1
       L       RJ,JMIDDL           j=jmiddl
       LA      RJ,1(RJ)            j=jmiddl+1
       L       RK,JSTART           k=jstart
       DO UNTIL=(CR,RI,EQ,RBS,OR,  do until i=bs or                    X
               C,RJ,GT,JEND)                j>jend  
         LR    R1,RI                 i
         SLA   R1,2                  .
         L     R4,B-4(R1)            r4=b(i)
         LR    R1,RJ                 j
         SLA   R1,2                  .
         L     R3,A-4(R1)            r3=a(j)
         LR    R9,RK                 k
         SLA   R9,2                  r9 for a(k)
         IF CR,R4,LE,R3 THEN         if b(i)<=a(j)
           ST  R4,A-4(R9)              a(k)=b(i)
           LA  RI,1(RI)                i=i+1 
         ELSE  ,                     else
           ST  R3,A-4(R9)              a(k)=a(j)
           LA  RJ,1(RJ)                j=j+1
         ENDIF ,                     end if
         LA    RK,1(RK)              k=k+1
       ENDDO   ,                   end do  
       DO WHILE=(CR,RI,LT,RBS)     do while i<bs 
         LR    R1,RI                 i
         SLA   R1,2                  .
         L     R2,B-4(R1)            b(i)
         LR    R1,RK                 k
         SLA   R1,2                  .
         ST    R2,A-4(R1)            a(k)=b(i)
         LA    RI,1(RI)              i=i+1
         LA    RK,1(RK)              k=k+1
       ENDDO   ,                   end do
       BR      R14                 return to caller
*      ------- ------------------  ------------------------------------
       LTORG   
SAVEXA DS      18F                 savearea of main
NN     EQU     ((B-A)/L'A)         number of items
A      DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1'
       DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74'
B      DS      (NN/2+1)F           merge sort static storage
TEMP   DS      F                   for swap
JSTART DS      F                   jstart 
JMIDDL DS      F                   jmiddl
JEND   DS      F                   jend
PG     DC      CL80' '             buffer
XDEC   DS      CL12                for edit
STACK  DSECT                       dynamic area
SAVEXB DS      18F                 " savearea of mergsort (72 bytes)
       YREGS
RI     EQU     6                   i
RJ     EQU     7                   j
RK     EQU     8                   k
RSTART EQU     6                   istart
REND   EQU     7                   i
RMIDDL EQU     8                   i
RPGI   EQU     3                   pgi
RBS    EQU     0                   bs
       END     MAIN
Output:
 -31   0   1   2   2   4  45  58  65  69  74  82  82  83  88  89  99 104 112 782

AArch64 Assembly

Works with: as version Raspberry Pi 3B version Buster 64 bits
/* ARM assembly AARCH64 Raspberry PI 3B */
/*  program mergeSort64.s  */
 
/*******************************************/
/* Constantes file                         */
/*******************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeConstantesARM64.inc"

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessSortOk:       .asciz "Table sorted.\n"
szMessSortNok:      .asciz "Table not sorted !!!!!.\n"
sMessResult:        .asciz "Value  : @ \n"
szCarriageReturn:   .asciz "\n"
 
.align 4
TableNumber:      .quad   1,3,11,6,2,5,9,10,8,4,7
#TableNumber:     .quad   10,9,8,7,6,-5,4,3,2,1
                 .equ NBELEMENTS, (. - TableNumber) / 8 
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:       .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main 
main:                                              // entry of program 
    ldr x0,qAdrTableNumber                         // address number table
    mov x1,0                                       // first element
    mov x2,NBELEMENTS                              // number of élements 
    bl mergeSort
    ldr x0,qAdrTableNumber                         // address number table
    bl displayTable
 
    ldr x0,qAdrTableNumber                         // address number table
    mov x1,NBELEMENTS                              // number of élements 
    bl isSorted                                    // control sort
    cmp x0,1                                       // sorted ?
    beq 1f                                    
    ldr x0,qAdrszMessSortNok                       // no !! error sort
    bl affichageMess
    b 100f
1:                                                 // yes
    ldr x0,qAdrszMessSortOk
    bl affichageMess
100:                                               // standard end of the program 
    mov x0,0                                       // return code
    mov x8,EXIT                                    // request to exit program
    svc 0                                          // perform the system call
 
qAdrsZoneConv:            .quad sZoneConv
qAdrszCarriageReturn:     .quad szCarriageReturn
qAdrsMessResult:          .quad sMessResult
qAdrTableNumber:          .quad TableNumber
qAdrszMessSortOk:         .quad szMessSortOk
qAdrszMessSortNok:        .quad szMessSortNok
/******************************************************************/
/*     control sorted table                                   */ 
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the number of elements  > 0  */
/* x0 return 0  if not sorted   1  if sorted */
isSorted:
    stp x2,lr,[sp,-16]!             // save  registers
    stp x3,x4,[sp,-16]!             // save  registers
    mov x2,0
    ldr x4,[x0,x2,lsl 3]
1:
    add x2,x2,1
    cmp x2,x1
    bge 99f
    ldr x3,[x0,x2, lsl 3]
    cmp x3,x4
    blt 98f
    mov x4,x3
    b 1b
98:
    mov x0,0                       // not sorted
    b 100f
99:
    mov x0,1                       // sorted
100:
    ldp x3,x4,[sp],16              // restaur  2 registers
    ldp x2,lr,[sp],16              // restaur  2 registers
    ret                            // return to address lr x30
/******************************************************************/
/*         merge                                              */ 
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains second start index */
/* r3 contains the last index   */ 
merge:
    stp x1,lr,[sp,-16]!        // save  registers
    stp x2,x3,[sp,-16]!        // save  registers
    stp x4,x5,[sp,-16]!        // save  registers
    stp x6,x7,[sp,-16]!        // save  registers
    str x8,[sp,-16]!
    mov x5,x2                  // init index x2->x5 
1:                             // begin loop first section
    ldr x6,[x0,x1,lsl 3]       // load value first section index r1
    ldr x7,[x0,x5,lsl 3]       // load value second section index r5
    cmp x6,x7
    ble 4f                     // <=  -> location first section OK
    str x7,[x0,x1,lsl 3]       // store value second section in first section
    add x8,x5,1
    cmp x8,x3                  // end second section ?
    ble 2f
    str x6,[x0,x5,lsl 3]
    b 4f                       // loop
2:                             // loop insert element part 1 into part 2
    sub x4,x8,1
    ldr x7,[x0,x8,lsl 3]       // load value 2
    cmp x6,x7                  // value < 
    bge 3f
    str x6,[x0,x4,lsl 3]       // store value 
    b 4f                       // loop
3:
    str x7,[x0,x4,lsl 3]       // store value 2
    add x8,x8,1
    cmp x8,x3                  // end second section ?
    ble 2b                     // no loop 
    sub x8,x8,1
    str x6,[x0,x8,lsl 3]       // store value 1
4:
    add x1,x1,1
    cmp x1,x2                  // end first section ?
    blt 1b

100:
    ldr x8,[sp],16             // restaur 1 register
    ldp x6,x7,[sp],16          // restaur  2 registers
    ldp x4,x5,[sp],16          // restaur  2 registers
    ldp x2,x3,[sp],16          // restaur  2 registers
    ldp x1,lr,[sp],16          // restaur  2 registers
    ret                        // return to address lr x30
/******************************************************************/
/*      merge sort                                                */ 
/******************************************************************/
/* x0 contains the address of table */
/* x1 contains the index of first element */
/* x2 contains the number of element */
mergeSort:
    stp x3,lr,[sp,-16]!    // save  registers
    stp x4,x5,[sp,-16]!    // save  registers
    stp x6,x7,[sp,-16]!    // save  registers
    cmp x2,2               // end ?
    blt 100f
    lsr x4,x2,1            // number of element of each subset
    add x5,x4,1
    tst x2,#1              // odd ?
    csel x4,x5,x4,ne
    mov x5,x1              // save first element
    mov x6,x2              // save number of element
    mov x7,x4              // save number of element of each subset
    mov x2,x4
    bl mergeSort
    mov x1,x7              // restaur number of element of each subset
    mov x2,x6              // restaur  number of element
    sub x2,x2,x1
    mov x3,x5              // restaur first element
    add x1,x1,x3              // + 1
    bl mergeSort           // sort first subset
    mov x1,x5              // restaur first element
    mov x2,x7              // restaur number of element of each subset
    add x2,x2,x1
    mov x3,x6              // restaur  number of element
    add x3,x3,x1 
    sub x3,x3,1              // last index
    bl merge
100:
    ldp x6,x7,[sp],16          // restaur  2 registers
    ldp x4,x5,[sp],16          // restaur  2 registers
    ldp x3,lr,[sp],16          // restaur  2 registers
    ret                        // return to address lr x30

/******************************************************************/
/*      Display table elements                                */ 
/******************************************************************/
/* x0 contains the address of table */
displayTable:
    stp x1,lr,[sp,-16]!              // save  registers
    stp x2,x3,[sp,-16]!              // save  registers
    mov x2,x0                        // table address
    mov x3,0
1:                                   // loop display table
    ldr x0,[x2,x3,lsl 3]
    ldr x1,qAdrsZoneConv
    bl conversion10S                  // décimal conversion
    ldr x0,qAdrsMessResult
    ldr x1,qAdrsZoneConv
    bl strInsertAtCharInc            // insert result at // character
    bl affichageMess                 // display message
    add x3,x3,1
    cmp x3,NBELEMENTS - 1
    ble 1b
    ldr x0,qAdrszCarriageReturn
    bl affichageMess
    mov x0,x2
100:
    ldp x2,x3,[sp],16               // restaur  2 registers
    ldp x1,lr,[sp],16               // restaur  2 registers
    ret                             // return to address lr x30
/********************************************************/
/*        File Include fonctions                        */
/********************************************************/
/* for this file see task include a file in language AArch64 assembly */
.include "../includeARM64.inc"

ACL2

(defun split (xys)
   (if (endp (rest xys))
       (mv xys nil)
       (mv-let (xs ys)
               (split (rest (rest xys)))
          (mv (cons (first xys) xs)
              (cons (second xys) ys)))))

(defun mrg (xs ys)
   (declare (xargs :measure (+ (len xs) (len ys))))
   (cond ((endp xs) ys)
         ((endp ys) xs)
         ((< (first xs) (first ys))
          (cons (first xs) (mrg (rest xs) ys)))
         (t (cons (first ys) (mrg xs (rest ys))))))

(defthm split-shortens
   (implies (consp (rest xs))
            (mv-let (ys zs)
                    (split xs)
               (and (< (len ys) (len xs))
                    (< (len zs) (len xs))))))

(defun msort (xs)
     (declare (xargs
            :measure (len xs)
            :hints (("Goal"
                     :use ((:instance split-shortens))))))
   (if (endp (rest xs))
       xs
       (mv-let (ys zs)
               (split xs)
          (mrg (msort ys)
               (msort zs)))))

Action!

Action! language does not support recursion. Therefore an iterative approach has been proposed. 

DEFINE MAX_COUNT="100"

PROC PrintArray(INT ARRAY a INT size)
  INT i

  Put('[)
  FOR i=0 TO size-1
  DO
    IF i>0 THEN Put(' ) FI
    PrintI(a(i))
  OD
  Put(']) PutE()
RETURN

PROC Merge(INT ARRAY a INT first,mid,last)
  INT ARRAY left(MAX_COUNT),right(MAX_COUNT)
  INT leftSize,rightSize,i,j,k
  
  leftSize=mid-first+1
  rightSize=last-mid
 
  FOR i=0 TO leftSize-1
  DO
    left(i)=a(first+i)
  OD
  FOR i=0 TO rightSize-1
  DO
    right(i)=a(mid+1+i)
  OD 
  i=0 j=0
  k=first
  WHILE i<leftSize AND j<rightSize
  DO
    IF left(i)<=right(j) THEN
      a(k)=left(i)
      i==+1
    ELSE
      a(k)=right(j)
      j==+1
    FI
    k==+1
  OD
 
  WHILE i<leftSize
  DO
    a(k)=left(i)
    i==+1 k==+1
  OD
 
  WHILE j<rightSize
  DO
    a(k)=right(j)
    j==+1 k==+1
  OD
RETURN

PROC MergeSort(INT ARRAY a INT size)
  INT currSize,first,mid,last

  currSize=1
  WHILE currSize<size
  DO
    first=0
    WHILE first<size-1
    DO
      mid=first+currSize-1
      IF mid>size-1 THEN
        mid=size-1
      FI
      last=first+2*currSize-1
      IF last>size-1 THEN
        last=size-1
      FI
      Merge(a,first,mid,last);

      first==+2*currSize
    OD
    currSize==*2
  OD
RETURN

PROC Test(INT ARRAY a INT size)
  PrintE("Array before sort:")
  PrintArray(a,size)
  MergeSort(a,size)
  PrintE("Array after sort:")
  PrintArray(a,size)
  PutE()
RETURN

PROC Main()
  INT ARRAY
    a(10)=[1 4 65535 0 3 7 4 8 20 65530],
    b(21)=[10 9 8 7 6 5 4 3 2 1 0
      65535 65534 65533 65532 65531
      65530 65529 65528 65527 65526],
    c(8)=[101 102 103 104 105 106 107 108],
    d(12)=[1 65535 1 65535 1 65535 1
      65535 1 65535 1 65535]
  
  Test(a,10)
  Test(b,21)
  Test(c,8)
  Test(d,12)
RETURN
Output:

Screenshot from Atari 8-bit computer 

Array before sort:
[1 4 -1 0 3 7 4 8 20 -6]
Array after sort:
[-6 -1 0 1 3 4 4 7 8 20]

Array before sort:
[10 9 8 7 6 5 4 3 2 1 0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10]
Array after sort:
[-10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 8 9 10]

Array before sort:
[101 102 103 104 105 106 107 108]
Array after sort:
[101 102 103 104 105 106 107 108]

Array before sort:
[1 -1 1 -1 1 -1 1 -1 1 -1 1 -1]
Array after sort:
[-1 -1 -1 -1 -1 -1 1 1 1 1 1 1]

ActionScript

function mergesort(a:Array)
{
	//Arrays of length 1 and 0 are always sorted
	if(a.length <= 1) return a;
	else
	{
		var middle:uint = a.length/2;
		//split the array into two
		var left:Array = new Array(middle);
		var right:Array = new Array(a.length-middle);
		var j:uint = 0, k:uint = 0;
		//fill the left array
		for(var i:uint = 0; i < middle; i++)
			left[j++]=a[i];
		//fill the right array
		for(i = middle; i< a.length; i++)
			right[k++]=a[i];
		//sort the arrays
		left = mergesort(left);
		right = mergesort(right);
		//If the last element of the left array is less than or equal to the first
		//element of the right array, they are in order and don't need to be merged
		if(left[left.length-1] <= right[0])
			return left.concat(right);
		a = merge(left, right);
		return a;
	}
}

function merge(left:Array, right:Array)
{
	var result:Array = new Array(left.length + right.length);
	var j:uint = 0, k:uint = 0, m:uint = 0;
	//merge the arrays in order
	while(j < left.length && k < right.length)
	{
		if(left[j] <= right[k])
			result[m++] = left[j++];
		else
			result[m++] = right[k++];
	}
	//If one of the arrays has remaining entries that haven't been merged, they
	//will be greater than the rest of the numbers merged so far, so put them on the
	//end of the array.
	for(; j < left.length; j++)
		result[m++] = left[j];
	for(; k < right.length; k++)
		result[m++] = right[k];
	return result;
}

Ada

This example creates a generic package for sorting arrays of any type. Ada allows array indices to be any discrete type, including enumerated types which are non-numeric. Furthermore, numeric array indices can start at any value, positive, negative, or zero. The following code handles all the possible variations in index types. 

generic
   type Element_Type is private;
   type Index_Type is (<>);
   type Collection_Type is array(Index_Type range <>) of Element_Type;
   with function "<"(Left, Right : Element_Type) return Boolean is <>;

package Mergesort is
   function Sort(Item : Collection_Type) return Collection_Type;
end MergeSort;

package body Mergesort is
   
   -----------
   -- Merge --
   -----------
   
   function Merge(Left, Right : Collection_Type) return Collection_Type is
      Result : Collection_Type(Left'First..Right'Last);
      Left_Index : Index_Type := Left'First;
      Right_Index : Index_Type := Right'First;
      Result_Index : Index_Type := Result'First;
   begin
      while Left_Index <= Left'Last and Right_Index <= Right'Last loop
         if Left(Left_Index) <= Right(Right_Index) then
            Result(Result_Index) := Left(Left_Index);
            Left_Index := Index_Type'Succ(Left_Index); -- increment Left_Index
         else
            Result(Result_Index) := Right(Right_Index);
            Right_Index := Index_Type'Succ(Right_Index); -- increment Right_Index
         end if;
         Result_Index := Index_Type'Succ(Result_Index); -- increment Result_Index
      end loop;
      if Left_Index <= Left'Last then
         Result(Result_Index..Result'Last) := Left(Left_Index..Left'Last);
      end if;
      if Right_Index <= Right'Last then
         Result(Result_Index..Result'Last) := Right(Right_Index..Right'Last);
      end if;
      return Result;
   end Merge;
   
   ----------
   -- Sort --
   ----------

   function Sort (Item : Collection_Type) return Collection_Type is
      Result : Collection_Type(Item'range);
      Middle : Index_Type;
   begin
      if Item'Length <= 1 then
         return Item;
      else
         Middle := Index_Type'Val((Item'Length / 2) + Index_Type'Pos(Item'First));
         declare
            Left : Collection_Type(Item'First..Index_Type'Pred(Middle));
            Right : Collection_Type(Middle..Item'Last);
         begin
            for I in Left'range loop
               Left(I) := Item(I);
            end loop;
            for I in Right'range loop
               Right(I) := Item(I);
            end loop;
            Left := Sort(Left);
            Right := Sort(Right);
            Result := Merge(Left, Right);
         end;
         return Result;
      end if;
   end Sort;

end Mergesort;

The following code provides an usage example for the generic package defined above. 

with Ada.Text_Io; use Ada.Text_Io;
with Mergesort; 

procedure Mergesort_Test is
   type List_Type is array(Positive range <>) of Integer;
   package List_Sort is new Mergesort(Integer, Positive, List_Type);
   procedure Print(Item : List_Type) is
   begin
      for I in Item'range loop
         Put(Integer'Image(Item(I)));
      end loop;
      New_Line;
   end Print;
   
   List : List_Type := (1, 5, 2, 7, 3, 9, 4, 6);
begin
   Print(List);
   Print(List_Sort.Sort(List));
end Mergesort_Test;
Output:
 1 5 2 7 3 9 4 6
 1 2 3 4 5 6 7 9

ALGOL 68

Translation of: python

Below are two variants of the same routine. If copying the DATA type to a different memory location is expensive, then the optimised version should be used as the DATA elements are handled indirectly. 

MODE DATA = CHAR;

PROC merge sort = ([]DATA m)[]DATA: (
    IF LWB m >= UPB m THEN
        m
    ELSE
        INT middle = ( UPB m + LWB m ) OVER 2;
        []DATA left = merge sort(m[:middle]);
        []DATA right = merge sort(m[middle+1:]);
        flex merge(left, right)[AT LWB m]
    FI
);

# FLEX version: A demonstration of FLEX for manipulating arrays #
PROC flex merge = ([]DATA in left, in right)[]DATA:(
    [UPB in left + UPB in right]DATA result;
    FLEX[0]DATA left := in left;
    FLEX[0]DATA right := in right;

    FOR index TO UPB result DO
        # change the direction of this comparison to change the direction of the sort #
        IF LWB right > UPB right THEN
            result[index:] := left; 
            stop iteration
        ELIF LWB left > UPB left THEN
            result[index:] := right;
            stop iteration
        ELIF left[1] <= right[1] THEN
            result[index] := left[1];
            left := left[2:]
        ELSE
            result[index] := right[1];
            right := right[2:]
        FI
    OD;
stop iteration:
    result
);

[32]CHAR char array data := "big fjords vex quick waltz nymph";
print((merge sort(char array data), new line));
Output:
     abcdefghiijklmnopqrstuvwxyz

Optimised version:

  1. avoids FLEX array copies and manipulations
  2. avoids type DATA memory copies, useful in cases where DATA is a large STRUCT
PROC opt merge sort = ([]REF DATA m)[]REF DATA: (
    IF LWB m >= UPB m THEN
        m
    ELSE
        INT middle = ( UPB m + LWB m ) OVER 2;
        []REF DATA left = opt merge sort(m[:middle]);
        []REF DATA right = opt merge sort(m[middle+1:]);
        opt merge(left, right)[AT LWB m]
    FI
);

PROC opt merge = ([]REF DATA left, right)[]REF DATA:(
    [UPB left - LWB left + 1 + UPB right - LWB right + 1]REF DATA result;
    INT index left:=LWB left, index right:=LWB right;

    FOR index TO UPB result DO
        # change the direction of this comparison to change the direction of the sort #
        IF index right > UPB right THEN
            result[index:] := left[index left:]; 
            stop iteration
        ELIF index left > UPB left THEN
            result[index:] := right[index right:];
            stop iteration
        ELIF left[index left] <= right[index right] THEN
            result[index] := left[index left]; index left +:= 1
        ELSE
            result[index] := right[index right]; index right +:= 1
        FI
    OD;
stop iteration:
    result
);

# create an array of pointers to the data being sorted #
[UPB char array data]REF DATA data; FOR i TO UPB char array data DO data[i] := char array data[i] OD;

[]REF CHAR result = opt merge sort(data);
FOR i TO UPB result DO print((result[i])) OD; print(new line)
Output:
     abcdefghiijklmnopqrstuvwxyz

AppleScript

(*
    In-place, iterative binary merge sort
    Merge sort algorithm: John von Neumann, 1945.
    
    Convenience terminology used here:
        run: one of two adjacent source-list ranges containing ordered items for merging.
        block: range in the destination list to which two runs are merged.
*)
on mergeSort(theList, l, r) -- Sort items l thru r of theList.
    set listLength to (count theList)
    if (listLength < 2) then return
    -- Convert negative and/or transposed range indices.
    if (l < 0) then set l to listLength + l + 1
    if (r < 0) then set r to listLength + r + 1
    if (l > r) then set {l, r} to {r, l}
    
    -- Script object containing the input list and the sort range indices.
    script main
        property lst : theList
        property l : missing value
        property r : missing value
    end script
    set {main's l, main's r} to {l, r}
    
    -- Just swap adjacent items as necessary on the first pass.
    -- (Short insertion sorts would be better, to create larger initial runs.)
    repeat with j from (l + 1) to r by 2
        set i to j - 1
        set lv to main's lst's item i
        set rv to main's lst's item j
        if (lv > rv) then
            set main's lst's item i to rv
            set main's lst's item j to lv
        end if
    end repeat
    set rangeLength to r - l + 1
    if (rangeLength < 3) then return -- That's all if fewer than three items to sort.
    
    -- Script object to alternate with the one above as the source and destination for the
    -- merges. Its list need only contain the items from the sort range as ordered so far.
    script aux
        property lst : main's lst's items l thru r
        property l : 1
        property r : rangeLength
    end script
    
    -- Work out how many merging passes will be needed and set the script objects' initial
    -- source and destination roles so that the final pass will merge back to the original list.
    set passesToDo to 0
    set blockSize to 2
    repeat while (blockSize < rangeLength)
        set passesToDo to passesToDo + 1
        set blockSize to blockSize + blockSize
    end repeat
    set {srce, dest} to {{main, aux}, {aux, main}}'s item (passesToDo mod 2 + 1)
    
    -- Do the remaining passes, doubling the run and block sizes on each pass.
    -- (The end set in each pass will usually be truncated.)
    set blockSize to 2
    repeat passesToDo times -- Per pass.
        set runSize to blockSize
        set blockSize to blockSize + blockSize
        set k to (dest's l) - 1 -- Destination traversal index.
        
        repeat with leftStart from srce's l to srce's r by blockSize -- Per merge.
            set blockEnd to k + blockSize
            if (blockEnd comes after dest's r) then set blockEnd to dest's r
            set i to leftStart -- Left run traversal index.
            set leftEnd to leftStart + runSize - 1
            if (leftEnd comes before srce's r) then
                set j to leftEnd + 1 -- Right run traversal index.
                set rightEnd to leftEnd + runSize
                if (rightEnd comes after srce's r) then set rightEnd to srce's r
                -- Merge process:
                set lv to srce's lst's item i
                set rv to srce's lst's item j
                repeat with k from (k + 1) to blockEnd
                    if (lv > rv) then
                        set dest's lst's item k to rv
                        if (j = rightEnd) then exit repeat -- Right run used up.
                        set j to j + 1
                        set rv to srce's lst's item j
                    else
                        set dest's lst's item k to lv
                        if (i = leftEnd) then -- Left run used up.
                            set i to j
                            exit repeat
                        end if
                        set i to i + 1
                        set lv to srce's lst's item i
                    end if
                end repeat
            end if
            -- Use up the remaining items from the not-yet-exhausted run.
            repeat with k from (k + 1) to blockEnd
                set dest's lst's item k to srce's lst's item i
                set i to i + 1
            end repeat
        end repeat -- Per merge.
        
        -- Switch source and destination scripts for the next pass.
        tell srce
            set srce to dest
            set dest to it
        end tell
    end repeat -- Per pass.
    
    return -- nothing
end mergeSort
property sort : mergeSort

-- Demo:
local aList
set aList to {22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90}
sort(aList, 1, -1) -- Sort items 1 thru -1 of aList.
return aList
Output:
{2, 4, 8, 15, 22, 22, 37, 38, 46, 48, 49, 53, 54, 54, 58, 70, 72, 76, 80, 82, 84, 86, 90, 93, 98}

ARM Assembly

Works with: as version Raspberry Pi
/* ARM assembly Raspberry PI  */
/*  program mergeSort.s  */
 
 /* REMARK 1 : this program use routines in a include file 
   see task Include a file language arm assembly 
   for the routine affichageMess conversion10 
   see at end of this program the instruction include */
/* for constantes see task include a file in arm assembly */
/************************************/
/* Constantes                       */
/************************************/
.include "../constantes.inc"

/*********************************/
/* Initialized data              */
/*********************************/
.data
szMessSortOk:       .asciz "Table sorted.\n"
szMessSortNok:      .asciz "Table not sorted !!!!!.\n"
sMessResult:        .asciz "Value  : @ \n"
szCarriageReturn:   .asciz "\n"
 
.align 4
#TableNumber:      .int   1,11,3,6,2,5,9,10,8,4,7
TableNumber:       .int   10,9,8,7,6,5,4,3,2,1
                   .equ NBELEMENTS, (. - TableNumber) / 4
/*********************************/
/* UnInitialized data            */
/*********************************/
.bss
sZoneConv:            .skip 24
/*********************************/
/*  code section                 */
/*********************************/
.text
.global main 
main:                                              @ entry of program 
 
    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#0                                      @ first element
    mov r2,#NBELEMENTS                             @ number of élements 
    bl mergeSort
    ldr r0,iAdrTableNumber                         @ address number table
    bl displayTable
 
    ldr r0,iAdrTableNumber                         @ address number table
    mov r1,#NBELEMENTS                             @ number of élements 
    bl isSorted                                    @ control sort
    cmp r0,#1                                      @ sorted ?
    beq 1f                                    
    ldr r0,iAdrszMessSortNok                       @ no !! error sort
    bl affichageMess
    b 100f
1:                                                 @ yes
    ldr r0,iAdrszMessSortOk
    bl affichageMess
100:                                               @ standard end of the program 
    mov r0, #0                                     @ return code
    mov r7, #EXIT                                  @ request to exit program
    svc #0                                         @ perform the system call
 
iAdrszCarriageReturn:     .int szCarriageReturn
iAdrsMessResult:          .int sMessResult
iAdrTableNumber:          .int TableNumber
iAdrszMessSortOk:         .int szMessSortOk
iAdrszMessSortNok:        .int szMessSortNok
/******************************************************************/
/*     control sorted table                                   */ 
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the number of elements  > 0  */
/* r0 return 0  if not sorted   1  if sorted */
isSorted:
    push {r2-r4,lr}                                    @ save registers
    mov r2,#0
    ldr r4,[r0,r2,lsl #2]
1:
    add r2,#1
    cmp r2,r1
    movge r0,#1
    bge 100f
    ldr r3,[r0,r2, lsl #2]
    cmp r3,r4
    movlt r0,#0
    blt 100f
    mov r4,r3
    b 1b
100:
    pop {r2-r4,lr}
    bx lr                                              @ return 
    
/******************************************************************/
/*         merge                                              */ 
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains first start index
/* r2 contains second start index */
/* r3 contains the last index   */ 
merge:
    push {r1-r8,lr}               @ save registers
    mov r5,r2                     @ init index r2->r5 
1:                                @ begin loop first section
    ldr r6,[r0,r1,lsl #2]         @ load value first section index r1
    ldr r7,[r0,r5,lsl #2]         @ load value second section index r5
    cmp r6,r7
    ble 3f                        @ <=  -> location first section OK
    str r7,[r0,r1,lsl #2]         @ store value second section in first section
    add r8,r5,#1
    cmp r8,r3                     @ end second section ?
    strgt r6,[r0,r5,lsl #2]
    bgt 3f                        @ loop
2:                                @ loop insert element part 1 into part 2
    sub r4,r8,#1
    ldr r7,[r0,r8,lsl #2]         @ load value 2
    cmp r6,r7                     @ value < 
    strlt r6,[r0,r4,lsl #2]       @ store value 
    blt 3f
    str r7,[r0,r4,lsl #2]         @ store value 2
    add r8,#1
    cmp r8,r3                     @ end second section ?
    ble 2b                        @ no loop 
    sub r8,#1
    str r6,[r0,r8,lsl #2]         @ store value 1
3:
    add r1,#1
    cmp r1,r2                     @ end first section ?
    blt 1b

100:
    pop {r1-r8,lr}
    bx lr                          @ return 
/******************************************************************/
/*      merge sort                                                */ 
/******************************************************************/
/* r0 contains the address of table */
/* r1 contains the index of first element */
/* r2 contains the number of element */
mergeSort:
    push {r3-r7,lr}           @ save registers
    cmp r2,#2
    blt 100f
    lsr r4,r2,#1             @ number of element of each subset
    tst r2,#1
    addne r4,#1
    mov r5,r1              @ save first element
    mov r6,r2              @ save number of element
    mov r7,r4              @ save number of element of each subset
    mov r2,r4
    bl mergeSort
    mov r1,r7              @ restaur number of element of each subset
    mov r2,r6              @ restaur  number of element
    sub r2,r1
    mov r3,r5              @ restaur first element
    add r1,r3              @ + 1
    bl mergeSort           @ sort first subset
    mov r1,r5              @ restaur first element
    mov r2,r7              @ restaur number of element of each subset
    add r2,r1
    mov r3,r6              @ restaur  number of element
    add r3,r1 
    sub r3,#1              @ last index
    bl merge
100:
    pop {r3-r7,lr}
    bx lr                  @ return 
 
/******************************************************************/
/*      Display table elements                                */ 
/******************************************************************/
/* r0 contains the address of table */
displayTable:
    push {r0-r3,lr}                                    @ save registers
    mov r2,r0                                          @ table address
    mov r3,#0
1:                                                     @ loop display table
    ldr r0,[r2,r3,lsl #2]
    ldr r1,iAdrsZoneConv                               @ 
    bl conversion10S                                    @ décimal conversion 
    ldr r0,iAdrsMessResult
    ldr r1,iAdrsZoneConv                               @ insert conversion
    bl strInsertAtCharInc
    bl affichageMess                                   @ display message
    add r3,#1
    cmp r3,#NBELEMENTS - 1
    ble 1b
    ldr r0,iAdrszCarriageReturn
    bl affichageMess
    mov r0,r2
100:
    pop {r0-r3,lr}
    bx lr
iAdrsZoneConv:           .int sZoneConv
/***************************************************/
/*      ROUTINES INCLUDE                           */
/***************************************************/
.include "../affichage.inc"

Arturo

merge: function [a,b,left,middle,right][
    leftLen: middle - left
    rightLen: right - middle

    l: 0
    r: leftLen

    loop left..dec middle 'i [
        b\[l]: a\[i]
        l: l + 1
    ]
    loop middle..dec right 'i [
        b\[r]: a\[i]
        r: r + 1
    ]

    l: 0
    r: leftLen  
    i: left

    while [and? l < leftLen r < leftLen + rightLen][
        if? b\[l] < b\[r] [
            a\[i]: b\[l]
            l: l + 1
        ] 
        else [
            a\[i]: b\[r]
            r: r + 1
        ]
        i: i + 1
    ]

    while [l < leftLen][
        a\[i]: b\[l]
        l: l + 1
        i: i + 1
    ]
    while [r < leftLen + rightLen][
        a\[i]: b\[r]
        r: r + 1
        i: i + 1
    ]
]

mergeLR: function [a,b,left,right][
    if 1 >= right - left -> return ø
    mid: (left + right) / 2
    mergeLR a b left mid
    mergeLR a b mid right
    merge a b left mid right
]

mergeSort: function [arr][
    result: new arr
    b: new array.of:size result 0

    mergeLR result b 0 size result
    return result
]

print mergeSort [3 1 2 8 5 7 9 4 6]
Output:
1 2 3 4 5 6 7 8 9

Astro

fun mergesort(m):
    if m.lenght <= 1: return m
    let middle = floor m.lenght / 2
    let left = merge(m[:middle])
    let right = merge(m[middle-1:]);

fun merge(left, right):
    let result = []
    while not (left.isempty or right.isempty):
        if left[1] <= right[1]:
            result.push! left.shift!()
        else:
            result.push! right.shift!()
    result.push! left.push! right

let arr = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
print mergesort arr

ATS

A mergesort for linear lists

This algorithm modifies the links in the list, rather than allocate new cons-pairs. It requires no garbage collector. 

(*------------------------------------------------------------------*)
(* Mergesort in ATS2, for linear lists.                             *)
(*------------------------------------------------------------------*)

#include "share/atspre_staload.hats"

staload UN = "prelude/SATS/unsafe.sats"

#define NIL list_vt_nil ()
#define ::  list_vt_cons

(*------------------------------------------------------------------*)

(* Destructive stable merge. *)
extern fun {a : vt@ype}
list_vt_merge {m, n : int}
              (lst1 : list_vt (a, m),
               lst2 : list_vt (a, n))
    :<!wrt> list_vt (a, m + n)

(* Order predicate for list_vt_merge. You have to implement this to
   suit your needs. *)
extern fun {a : vt@ype}
list_vt_merge$lt : (&a, &a) -<> bool

(* Destructive stable mergesort. *)
extern fun {a : vt@ype}
list_vt_mergesort {n   : int}
                  (lst : list_vt (a, n))
    :<!wrt> list_vt (a, n)

(* Order predicate for list_vt_mergesort. You have to implement this
   to suit your needs. *)
extern fun {a : vt@ype}
list_vt_mergesort$lt : (&a, &a) -<> bool

(*------------------------------------------------------------------*)

implement {a}
list_vt_merge {m, n} (lst1, lst2) =
  let
    macdef lt = list_vt_merge$lt<a>

    fun
    loop {m, n       : nat} .<m + n>.
         (lst1       : list_vt (a, m),
          lst2       : list_vt (a, n),
          lst_merged : &List_vt a? >> list_vt (a, m + n))
        :<!wrt> void =
      case+ lst1 of
      | ~ NIL => lst_merged := lst2
      | @ elem1 :: tail1 =>
        begin
          case+ lst2 of
          | ~ NIL =>
            let
              prval () = fold@ lst1
            in
              lst_merged := lst1
            end
          | @ elem2 :: tail2 =>
            if ~(elem2 \lt elem1) then
              let
                val () = lst_merged := lst1
                prval () = fold@ lst2
                val () = loop (tail1, lst2, tail1)
                prval () = fold@ lst_merged
              in
              end
            else
              let
                val () = lst_merged := lst2
                prval () = fold@ lst1
                val () = loop (lst1, tail2, tail2)
                prval () = fold@ lst_merged
              in
              end
        end

    prval () = lemma_list_vt_param lst1 (* Proves 0 <= m. *)
    prval () = lemma_list_vt_param lst2 (* Proves 0 <= n. *)
    prval () = prop_verify {0 <= m} ()
    prval () = prop_verify {0 <= n} ()

    var lst_merged : List_vt a?
    val () = loop {m, n} (lst1, lst2, lst_merged)
  in
    lst_merged
  end

(*------------------------------------------------------------------*)

implement {a}
list_vt_mergesort {n} lst =
  let
    implement
    list_vt_merge$lt<a> (x, y) =
      list_vt_mergesort$lt<a> (x, y)

    (* You can make SMALL larger than 1 and write small_sort as a fast
       stable sort for small lists. *)
    #define SMALL 1
    fn
    small_sort {m   : pos | m <= SMALL}
               (lst : list_vt (a, m),
                m   : int m)
        :<!wrt> list_vt (a, m) =
      lst

    fun
    recurs {m   : pos} .<m>.
           (lst : list_vt (a, m),
            m   : int m)
        :<!wrt> list_vt (a, m) =
      if m <= SMALL then
        small_sort (lst, m)
      else
        let
          prval () = prop_verify {2 <= m} ()
          val i = m / 2
          val @(lst1, lst2) = list_vt_split_at<a> (lst, i)
          val lst1 = recurs (lst1, i)
          val lst2 = recurs (lst2, m - i)
        in
          list_vt_merge<a> (lst1, lst2)
        end

    prval () = lemma_list_vt_param lst (* Proves 0 <= n. *)
    prval () = prop_verify {0 <= n} ()
  in
    case+ lst of
    | NIL => lst
    | _ :: _ => recurs (lst, length lst)
  end

(*------------------------------------------------------------------*)

extern fun
list_vt_mergesort_int {n   : int}
                      (lst : list_vt (int, n))
    :<!wrt> list_vt (int, n)

implement
list_vt_mergesort_int {n} lst =
  let
    implement
    list_vt_mergesort$lt<int> (x, y) =
      x < y
  in
    list_vt_mergesort<int> {n} lst
  end

implement
main0 () =
  let
    val lst = $list_vt (22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49,
                        48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76,
                        53, 37, 90)
    val () = println! ("before : ", $UN.castvwtp1{List int} lst)
    val lst = list_vt_mergesort_int lst
    val () = println! ("after  : ", $UN.castvwtp1{List int} lst)
  in
    list_vt_free<int> lst
  end

(*------------------------------------------------------------------*)
Output:
$ patscc -O3 -DATS_MEMALLOC_LIBC mergesort_task_for_list_vt.dats && ./a.out
before : 22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54, 93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90
after  : 2, 4, 8, 15, 22, 22, 37, 38, 46, 48, 49, 53, 54, 54, 58, 70, 72, 76, 80, 82, 84, 86, 90, 93, 98

Footnote: Rather than directly write a mergesort for "ordinary" non-linear lists, I would write a routine to do the following:

  • make a copy of the list;
  • cast the copy to a linear list;
  • sort the linear list;
  • cast the result to non-linear list, and return the casted result.


This way, new cons-pairs are allocated only once.

The same thing can be done in other languages, of course. An interesting thing about this ATS implementation, though, is it proves the result is of the same length as the input. It does not, however, prove that the result satisfies the order predicate.

A mergesort for non-linear lists of integers, guaranteeing a sorted result

The following program not only sorts a list of integers, but verifies that the result is sorted. It is the simplest implementation I could think of that does that. It works by having a special kind of list that can be consed only in sorted order.

The length of the result also is verified. However, there is no proof that the result contains the same data as the input. 

//--------------------------------------------------------------------
//
//  A mergesort for 32-bit signed integers.
//
//--------------------------------------------------------------------

#include "share/atspre_staload.hats"

(*------------------------------------------------------------------*)

#define ENTIER_MAX 2147483647

(* We do not include the most negative two's-complement number. *)
stadef entier (i : int) = ~ENTIER_MAX <= i && i <= ENTIER_MAX
sortdef entier          = {i : int | entier i}

typedef entier (i : int) = [entier i] int i
typedef entier           = [i : entier] entier i

datatype sorted_entier_list (int, int) =
| sorted_entier_list_nil (0, ENTIER_MAX)
| {n : nat}
  {i, j : entier | ~(j < i)}
  sorted_entier_list_cons (n + 1, i) of
    (entier i, sorted_entier_list (n, j))
typedef sorted_entier_list (n : int) =
  [i : entier] sorted_entier_list (n, i)
typedef sorted_entier_list =
  [n : int] sorted_entier_list n

infixr ( :: ) :::
#define NIL  list_nil ()
#define ::   list_cons
#define SNIL sorted_entier_list_nil ()
#define :::  sorted_entier_list_cons

(*------------------------------------------------------------------*)

extern prfn
lemma_sorted_entier_list_param
          {n   : int}
          (lst : sorted_entier_list n)
    :<prf> [0 <= n] void

extern fn
sorted_entier_list_length
          {n   : int}
          (lst : sorted_entier_list n)
    :<> [0 <= n] int n

extern fn
sorted_entier_list_merge
          {m, n : int}
          {i, j : entier}
          (lst1 : sorted_entier_list (m, i),
           lst2 : sorted_entier_list (n, j))
    :<> sorted_entier_list (m + n, min (i, j))

extern fn
entier_list_mergesort
          {n   : int}
          (lst : list (entier, n)) (* An ordinary list. *)
    :<!wrt> sorted_entier_list n

extern fn
sorted_entier_list2list
          {n   : int}
          (lst : sorted_entier_list n)
    :<> list (entier, n)

overload length with sorted_entier_list_length
overload merge with sorted_entier_list_merge
overload mergesort with entier_list_mergesort
overload to_list with sorted_entier_list2list

(*------------------------------------------------------------------*)

primplement
lemma_sorted_entier_list_param {n} lst =
  case+ lst of
  | SNIL => ()
  | _ ::: _ => ()

implement
sorted_entier_list_length {n} lst =
  (* This implementation is tail-recursive. *)
  let
    fun
    count {m   : nat | m <= n} .<n - m>.
          (lst : sorted_entier_list (n - m),
           m   : int m)
        :<> [0 <= n] int n =
      case+ lst of
      | SNIL => m
      | _ ::: tail => count {m + 1} (tail, succ m)

    prval () = lemma_sorted_entier_list_param lst
  in
    count (lst, 0)
  end

implement
sorted_entier_list_merge (lst1, lst2) =
  (* This implementation is *NOT* tail recursive. It will use O(m+n)
     stack space. *)
  let
    fun
    recurs {m, n : nat}
           {i, j : entier} .<m + n>.
           (lst1 : sorted_entier_list (m, i),
            lst2 : sorted_entier_list (n, j))
        :<> sorted_entier_list (m + n, min (i, j)) =
      case+ lst1 of
      | SNIL => lst2
      | i ::: tail1 =>
        begin
          case+ lst2 of
          | SNIL => lst1
          | j ::: tail2 =>
            if ~(j < i) then
              i ::: recurs (tail1, lst2)
            else
              j ::: recurs (lst1, tail2)
        end

    prval () = lemma_sorted_entier_list_param lst1
    prval () = lemma_sorted_entier_list_param lst2
  in
    recurs (lst1, lst2)
  end

implement
entier_list_mergesort lst =
  let
    fun
    recurs {m   : nat} .<m>.
           (lst : list (entier, m),
            m   : int m)
        :<!wrt> sorted_entier_list m =
      if m = 1 then
        let
          val+ head :: NIL = lst
        in
          head ::: SNIL
        end
      else if m = 0 then
        SNIL
      else
        let
          val m_left = m \g1int_ndiv 2
          val m_right = m - m_left
          val @(left, right) = list_split_at (lst, m_left)
          val left = recurs (list_vt2t left, m_left)
          and right = recurs (right, m_right)
        in
          left \merge right
        end

    prval () = lemma_list_param lst
  in
    recurs (lst, length lst)
  end

implement
sorted_entier_list2list lst =
  (* This implementation is *NOT* tail recursive. It will use O(n)
     stack space. *)
  let
    fun
    recurs {n   : nat} .<n>.
           (lst : sorted_entier_list n)
        :<> list (entier, n) =
      case+ lst of
      | SNIL => NIL
      | head ::: tail => head :: recurs tail

    prval () = lemma_sorted_entier_list_param lst
  in
    recurs lst
  end

(*------------------------------------------------------------------*)

fn
print_Int_list
          {n   : int}
          (lst : list (Int, n))
    : void =
  let
    fun
    loop {n   : nat} .<n>.
         (lst : list (Int, n))
        : void =
      case+ lst of
      | NIL => ()
      | head :: tail =>
        begin
          print! (" ");
          print! (head);
          loop tail
        end
    prval () = lemma_list_param lst
  in
    loop lst
  end

implement
main0 () =
  let
    val example_list =
      $list (22, 15, 98, 82, 22, 4, 58, 70, 80, 38, 49, 48, 46, 54,
             93, 8, 54, 2, 72, 84, 86, 76, 53, 37, 90)
    val sorted_list = mergesort example_list
  in
    print! ("unsorted  ");
    print_Int_list example_list;
    println! ();
    print! ("sorted    ");
    print_Int_list (to_list sorted_list);
    println! ()
  end

(*------------------------------------------------------------------*)
Output:
patscc -O3 -DATS_MEMALLOC_GCBDW mergesort_task_verified.dats -lgc && ./a.out
unsorted   22 15 98 82 22 4 58 70 80 38 49 48 46 54 93 8 54 2 72 84 86 76 53 37 90
sorted     2 4 8 15 22 22 37 38 46 48 49 53 54 54 58 70 72 76 80 82 84 86 90 93 98

Postscript. One might try adding a line such as 

val x = 3 ::: 2 ::: SNIL

to the program and see that the compiler will report it as erroneous, on grounds that "2 is not less than 3" is unsatisfied.

AutoHotkey_L

AutoHotkey_L has true array support and can dynamically grow and shrink its arrays at run time. This version of Merge Sort only needs n locations to sort. AHK forum post 

#NoEnv

Test := []
Loop 100 {
    Random n, 0, 999
    Test.Insert(n)
}
Result := MergeSort(Test)
Loop % Result.MaxIndex() {
    MsgBox, 1, , % Result[A_Index]
    IfMsgBox Cancel
        Break
}
Return


/*
    Function MergeSort
        Sorts an array by first recursively splitting it down to its
        individual elements and then merging those elements in their
        correct order.
       
    Parameters
        Array   The array to be sorted
       
    Returns
        The sorted array
*/
MergeSort(Array)
    {
        ; Return single element arrays
        If (! Array.HasKey(2))
            Return Array

        ; Split array into Left and Right halfs
        Left := [], Right := [], Middle := Array.MaxIndex() // 2
        Loop % Middle
            Right.Insert(Array.Remove(Middle-- + 1)), Left.Insert(Array.Remove(1))
        If (Array.MaxIndex())
            Right.Insert(Array.Remove(1))
       
        Left := MergeSort(Left), Right := MergeSort(Right)

        ; If all the Right values are greater than all the
        ; Left values, just append Right at the end of Left.
        If (Left[Left.MaxIndex()] <= Right[1]) {
            Loop % Right.MaxIndex()
                Left.Insert(Right.Remove(1))
            Return Left
        }
        ; Loop until one of the arrays is empty
        While(Left.MaxIndex() and Right.MaxIndex())
            Left[1] <= Right[1] ? Array.Insert(Left.Remove(1))
                                : Array.Insert(Right.Remove(1))

        Loop % Left.MaxIndex()
            Array.Insert(Left.Remove(1))

        Loop % Right.MaxIndex()
            Array.Insert(Right.Remove(1))
           
        Return Array
    }

AutoHotkey

Contributed by Laszlo on the ahk forum 

MsgBox % MSort("")
MsgBox % MSort("xxx")
MsgBox % MSort("3,2,1")
MsgBox % MSort("dog,000000,cat,pile,abcde,1,zz,xx,z")

MSort(x) {                                                  ; Merge-sort of a comma separated list
   If (2 > L:=Len(x))
       Return x                                             ; empty or single item lists are sorted
   StringGetPos p, x, `,, % "L" L//2                        ; Find middle comma
   Return Merge(MSort(SubStr(x,1,p)), MSort(SubStr(x,p+2))) ; Split, Sort, Merge
}

Len(list) {
   StringReplace t, list,`,,,UseErrorLevel                  ; #commas -> ErrorLevel
   Return list="" ? 0 : ErrorLevel+1
}

Item(list,ByRef p) {                                        ; item at position p, p <- next position
   Return (p := InStr(list,",",0,i:=p+1)) ? SubStr(list,i,p-i) : SubStr(list,i)
}

Merge(list0,list1) {                                        ; Merge 2 sorted lists
   IfEqual list0,, Return list1
   IfEqual list1,, Return list0
   i0 := Item(list0,p0:=0)
   i1 := Item(list1,p1:=0)
   Loop  {
      i := i0>i1
      list .= "," i%i%                                      ; output smaller
      If (p%i%)
         i%i% := Item(list%i%,p%i%)                         ; get next item from processed list
      Else {
         i ^= 1                                             ; list is exhausted: attach rest of other
         Return SubStr(list "," i%i% (p%i% ? "," SubStr(list%i%,p%i%+1) : ""), 2)
      }
   }
}

BASIC

BBC BASIC

DEFPROC_MergeSort(Start%,End%)
REM *****************************************************************
REM This procedure Merge Sorts the chunk of data% bounded by
REM Start% & End%.
REM *****************************************************************

LOCAL Middle%
IF End%=Start% ENDPROC

IF End%-Start%=1 THEN
   IF data%(End%)<data%(Start%) THEN
      SWAP data%(Start%),data%(End%)
   ENDIF
   ENDPROC
ENDIF

Middle%=Start%+(End%-Start%)/2

PROC_MergeSort(Start%,Middle%)
PROC_MergeSort(Middle%+1,End%)
PROC_Merge(Start%,Middle%,End%)

ENDPROC
:
DEF PROC_Merge(Start%,Middle%,End%)

LOCAL fh_size%
fh_size% = Middle%-Start%+1

FOR I%=0 TO fh_size%-1
  fh%(I%)=data%(Start%+I%)
NEXT I%

I%=0
J%=Middle%+1
K%=Start%

REPEAT
  IF fh%(I%) <= data%(J%) THEN
    data%(K%)=fh%(I%)
    I%+=1
    K%+=1
  ELSE
    data%(K%)=data%(J%)
    J%+=1
    K%+=1
  ENDIF
UNTIL I%=fh_size% OR J%>End%

WHILE I% < fh_size%
  data%(K%)=fh%(I%)
  I%+=1
  K%+=1
ENDWHILE

ENDPROC

Usage would look something like this example which sorts a series of 1000 random integers: 

REM Example of merge sort usage.
Size%=1000

S1%=Size%/2

DIM data%(Size%)
DIM fh%(S1%)

FOR I%=1 TO Size%
  data%(I%)=RND(100000)
NEXT

PROC_MergeSort(1,Size%)

END

Chipmunk Basic

Works with: Chipmunk Basic version 3.6.4
Translation of: Quite BASIC
100 REM Sorting algorithms/Merge sort
110 CLS
120 LET N = 10
130 LET C = 0
140 OPTION BASE 1
150 DIM A(10)
160 DIM B(10)
170 RANDOMIZE TIMER
180 GOSUB 810
190 REM Print the random array
200 PRINT "unsort  ";
210 GOSUB 860
220 REM Sort the array
230 GOSUB 300
240 PRINT "  sort  ";
250 REM Print the sorted array
260 GOSUB 860
270 PRINT "Number of iterations: ";C
290 END
300 REM Merge sort the list A of length N
310 REM Using the array B for temporary storage
320 REM
330 REM === Split phase ===
340 REM C counts the number of split/merge iterations
350 LET C = C+1
360 LET X = 1
370 LET Y = 1
380 LET Z = N
390 GOTO 410
400 IF A(X) < A(X-1) THEN GOTO 470
410 LET B(Y) = A(X)
420 LET Y = Y+1
430 LET X = X+1
440 IF Z < Y THEN GOTO 500
450 GOTO 400
460 IF A(X) < A(X-1) THEN GOTO 410
470 LET B(Z) = A(X)
480 LET Z = Z-1
490 LET X = X+1
500 IF Z < Y THEN GOTO 530
510 GOTO 460
520 REM
530 REM === Merge Phase ===
540 REM Q means "we're done" (or "quit")
550 REM Q is 1 until we know that this is _not_ the last iteration
560 LET Q = 1
570 LET X = 1
580 LET Y = 1
590 LET Z = N
600 REM First select the smaller item
610 IF B(Y) < B(Z) THEN GOTO 710 ELSE GOTO 750
620 REM Check if the loop is done
630 IF Z < Y THEN GOTO 790
640 REM If both items are smaller then start over with the smallest
650 IF B(Y) >= A(X-1) OR B(Z) >= A(X-1) THEN GOTO 680
660 LET Q = 0
670 GOTO 600
680 REM Pick the smallest item that represents an increase
690 IF B(Z) < B(Y) AND B(Z) >= A(X-1) THEN GOTO 750
700 IF B(Z) > B(Y) AND B(Y) < A(X-1) THEN GOTO 750
710 LET A(X) = B(Y)
720 LET Y = Y+1
730 LET X = X+1
740 GOTO 620
750 LET A(X) = B(Z)
760 LET Z = Z-1
770 LET X = X+1
780 GOTO 620
790 IF Q = 0 THEN GOTO 330
800 RETURN
810 REM Create a random list of N integers
820 FOR I = 1 TO N
830 LET A(I) = FLOOR(RND(100))
840 NEXT I
850 RETURN
860 REM PRINT the list A
870 FOR I = 1 TO N
880 PRINT A(I);" ";
890 NEXT I
900 PRINT
910 RETURN

Minimal BASIC

Translation of: Quite BASIC
120 LET N = 10
130 LET C = 0
140 OPTION BASE 1
150 DIM A(10)
160 DIM B(10)
170 RANDOMIZE
180 GOSUB 810
190 REM Print the random array
200 PRINT "unsort  ";
210 GOSUB 860
220 REM Sort the array
230 GOSUB 300
240 PRINT "  sort  ";
250 REM Print the sorted array
260 GOSUB 860
270 PRINT "Number of iterations: "; C
290 GOTO 950
300 REM Merge sort the list A of length N
310 REM Using the array B for temporary storage
320 REM
330 REM === Split phase ===
340 REM C counts the number of split/merge iterations
350 LET C = C+1
360 LET X = 1
370 LET Y = 1
380 LET Z = N
390 GOTO 410
400 IF A(X) < A(X-1) THEN 470
410 LET B(Y) = A(X)
420 LET Y = Y+1
430 LET X = X+1
440 IF Z < Y THEN 500
450 GOTO 400
460 IF A(X) < A(X-1) THEN 410
470 LET B(Z) = A(X)
480 LET Z = Z-1
490 LET X = X+1
500 IF Z < Y THEN 530
510 GOTO 460
520 REM
530 REM === Merge Phase ===
540 REM Q means "we're done" (or "quit")
550 REM Q is 1 until we know that this is _not_ the last iteration
560 LET Q = 1
570 LET X = 1
580 LET Y = 1
590 LET Z = N
600 REM First select the smaller item
610 IF B(Y) < B(Z) THEN 710
615 IF B(Y) > B(Z) THEN 750
620 REM Check if the loop is done
630 IF Z < Y THEN 790
640 REM If both items are smaller then start over with the smallest
650 IF B(Y) >= A(X-1) THEN 680
655 IF B(Z) >= A(X-1) THEN 680
660 LET Q = 0
670 GOTO 600
680 REM Pick the smallest item that represents an increase
690 IF B(Z) < B(Y) THEN 695 
692 IF B(Z) > B(Y) THEN 700
695 IF B(Z) >= A(X-1) THEN 750
700 IF B(Z) > B(Y) THEN 705
705 IF B(Y) < A(X-1) THEN 750
710 LET A(X) = B(Y)
720 LET Y = Y+1
730 LET X = X+1
740 GOTO 620
750 LET A(X) = B(Z)
760 LET Z = Z-1
770 LET X = X+1
780 GOTO 620
790 IF Q = 0 THEN 330
800 RETURN
810 REM Create a random list of N integers
820 FOR I = 1 TO N
830 LET A(I) = INT((RND * 100) + .5)
840 NEXT I
850 RETURN
860 REM PRINT the list A
870 FOR I = 1 TO N
880 PRINT A(I); " ";
890 NEXT I
900 PRINT
910 RETURN
950 END

Quite BASIC

100 REM Sorting algorithms/Merge sort
110 CLS
120 LET N = 10
130 LET C = 0
150 ARRAY A
160 ARRAY B
180 GOSUB 810
190 REM Print the random array
200 PRINT "unsort  ";
210 GOSUB 860
220 REM Sort the array
230 GOSUB 300
240 PRINT "  sort  ";
250 REM Print the sorted array
260 GOSUB 860
270 PRINT "Number of iterations: "; C
290 END
300 REM Merge sort the list A of length N
310 REM Using the array B for temporary storage
320 REM
330 REM === Split phase ===
340 REM C counts the number of split/merge iterations
350 LET C = C+1
360 LET X = 1
370 LET Y = 1
380 LET Z = N
390 GOTO 410
400 IF A(X) < A(X-1) THEN GOTO 470
410 LET B(Y) = A(X)
420 LET Y = Y+1
430 LET X = X+1
440 IF Z < Y THEN GOTO 500
450 GOTO 400
460 IF A(X) < A(X-1) THEN GOTO 410
470 LET B(Z) = A(X)
480 LET Z = Z-1
490 LET X = X+1
500 IF Z < Y THEN GOTO 530
510 GOTO 460
520 REM
530 REM === Merge Phase ===
540 REM Q means "we're done" (or "quit")
550 REM Q is 1 until we know that this is _not_ the last iteration
560 LET Q = 1
570 LET X = 1
580 LET Y = 1
590 LET Z = N
600 REM First select the smaller item
610 IF B(Y) < B(Z) THEN GOTO 710 ELSE GOTO 750
620 REM Check if the loop is done
630 IF Z < Y THEN GOTO 790
640 REM If both items are smaller then start over with the smallest
650 IF B(Y) >= A(X-1) OR B(Z) >= A(X-1) THEN GOTO 680
660 LET Q = 0
670 GOTO 600
680 REM Pick the smallest item that represents an increase
690 IF B(Z) < B(Y) AND B(Z) >= A(X-1) THEN GOTO 750
700 IF B(Z) > B(Y) AND B(Y) < A(X-1) THEN GOTO 750
710 LET A(X) = B(Y)
720 LET Y = Y+1
730 LET X = X+1
740 GOTO 620
750 LET A(X) = B(Z)
760 LET Z = Z-1
770 LET X = X+1
780 GOTO 620
790 IF Q = 0 THEN GOTO 330
800 RETURN
810 REM Create a random list of N integers
820 FOR I = 1 TO N
830 LET A(I) = FLOOR(RND(100))
840 NEXT I
850 RETURN
860 REM PRINT the list A
870 FOR I = 1 TO N
880 PRINT A(I); " ";
890 NEXT I
900 PRINT
910 RETURN

BCPL

get "libhdr"

let mergesort(A, n) be if n >= 2
$(  let m = n / 2
    mergesort(A, m)
    mergesort(A+m, n-m)
    merge(A, n, m)
$)
and merge(A, n, m) be
$(  let i, j = 0, m
    let x = getvec(n)
    for k=0 to n-1
        x!k := A!valof
            test j~=n & (i=m | A!j < A!i)
            $(  j := j + 1
                resultis j - 1
            $)
            else 
            $(  i := i + 1
                resultis i - 1
            $)
    for i=0 to n-1 do a!i := x!i
    freevec(x)
$)

let write(s, A, len) be
$(  writes(s)
    for i=0 to len-1 do writed(A!i, 4)
    wrch('*N')
$)
    
let start() be
$(  let array = table 4,65,2,-31,0,99,2,83,782,1
    let length = 10    
    write("Before: ", array, length)
    mergesort(array, length)
    write("After:  ", array, length)
$)
Output:
Before:    4  65   2 -31   0  99   2  83 782   1
After:   -31   0   1   2   2   4  65  83  99 782

C

#include <stdio.h>
#include <stdlib.h>

void merge (int *a, int n, int m) {
    int i, j, k;
    int *x = malloc(n * sizeof (int));
    for (i = 0, j = m, k = 0; k < n; k++) {
        x[k] = j == n      ? a[i++]
             : i == m      ? a[j++]
             : a[j] < a[i] ? a[j++]
             :               a[i++];
    }
    for (i = 0; i < n; i++) {
        a[i] = x[i];
    }
    free(x);
}

void merge_sort (int *a, int n) {
    if (n < 2)
        return;
    int m = n / 2;
    merge_sort(a, m);
    merge_sort(a + m, n - m);
    merge(a, n, m);
}

int main () {
    int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
    int n = sizeof a / sizeof a[0];
    int i;
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    merge_sort(a, n);
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    return 0;
}
Output:
4 65 2 -31 0 99 2 83 782 1
-31 0 1 2 2 4 65 83 99 782

Non-recursive variant: 

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

/* x and y are sorted, copy nx+ny sorted values to r */
void merge(int nx, int*x, int ny, int*y, int*r) {
    int i= 0, j= 0, k= 0;
    while (i<nx && j<ny) {
        int a= x[i], b= y[j];
        if (a<b) {
            r[k++]= a;
            i++;
        } else {
            r[k++]= b;
            j++;
        }
    }
    if (i<nx) {
        memcpy(r+k, i+x, (nx-i)*sizeof (int));
    } else if (j<ny) {
        memcpy(r+k, j+y, (ny-j)*sizeof (int));
    }
}

void mergesort(int ny, int *y) {
    int stride= 1, mid, *r= y, *t, *x= malloc(ny*sizeof (int));
    while (stride < ny) {
        stride= 2*(mid= stride);
        for (int i= 0; i<ny; i+= stride) {
            int lim= mid;
            if (i+stride >= ny) {
                if (i+mid >= ny) {
                    memcpy(i+x, i+y, (ny-i)*sizeof (int));
                    continue;
                }
                lim= ny-(i+mid);
            }
            merge(mid, i+y, lim, i+mid+y, i+x);
        }
        t= x; x= y; y=t;
    }
    if (y!=r) {
        memcpy(r, y, ny*sizeof(int));
        x= y;
    }
    free(x);
}

int main () {
    int a[] = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1};
    int n = sizeof a / sizeof a[0];
    int i;
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    mergesort(n, a);
    for (i = 0; i < n; i++)
        printf("%d%s", a[i], i == n - 1 ? "\n" : " ");
    return 0;
}
Output:
4 65 2 -31 0 99 2 83 782 1
-31 0 1 2 2 4 65 83 99 782

C#

Works with: C# version 3.0+
namespace RosettaCode {
  using System;

  public class MergeSort<T> where T : IComparable {
    #region Constants
    public const UInt32 INSERTION_LIMIT_DEFAULT = 12;
    public const Int32 MERGES_DEFAULT = 6;
    #endregion

    #region Properties
    public UInt32 InsertionLimit { get; }
    protected UInt32[] Positions { get; set; }

    private Int32 merges;
    public Int32 Merges {
      get { return merges; }
      set {
        // A minimum of 2 merges are required
        if (value > 1)
          merges = value;
        else
          throw new ArgumentOutOfRangeException($"value = {value} must be greater than one", nameof(Merges));

        if (Positions == null || Positions.Length != merges)
          Positions = new UInt32[merges];
      }
    }
    #endregion

    #region Constructors
    public MergeSort(UInt32 insertionLimit, Int32 merges) {
      InsertionLimit = insertionLimit;
      Merges = merges;
    }

    public MergeSort()
      : this(INSERTION_LIMIT_DEFAULT, MERGES_DEFAULT) {
    }
    #endregion

    #region Sort Methods
    public void Sort(T[] entries) {
      // Allocate merge buffer
      var entries2 = new T[entries.Length];
      Sort(entries, entries2, 0, entries.Length - 1);
    }

    // Top-Down K-way Merge Sort
    public void Sort(T[] entries1, T[] entries2, Int32 first, Int32 last) {
      var length = last + 1 - first;
      if (length < 2) return;      
      if (length < Merges || length < InsertionLimit) {
        InsertionSort<T>.Sort(entries1, first, last);
        return;
      }

      var left = first;
      var size = ceiling(length, Merges);
      for (var remaining = length; remaining > 0; remaining -= size, left += size) {
        var right = left + Math.Min(remaining, size) - 1;
        Sort(entries1, entries2, left, right);
      }

      Merge(entries1, entries2, first, last);
      Array.Copy(entries2, first, entries1, first, length);
    }
    #endregion

    #region Merge Methods
    public void Merge(T[] entries1, T[] entries2, Int32 first, Int32 last) {
      Array.Clear(Positions, 0, Merges);
      // This implementation has a quadratic time dependency on the number of merges
      for (var index = first; index <= last; index++)
        entries2[index] = remove(entries1, first, last);
    }

    private T remove(T[] entries, Int32 first, Int32 last) {
      T entry = default;
      Int32? found = default;
      var length = last + 1 - first;

      var index = 0;
      var left = first;
      var size = ceiling(length, Merges);
      for (var remaining = length; remaining > 0; remaining -= size, left += size, index++) {
        var position = Positions[index];
        if (position < Math.Min(remaining, size)) {
          var next = entries[left + position];
          if (!found.HasValue || entry.CompareTo(next) > 0) {
            found = index;
            entry = next;
          }
        }
      }

      // Remove entry
      Positions[found.Value]++;
      return entry;
    }
    #endregion

    #region Math Methods
    private static Int32 ceiling(Int32 numerator, Int32 denominator) {
      return (numerator + denominator - 1) / denominator;
    }
    #endregion
  }

  #region Insertion Sort
  static class InsertionSort<T> where T : IComparable {
    public static void Sort(T[] entries, Int32 first, Int32 last) {
      for (var next = first + 1; next <= last; next++)
        insert(entries, first, next);
    }

    /// <summary>Bubble next entry up to its sorted location, assuming entries[first:next - 1] are already sorted.</summary>
    private static void insert(T[] entries, Int32 first, Int32 next) {
      var entry = entries[next];
      while (next > first && entries[next - 1].CompareTo(entry) > 0)
        entries[next] = entries[--next];
      entries[next] = entry;
    }
  }
  #endregion
}

Example: 

  using Sort;
  using System;

  class Program {
    static void Main(String[] args) {
      var entries = new Int32[] { 7, 5, 2, 6, 1, 4, 2, 6, 3 };
      var sorter = new MergeSort<Int32>();
      sorter.Sort(entries);
      Console.WriteLine(String.Join(" ", entries));
    }
  }
Output:
1 2 2 3 4 5 6 6 7

C++

#include <iterator>
#include <algorithm> // for std::inplace_merge
#include <functional> // for std::less

template<typename RandomAccessIterator, typename Order>
 void mergesort(RandomAccessIterator first, RandomAccessIterator last, Order order)
{
  if (last - first > 1)
  {
    RandomAccessIterator middle = first + (last - first) / 2;
    mergesort(first, middle, order);
    mergesort(middle, last, order);
    std::inplace_merge(first, middle, last, order);
  }
}

template<typename RandomAccessIterator>
 void mergesort(RandomAccessIterator first, RandomAccessIterator last)
{
  mergesort(first, last, std::less<typename std::iterator_traits<RandomAccessIterator>::value_type>());
}

Clojure

Translation of: Haskell
(defn merge [left right]
  (cond (nil? left) right
        (nil? right) left
        :else (let [[l & *left] left
                    [r & *right] right]
                (if (<= l r) (cons l (merge *left right))
                             (cons r (merge left *right))))))

(defn merge-sort [list]
  (if (< (count list) 2)
    list
    (let [[left right] (split-at (/ (count list) 2) list)]
      (merge (merge-sort left) (merge-sort right)))))

COBOL

Cobol cannot do recursion, so this version simulates recursion. The working storage is therefore pretty complex, so I have shown the whole program, not just the working procedure division parts. 

       IDENTIFICATION DIVISION.
       PROGRAM-ID.                      MERGESORT.
       AUTHOR.                          DAVE STRATFORD.
       DATE-WRITTEN.                    APRIL 2010.
       INSTALLATION.                    HEXAGON SYSTEMS LIMITED.
      ******************************************************************
      *                            MERGE SORT                          *
      *  The Merge sort uses a completely different paradigm, one of   *
      * divide and conquer, to many of the other sorts. The data set   *
      * is split into smaller sub sets upon which are sorted and then  *
      * merged together to form the final sorted data set.             *
      *  This version uses the recursive method. Split the data set in *
      * half and perform a merge sort on each half. This in turn splits*
      * each half again and again until each set is just one or 2 items*
      * long. A set of one item is already sorted so is ignored, a set *
      * of two is compared and swapped as necessary. The smaller data  *
      * sets are then repeatedly merged together to eventually form the*
      * full, sorted, set.                                             *
      *  Since cobol cannot do recursion this module only simulates it *
      * so is not as fast as a normal recursive version would be.      *
      *  Scales very well to larger data sets, its relative complexity *
      * means it is not suited to sorting smaller data sets: use an    *
      * Insertion sort instead as the Merge sort is a stable sort.     *
      ******************************************************************

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.                 ICL VME.
       OBJECT-COMPUTER.                 ICL VME.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT FA-INPUT-FILE  ASSIGN FL01.
           SELECT FB-OUTPUT-FILE ASSIGN FL02.

       DATA DIVISION.
       FILE SECTION.
       FD  FA-INPUT-FILE.
       01  FA-INPUT-REC.
         03  FA-DATA                    PIC 9(6).

       FD  FB-OUTPUT-FILE.
       01  FB-OUTPUT-REC                PIC 9(6).

       WORKING-STORAGE SECTION.
       01  WA-IDENTITY.
         03  WA-PROGNAME                PIC X(10) VALUE "MERGESORT".
         03  WA-VERSION                 PIC X(6) VALUE "000001".

       01  WB-TABLE.
         03  WB-ENTRY                   PIC 9(8) COMP SYNC OCCURS 100000
                                                 INDEXED BY WB-IX-1
                                                            WB-IX-2.

       01  WC-VARS.
         03  WC-SIZE                    PIC S9(8) COMP SYNC.
         03  WC-TEMP                    PIC S9(8) COMP SYNC.
         03  WC-START                   PIC S9(8) COMP SYNC.
         03  WC-MIDDLE                  PIC S9(8) COMP SYNC.
         03  WC-END                     PIC S9(8) COMP SYNC.

       01  WD-FIRST-HALF.
         03  WD-FH-MAX                  PIC S9(8) COMP SYNC.
         03  WD-ENTRY                   PIC 9(8) COMP SYNC OCCURS 50000
                                                 INDEXED BY WD-IX.

       01  WF-CONDITION-FLAGS.
         03  WF-EOF-FLAG                PIC X.
           88  END-OF-FILE              VALUE "Y".
         03  WF-EMPTY-FILE-FLAG         PIC X.
           88  EMPTY-FILE               VALUE "Y".

       01  WS-STACK.
      * This stack is big enough to sort a list of 1million items.
         03  WS-STACK-ENTRY OCCURS 20 INDEXED BY WS-STACK-TOP.
           05  WS-START                 PIC S9(8) COMP SYNC.
           05  WS-MIDDLE                PIC S9(8) COMP SYNC.
           05  WS-END                   PIC S9(8) COMP SYNC.
           05  WS-FS-FLAG               PIC X.
             88  FIRST-HALF             VALUE "F".
             88  SECOND-HALF            VALUE "S".
             88  WS-ALL                 VALUE "A".
           05  WS-IO-FLAG               PIC X.
             88  WS-IN                  VALUE "I".
             88  WS-OUT                 VALUE "O".

       PROCEDURE DIVISION.
       A-MAIN SECTION.
       A-000.
           PERFORM B-INITIALISE.

           IF NOT EMPTY-FILE
              PERFORM C-PROCESS.

           PERFORM D-FINISH.

       A-999.
           STOP RUN.

       B-INITIALISE SECTION.
       B-000.
           DISPLAY "*** " WA-PROGNAME " VERSION "
                          WA-VERSION " STARTING ***".

           MOVE ALL "N" TO WF-CONDITION-FLAGS.
           OPEN INPUT FA-INPUT-FILE.
           SET WB-IX-1 TO 0.

           READ FA-INPUT-FILE AT END MOVE "Y" TO WF-EOF-FLAG
                                                 WF-EMPTY-FILE-FLAG.

           PERFORM BA-READ-INPUT UNTIL END-OF-FILE.

           CLOSE FA-INPUT-FILE.

           SET WC-SIZE TO WB-IX-1.

       B-999.
           EXIT.

       BA-READ-INPUT SECTION.
       BA-000.
           SET WB-IX-1 UP BY 1.
           MOVE FA-DATA TO WB-ENTRY(WB-IX-1).

           READ FA-INPUT-FILE AT END MOVE "Y" TO WF-EOF-FLAG.

       BA-999.
           EXIT.

       C-PROCESS SECTION.
       C-000.
           DISPLAY "SORT STARTING".

           MOVE 1           TO WS-START(1).
           MOVE WC-SIZE     TO WS-END(1).
           MOVE "F"         TO WS-FS-FLAG(1).
           MOVE "I"         TO WS-IO-FLAG(1).
           SET WS-STACK-TOP TO 2.

           PERFORM E-MERGE-SORT UNTIL WS-OUT(1).

           DISPLAY "SORT FINISHED".

       C-999.
           EXIT.

       D-FINISH SECTION.
       D-000.
           OPEN OUTPUT FB-OUTPUT-FILE.
           SET WB-IX-1 TO 1.

           PERFORM DA-WRITE-OUTPUT UNTIL WB-IX-1 > WC-SIZE.

           CLOSE FB-OUTPUT-FILE.

           DISPLAY "*** " WA-PROGNAME " FINISHED ***".

       D-999.
           EXIT.

       DA-WRITE-OUTPUT SECTION.
       DA-000.
           WRITE FB-OUTPUT-REC FROM WB-ENTRY(WB-IX-1).
           SET WB-IX-1 UP BY 1.

       DA-999.
           EXIT.

      ******************************************************************
       E-MERGE-SORT SECTION.
      *=====================                                           *
      * This section controls the simulated recursion.                 *
      ******************************************************************
       E-000.
           IF WS-OUT(WS-STACK-TOP - 1)
              GO TO E-010. 

           MOVE WS-START(WS-STACK-TOP - 1) TO WC-START.
           MOVE WS-END(WS-STACK-TOP - 1)   TO WC-END.

      * First check size of part we are dealing with.
           IF WC-END - WC-START = 0
      * Only 1 number in range, so simply set for output, and move on
              MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1)
              GO TO E-010.

           IF WC-END - WC-START = 1
      * 2 numbers, so compare and swap as necessary. Set for output
              MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1)
              IF WB-ENTRY(WC-START) > WB-ENTRY(WC-END)
                 MOVE WB-ENTRY(WC-START) TO WC-TEMP
                 MOVE WB-ENTRY(WC-END) TO WB-ENTRY(WC-START)
                 MOVE WC-TEMP TO WB-ENTRY(WC-END)
                 GO TO E-010
              ELSE
                 GO TO E-010.

      * More than 2, so split and carry on down
           COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2.

           MOVE WC-START  TO WS-START(WS-STACK-TOP).
           MOVE WC-MIDDLE TO WS-END(WS-STACK-TOP).
           MOVE "F"       TO WS-FS-FLAG(WS-STACK-TOP).
           MOVE "I"       TO WS-IO-FLAG(WS-STACK-TOP).
           SET WS-STACK-TOP UP BY 1.

           GO TO E-999.

       E-010.
           SET WS-STACK-TOP DOWN BY 1.

           IF SECOND-HALF(WS-STACK-TOP)
              GO TO E-020.

           MOVE WS-START(WS-STACK-TOP - 1) TO WC-START.
           MOVE WS-END(WS-STACK-TOP - 1)   TO WC-END.
           COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2 + 1.

           MOVE WC-MIDDLE TO WS-START(WS-STACK-TOP).
           MOVE WC-END    TO WS-END(WS-STACK-TOP).
           MOVE "S"       TO WS-FS-FLAG(WS-STACK-TOP).
           MOVE "I"       TO WS-IO-FLAG(WS-STACK-TOP).
           SET WS-STACK-TOP UP BY 1.

           GO TO E-999.

       E-020.
           MOVE WS-START(WS-STACK-TOP - 1) TO WC-START.
           MOVE WS-END(WS-STACK-TOP - 1)   TO WC-END.
           COMPUTE WC-MIDDLE = ( WC-START + WC-END ) / 2.
           PERFORM H-PROCESS-MERGE.
           MOVE "O" TO WS-IO-FLAG(WS-STACK-TOP - 1).

       E-999.
           EXIT.

      ******************************************************************
       H-PROCESS-MERGE SECTION.
      *========================                                        *
      * This section identifies which data is to be merged, and then   *
      * merges the two data streams into a single larger data stream.  *
      ******************************************************************
       H-000.
           INITIALISE WD-FIRST-HALF.
           COMPUTE WD-FH-MAX = WC-MIDDLE - WC-START + 1.
           SET WD-IX                        TO 1.

           PERFORM HA-COPY-OUT VARYING WB-IX-1 FROM WC-START BY 1
                               UNTIL WB-IX-1 > WC-MIDDLE.

           SET WB-IX-1 TO WC-START.
           SET WB-IX-2 TO WC-MIDDLE.
           SET WB-IX-2 UP BY 1.
           SET WD-IX   TO 1.
          
           PERFORM HB-MERGE UNTIL WD-IX > WD-FH-MAX OR WB-IX-2 > WC-END.

           PERFORM HC-COPY-BACK UNTIL WD-IX > WD-FH-MAX.

       H-999.
           EXIT.

       HA-COPY-OUT SECTION.
       HA-000.
           MOVE WB-ENTRY(WB-IX-1) TO WD-ENTRY(WD-IX).
           SET WD-IX UP BY 1.

       HA-999.
           EXIT.

       HB-MERGE SECTION.
       HB-000.
           IF WB-ENTRY(WB-IX-2) < WD-ENTRY(WD-IX)
              MOVE WB-ENTRY(WB-IX-2) TO WB-ENTRY(WB-IX-1)
              SET WB-IX-2            UP BY 1
           ELSE
              MOVE WD-ENTRY(WD-IX) TO WB-ENTRY(WB-IX-1)
              SET WD-IX            UP BY 1.

           SET WB-IX-1 UP BY 1.

       HB-999.
           EXIT.

       HC-COPY-BACK SECTION.
       HC-000.
           MOVE WD-ENTRY(WD-IX) TO WB-ENTRY(WB-IX-1).
           SET WD-IX            UP BY 1.
           SET WB-IX-1          UP BY 1.

       HC-999.
           EXIT.

CoffeeScript

# This is a simple version of mergesort that returns brand-new arrays.
# A more sophisticated version would do more in-place optimizations.
merge_sort = (arr) ->
  if arr.length <= 1
    return (elem for elem in arr)
  m = Math.floor(arr.length / 2)
  arr1 = merge_sort(arr.slice 0, m)
  arr2 = merge_sort(arr.slice m)
  result = []
  p1 = p2 = 0
  while true
    if p1 >= arr1.length
      if p2 >= arr2.length
        return result 
      result.push arr2[p2]
      p2 += 1
    else if p2 >= arr2.length or arr1[p1] < arr2[p2]
      result.push arr1[p1]
      p1 += 1
    else
      result.push arr2[p2]
      p2 += 1

do ->
  console.log merge_sort [2,4,6,8,1,3,5,7,9,10,11,0,13,12]
Output:
> coffee mergesort.coffee 
[ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 ]

Common Lisp

(defun merge-sort (result-type sequence predicate)
   (let ((split (floor (length sequence) 2)))
     (if (zerop split)
       (copy-seq sequence)
       (merge result-type (merge-sort result-type (subseq sequence 0 split) predicate)
                          (merge-sort result-type (subseq sequence split)   predicate)
                          predicate))))

merge is a standard Common Lisp function. 

> (merge-sort 'list (list 1 3 5 7 9 8 6 4 2) #'<)
(1 2 3 4 5 6 7 8 9)

Component Pascal

Works with: BlackBox Component Builder

Inspired by the approach used by the Modula-2[1] application.

This an implementation of the stable merge sort algorithm for linked lists. The merge sort algorithm is often the best choice for sorting a linked list.

The `Sort` procedure reduces the number of traversals by calculating the length only once at the beginning of the sorting process. This optimization leads to a more efficient sorting process, making it faster, especially for large input lists.

Two modules are provided - for implementing and for using the merge sort . 

MODULE RosettaMergeSort;

	

	TYPE Template* = ABSTRACT RECORD END;

	(* Abstract Procedures: *)

	(* Return TRUE if list item`front` comes before list item `rear` in the sorted order, FALSE otherwise *)
	(* For the sort to be stable `front` comes before `rear` if they are equal *)
	PROCEDURE (IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;

	(* Return the next item in the list after `s` *)
	PROCEDURE (IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;

	(* Update the next pointer of list item `s` to the value of list `next` -  Return the modified `s` *)
	PROCEDURE (IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;

	(* Merge sorted lists `front` and `rear` -  Return the merged sorted list *)
	PROCEDURE (IN t: Template) Merge (front, rear: ANYPTR): ANYPTR, NEW;
	BEGIN
		IF front = NIL THEN RETURN rear END;
		IF rear = NIL THEN RETURN front END;
		IF t.Before(front, rear) THEN
			RETURN t.Set(front, t.Merge(t.Next(front), rear))
		ELSE
			RETURN t.Set(rear, t.Merge(front, t.Next(rear)))
		END
	END Merge;

	(* Sort the first `n` items in the list `s` and drop them from `s` *)
	(* Return the sorted `n` items *)
	PROCEDURE (IN t: Template) TakeSort (n: INTEGER; VAR s: ANYPTR): ANYPTR, NEW;
		VAR k: INTEGER; front, rear: ANYPTR;
	BEGIN
		IF n = 1 THEN (* base case: if `n` is 1, return the head of `s` *)
			front := s; s := t.Next(s); RETURN t.Set(front, NIL)
		END;
		(* Divide the first `n` items of `s` into two sorted parts *)
		k := n DIV 2;
		front := t.TakeSort(k, s);
		rear := t.TakeSort(n - k, s);
		RETURN t.Merge(front, rear) (* Return the merged parts *)
	END TakeSort;

	(* Perform a merge sort on `s` -  Return the sorted list *)
	PROCEDURE (IN t: Template) Sort* (s: ANYPTR): ANYPTR, NEW;
		VAR n: INTEGER; r: ANYPTR;
	BEGIN
		IF s = NIL THEN RETURN s END; (* If `s` is empty, return `s` *)
		(* Count of items in `s` *)
		n := 0; r := s; (* Initialize the item to be counted to `s` *)
		WHILE r # NIL DO INC(n); r := t.Next(r) END;
		RETURN t.TakeSort(n, s) (* Return the sorted list *)
	END Sort;

END RosettaMergeSort.

Interface extracted from implementation: 

DEFINITION RosettaMergeSort;

	TYPE
		Template = ABSTRACT RECORD 
			(IN t: Template) Before- (front, rear: ANYPTR): BOOLEAN, NEW, ABSTRACT;
			(IN t: Template) Next- (s: ANYPTR): ANYPTR, NEW, ABSTRACT;
			(IN t: Template) Set- (s, next: ANYPTR): ANYPTR, NEW, ABSTRACT;
			(IN t: Template) Sort (s: ANYPTR): ANYPTR, NEW
		END;

END RosettaMergeSort.

Use the merge sort implementation from `RosettaMergeSort` to sort a linked list of characters: 

MODULE RosettaMergeSortUse;

	(* Import Modules: *)
	IMPORT Sort := RosettaMergeSort, Out;

	(* Type Definitions: *)
	TYPE
		(* a character list *)
		List = POINTER TO RECORD
			value: CHAR;
			next: List
		END;

		(* Implement the abstract record type Sort.Template *)
		Order = ABSTRACT RECORD (Sort.Template) END;
		Asc = RECORD (Order) END;
		Bad = RECORD (Order) END;
		Desc = RECORD (Order) END;

	(* Abstract Procedure Implementations: *)

	(* Return the next node in the linked list *)
	PROCEDURE (IN t: Order) Next (s: ANYPTR): ANYPTR;
	BEGIN RETURN s(List).next END Next;

	(* Set the next pointer of list item `s` to `next` -  Return the updated `s` *)
	PROCEDURE (IN t: Order) Set (s, next: ANYPTR): ANYPTR;
	BEGIN
		IF next = NIL THEN s(List).next := NIL
					  ELSE s(List).next := next(List) END;
		RETURN s
	END Set;

	(* Ignoring case, compare characters to determine ascending order in the sorted list *)
	(* For the sort to be stable `front` comes before `rear` if they are equal *)
	PROCEDURE (IN t: Asc) Before (front, rear: ANYPTR): BOOLEAN;
	BEGIN
		RETURN CAP(front(List).value) <= CAP(rear(List).value)
	END Before;

	(* Unstable sort!!! *)
	PROCEDURE (IN t: Bad) Before (front, rear: ANYPTR): BOOLEAN;
	BEGIN
		RETURN CAP(front(List).value) < CAP(rear(List).value)
	END Before;

	(* Ignoring case, compare characters to determine descending order in the sorted list *)
	(* For the sort to be stable `front` comes before `rear` if they are equal *)
	PROCEDURE (IN t: Desc) Before (front, rear: ANYPTR): BOOLEAN;
	BEGIN
		RETURN CAP(front(List).value) >= CAP(rear(List).value)
	END Before;

	(* Helper Procedures: *)

	(* Takes a string and converts it into a linked list of characters *)
	PROCEDURE Explode (str: ARRAY OF CHAR): List;
		VAR i: INTEGER; h, t: List;
	BEGIN
		i := LEN(str$);
		WHILE i # 0 DO
			t := h; NEW(h);
			DEC(i); h.value := str[i];
			h.next := t
		END;
		RETURN h
	END Explode;

	(* Outputs the characters in a linked list as a string in quotes *)
	PROCEDURE Show (s: List);
		VAR i: INTEGER;
	BEGIN
		Out.Char('"');
		WHILE s # NIL DO Out.Char(s.value); s := s.next END;
		Out.Char('"')
	END Show;

	(* Main Procedure: *)
	PROCEDURE Use*;
		VAR a: Asc; b: Bad; d: Desc; s: List;
	BEGIN
		s := Explode("A quick brown fox jumps over the lazy dog");
		Out.String("Before:"); Out.Ln; Show(s); Out.Ln;
		s := a.Sort(s)(List); (* Ascending stable sort *)
		Out.String("After Asc:"); Out.Ln; Show(s); Out.Ln;
		s := b.Sort(s)(List); (* Ascending unstable sort *)
		Out.String("After Bad:"); Out.Ln; Show(s); Out.Ln;
		s := d.Sort(s)(List); (* Descending stable sort *)
		Out.String("After Desc:"); Out.Ln; Show(s); Out.Ln
	END Use;


END RosettaMergeSortUse.

Execute: ^Q RosettaMergeSortUse.Use

Output:
Before:
"A quick brown fox jumps over the lazy dog"
After Asc:
"        Aabcdeefghijklmnoooopqrrstuuvwxyz"
After Bad:
"        aAbcdeefghijklmnoooopqrrstuuvwxyz"
After Desc:
"zyxwvuutsrrqpoooonmlkjihgfeedcbaA        "

Crystal

Translation of: Ruby
def merge_sort(a : Array(Int32)) : Array(Int32)
  return a if a.size <= 1
  m = a.size // 2
  lt = merge_sort(a[0 ... m])
  rt = merge_sort(a[m .. -1])
  return merge(lt, rt)
end
 
def merge(lt : Array(Int32), rt : Array(Int32)) : Array(Int32)
  result = Array(Int32).new
  until lt.empty? || rt.empty?
    result << (lt.first < rt.first ? lt.shift : rt.shift)
  end
  return result + lt + rt
end
 
a = [7, 6, 5, 9, 8, 4, 3, 1, 2, 0]
puts merge_sort(a) # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]

Curry

Copied from Curry: Example Programs 

-- merge sort: sorting two lists by merging the sorted first
-- and second half of the list

sort :: ([a] -> [a] -> [a] -> Success) -> [a] -> [a] -> Success

sort merge xs ys =
   if length xs < 2 then ys =:= xs
   else sort merge (firsthalf xs) us
        & sort merge (secondhalf xs) vs
        & merge us vs ys
   where us,vs free


intMerge :: [Int] -> [Int] -> [Int] -> Success

intMerge []     ys     zs =  zs =:= ys
intMerge (x:xs) []     zs =  zs =:= x:xs
intMerge (x:xs) (y:ys) zs =
   if (x > y) then intMerge (x:xs) ys us & zs =:= y:us
              else intMerge xs (y:ys) vs & zs =:= x:vs
   where us,vs free
  
firsthalf  xs = take (length xs `div` 2) xs
secondhalf xs = drop (length xs `div` 2) xs



goal1 xs = sort intMerge [3,1,2] xs
goal2 xs = sort intMerge [3,1,2,5,4,8] xs
goal3 xs = sort intMerge [3,1,2,5,4,8,6,7,2,9,1,4,3] xs

D

Arrays only, not in-place. 

import std.stdio, std.algorithm, std.array, std.range;

T[] mergeSorted(T)(in T[] D) /*pure nothrow @safe*/ {
    if (D.length < 2)
        return D.dup;
    return [D[0 .. $ / 2].mergeSorted, D[$ / 2 .. $].mergeSorted]
           .nWayUnion.array;
}

void main() {
    [3, 4, 2, 5, 1, 6].mergeSorted.writeln;
}

Alternative Version

This in-place version allocates the auxiliary memory on the stack, making life easier for the garbage collector, but with risk of stack overflow (same output): 

import std.stdio, std.algorithm, core.stdc.stdlib, std.exception,
       std.range;

void mergeSort(T)(T[] data) if (hasSwappableElements!(typeof(data))) {
    immutable L = data.length;
    if (L < 2) return;
    T* ptr = cast(T*)alloca(L * T.sizeof);
    enforce(ptr != null);
    ptr[0 .. L] = data[];
    mergeSort(ptr[0 .. L/2]);
    mergeSort(ptr[L/2 .. L]);
    [ptr[0 .. L/2], ptr[L/2 .. L]].nWayUnion().copy(data);
}

void main() {
    auto a = [3, 4, 2, 5, 1, 6];
    a.mergeSort();
    writeln(a);
}

Dart

void main() {
  MergeSortInDart sampleSort = MergeSortInDart();

  List<int> theResultingList = sampleSort.sortTheList([54, 89, 125, 47899, 32, 61, 42, 895647, 215, 345, 6, 21, 2, 78]);

  print('Here\'s the sorted list: ${theResultingList}');
}

/////////////////////////////////////

class MergeSortInDart {

  List<int> sortedList;

  // In Dart we often put helper functions at the bottom.
  // You could put them anywhere, we just like it this way
  // for organizational purposes. It's nice to be able to
  // read them in the order they're called.

  // Start here
  List<int> sortTheList(List<int> sortThis){
    // My parameters are listed vertically for readability. Dart
    // doesn't care how you list them, vertically or horizontally.
    sortedList = mSort(
      sortThis,
      sortThis.sublist(0, sortThis.length),
      sortThis.length,
    );
    return sortThis;
  }

  mSort(
    List<int> sortThisList,
    List<int> tempList,
    int thisListLength) {

    if (thisListLength == 1) {
      return;
    }

    // In Dart using ~/ is more efficient than using .floor()
    int middle = (thisListLength ~/ 2);

    // If you use something in a try/on/catch/finally block then
    // be sure to declare it outside the block (for scope)
    List<int> tempLeftList;

    // This was used for troubleshooting. It was left here to show
    // how a basic block try/on can be better than a debugPrint since
    // it won't print unless there's a problem.
    try {
      tempLeftList = tempList.sublist(0, middle);
    } on RangeError {
      print(
          'tempLeftList length = ${tempList.length}, thisListLength '
            'was supposedly $thisListLength and Middle was $middle');
    }

    // If you see "myList.getRange(x,y)" that's a sign the code is
    // from Dart 1 and needs to be updated. It's "myList.sublist" in Dart 2
    List<int> tempRightList = tempList.sublist(middle);

    // Left side.
    mSort(
      tempLeftList,
      sortThisList.sublist(0, middle),
      middle,
    );

    // Right side.
    mSort(
      tempRightList,
      sortThisList.sublist(middle),
      sortThisList.length - middle,
    );

    // Merge it.
    dartMerge(
      tempLeftList,
      tempRightList,
      sortThisList,
    );
  }

  dartMerge(
    List<int> leftSide,
    List<int> rightSide,
    List<int> sortThisList,
    ) {
    int index = 0;
    int elementValue;

    // This should be human readable.
    while (leftSide.isNotEmpty && rightSide.isNotEmpty) {
      if (rightSide[0] < leftSide[0]) {
        elementValue = rightSide[0];
        rightSide.removeRange(0, 1);
      } else {
        elementValue = leftSide[0];
        leftSide.removeRange(0, 1);
      }
      sortThisList[index++] = elementValue;
    }

    while (leftSide.isNotEmpty) {
      elementValue = leftSide[0];
      leftSide.removeRange(0, 1);
      sortThisList[index++] = elementValue;
    }

    while (rightSide.isNotEmpty) {
      elementValue = rightSide[0];
      rightSide.removeRange(0, 1);
      sortThisList[index++] = elementValue;
    }
    sortedList = sortThisList;
  }
}

Delphi

See Pascal.

E

def merge(var xs :List, var ys :List) {
    var result := []
    while (xs =~ [x] + xr && ys =~ [y] + yr) {
        if (x <= y) {
            result with= x
            xs := xr
        } else {
            result with= y
            ys := yr
        }
    }
    return result + xs + ys
}

def sort(list :List) {
    if (list.size() <= 1) { return list }
    def split := list.size() // 2
    return merge(sort(list.run(0, split)),
                 sort(list.run(split)))
}

EasyLang

proc sort . d[] .
   len tmp[] len d[]
   sz = 1
   while sz < len d[]
      swap tmp[] d[]
      left = 1
      while left < len d[]
         # merge
         mid = left + sz - 1
         if mid > len d[]
            mid = len d[]
         .
         right = mid + sz
         if right > len d[]
            right = len d[]
         .
         l = left
         r = mid + 1
         for i = left to right
            if r > right or l <= mid and tmp[l] < tmp[r]
               d[i] = tmp[l]
               l += 1
            else
               d[i] = tmp[r]
               r += 1
            .
         .
         left += 2 * sz
      .
      sz *= 2
   .
.
data[] = [ 29 4 72 44 55 26 27 77 92 5 ]
sort data[]
print data[]

Eiffel

class
	MERGE_SORT [G -> COMPARABLE]

create
	sort

feature

	sort (ar: ARRAY [G])
			-- Sorted array in ascending order.
		require
			ar_not_empty: not ar.is_empty
		do
			create sorted_array.make_empty
			mergesort (ar, 1, ar.count)
			sorted_array := ar
		ensure
			sorted_array_not_empty: not sorted_array.is_empty
			sorted: is_sorted (sorted_array, 1, sorted_array.count)
		end

	sorted_array: ARRAY [G]

feature {NONE}

	mergesort (ar: ARRAY [G]; l, r: INTEGER)
			-- Sorting part of mergesort.
		local
			m: INTEGER
		do
			if l < r then
				m := (l + r) // 2
				mergesort (ar, l, m)
				mergesort (ar, m + 1, r)
				merge (ar, l, m, r)
			end
		end

	merge (ar: ARRAY [G]; l, m, r: INTEGER)
			-- Merge part of mergesort.
		require
			positive_index_l: l >= 1
			positive_index_m: m >= 1
			positive_index_r: r >= 1
			ar_not_empty: not ar.is_empty
		local
			merged: ARRAY [G]
			h, i, j, k: INTEGER
		do
			i := l
			j := m + 1
			k := l
			create merged.make_filled (ar [1], 1, ar.count)
			from
			until
				i > m or j > r
			loop
				if ar.item (i) <= ar.item (j) then
					merged.force (ar.item (i), k)
					i := i + 1
				elseif ar.item (i) > ar.item (j) then
					merged.force (ar.item (j), k)
					j := j + 1
				end
				k := k + 1
			end
			if i > m then
				from
					h := j
				until
					h > r
				loop
					merged.force (ar.item (h), k + h - j)
					h := h + 1
				end
			elseif j > m then
				from
					h := i
				until
					h > m
				loop
					merged.force (ar.item (h), k + h - i)
					h := h + 1
				end
			end
			from
				h := l
			until
				h > r
			loop
				ar.item (h) := merged.item (h)
				h := h + 1
			end
		ensure
			is_partially_sorted: is_sorted (ar, l, r)
		end

	is_sorted (ar: ARRAY [G]; l, r: INTEGER): BOOLEAN
			-- Is 'ar' sorted in ascending order?
		require
			ar_not_empty: not ar.is_empty
			l_in_range: l >= 1
			r_in_range: r <= ar.count
		local
			i: INTEGER
		do
			Result := True
			from
				i := l
			until
				i = r
			loop
				if ar [i] > ar [i + 1] then
					Result := False
				end
				i := i + 1
			end
		end

end

Test: 

class
	APPLICATION

create
	make

feature

	make
		do
			test := <<2, 5, 66, -2, 0, 7>>
			io.put_string ("unsorted" + "%N")
			across
				test as ar
			loop
				io.put_string (ar.item.out + "%T")
			end
			io.put_string ("%N" + "sorted" + "%N")
			create merge.sort (test)
			across
				merge.sorted_array as ar
			loop
				io.put_string (ar.item.out + "%T")
			end
		end

	test: ARRAY [INTEGER]

	merge: MERGE_SORT [INTEGER]

end
Output:
unsorted
2 5 66 -2 0 7
sorted
-2 0 2 5 7 66

Elixir

defmodule Sort do
  def merge_sort(list) when length(list) <= 1, do: list
  def merge_sort(list) do
    {left, right} = Enum.split(list, div(length(list), 2))
    :lists.merge( merge_sort(left), merge_sort(right))
  end
end

Example: 

iex(10)> Sort.merge_sort([5,3,9,4,1,6,8,2,7])
[1, 2, 3, 4, 5, 6, 7, 8, 9]

Erlang

Below are two versions. Both take advantage of built-in Erlang functions, lists:split and list:merge. The multi-process version spawns a new process each time it splits. This was slightly faster on a test system with only two cores, so it may not be the best implementation, however it does illustrate how easy it can be to add multi-threaded/process capabilities to a program.

Single-threaded version: 

mergeSort(L) when length(L) == 1 -> L;
mergeSort(L) when length(L) > 1 ->
    {L1, L2} = lists:split(length(L) div 2, L),
    lists:merge(mergeSort(L1), mergeSort(L2)).

Multi-process version: 

pMergeSort(L) when length(L) == 1 -> L;
pMergeSort(L) when length(L) > 1 ->
    {L1, L2} = lists:split(length(L) div 2, L),
    spawn(mergesort, pMergeSort2, [L1, self()]),
    spawn(mergesort, pMergeSort2, [L2, self()]),
    mergeResults([]).

pMergeSort2(L, Parent) when length(L) == 1 -> Parent ! L;
pMergeSort2(L, Parent) when length(L) > 1 ->
    {L1, L2} = lists:split(length(L) div 2, L),
    spawn(mergesort, pMergeSort2, [L1, self()]),
    spawn(mergesort, pMergeSort2, [L2, self()]),
    Parent ! mergeResults([]).


another multi-process version (number of processes == number of processor cores): 

merge_sort(List) -> m(List, erlang:system_info(schedulers)).

m([L],_) -> [L]; 
m(L, N) when N > 1  -> 
    {L1,L2} = lists:split(length(L) div 2, L),
    {Parent, Ref} = {self(), make_ref()},
    spawn(fun()-> Parent ! {l1, Ref, m(L1, N-2)} end), 
    spawn(fun()-> Parent ! {l2, Ref, m(L2, N-2)} end), 
    {L1R, L2R} = receive_results(Ref, undefined, undefined),
    lists:merge(L1R, L2R);
m(L, _) -> {L1,L2} = lists:split(length(L) div 2, L), lists:merge(m(L1, 0), m(L2, 0)).

receive_results(Ref, L1, L2) ->
    receive
        {l1, Ref, L1R} when L2 == undefined -> receive_results(Ref, L1R, L2);
        {l2, Ref, L2R} when L1 == undefined -> receive_results(Ref, L1, L2R);
        {l1, Ref, L1R} -> {L1R, L2};
        {l2, Ref, L2R} -> {L1, L2R}
    after 5000 -> receive_results(Ref, L1, L2)
    end.

ERRE

PROGRAM MERGESORT_DEMO

! Example of merge sort usage.

CONST SIZE%=100,S1%=50

DIM DTA%[SIZE%],FH%[S1%],STACK%[20,2]


PROCEDURE MERGE(START%,MIDDLE%,ENDS%)

LOCAL FHSIZE%

  FHSIZE%=MIDDLE%-START%+1

  FOR I%=0 TO FHSIZE%-1 DO
     FH%[I%]=DTA%[START%+I%]
  END FOR

  I%=0
  J%=MIDDLE%+1
  K%=START%

  REPEAT
    IF FH%[I%]<=DTA%[J%] THEN
        DTA%[K%]=FH%[I%]
        I%=I%+1
        K%=K%+1
      ELSE
        DTA%[K%]=DTA%[J%]
        J%=J%+1
        K%=K%+1
    END IF
  UNTIL I%=FHSIZE% OR J%>ENDS%

  WHILE I%<FHSIZE% DO
     DTA%[K%]=FH%[I%]
     I%=I%+1
     K%=K%+1
  END WHILE

END PROCEDURE

PROCEDURE MERGE_SORT(LEV->LEV)

! *****************************************************************
! This procedure Merge Sorts the chunk of DTA% bounded by
! Start% & Ends%.
! *****************************************************************

   LOCAL MIDDLE%

   IF ENDS%=START% THEN LEV=LEV-1 EXIT PROCEDURE END IF

   IF ENDS%-START%=1 THEN
      IF DTA%[ENDS%]<DTA%[START%] THEN
         SWAP(DTA%[START%],DTA%[ENDS%])
      END IF
      LEV=LEV-1
      EXIT PROCEDURE
   END IF

   MIDDLE%=START%+(ENDS%-START%)/2

   STACK%[LEV,0]=START%  STACK%[LEV,1]=ENDS%  STACK%[LEV,2]=MIDDLE%
   START%=START%  ENDS%=MIDDLE%
   MERGE_SORT(LEV+1->LEV)
   START%=STACK%[LEV,0]  ENDS%=STACK%[LEV,1]  MIDDLE%=STACK%[LEV,2]

   STACK%[LEV,0]=START%  STACK%[LEV,1]=ENDS%  STACK%[LEV,2]=MIDDLE%
   START%=MIDDLE%+1  ENDS%=ENDS%
   MERGE_SORT(LEV+1->LEV)
   START%=STACK%[LEV,0]  ENDS%=STACK%[LEV,1]  MIDDLE%=STACK%[LEV,2]

   MERGE(START%,MIDDLE%,ENDS%)

   LEV=LEV-1
END PROCEDURE

BEGIN
  FOR I%=1 TO SIZE% DO
     DTA%[I%]=RND(1)*10000
  END FOR

  START%=1  ENDS%=SIZE%
  MERGE_SORT(0->LEV)

  FOR I%=1 TO SIZE% DO
     WRITE("#####";DTA%[I%];)
  END FOR
  PRINT
END PROGRAM

Euphoria

function merge(sequence left, sequence right)
    sequence result
    result = {}
    while length(left) > 0 and length(right) > 0 do
        if compare(left[1], right[1]) <= 0 then
            result = append(result, left[1])
            left = left[2..$]
        else
            result = append(result, right[1])
            right = right[2..$]
        end if
    end while
    return result & left & right
end function

function mergesort(sequence m)
    sequence left, right
    integer middle
    if length(m) <= 1 then
        return m
    else
        middle = floor(length(m)/2)
        left = mergesort(m[1..middle])
        right = mergesort(m[middle+1..$])
        if compare(left[$], right[1]) <= 0 then
            return left & right
        elsif compare(right[$], left[1]) <= 0 then
            return right & left
        else
            return merge(left, right)
        end if
    end if
end function

constant s = rand(repeat(1000,10))
? s
? mergesort(s)
Output:
{385,599,284,650,457,804,724,300,434,722}
{284,300,385,434,457,599,650,722,724,804}

F#

let split list =
    let rec aux l acc1 acc2 =
        match l with
            | [] -> (acc1,acc2)
            | [x] -> (x::acc1,acc2)
            | x::y::tail ->
                aux tail (x::acc1) (y::acc2)
    in aux list [] []

let rec merge l1 l2 =
    match (l1,l2) with
        | (x,[]) -> x
        | ([],y) -> y
        | (x::tx,y::ty) ->
            if x <= y then x::merge tx l2
            else y::merge l1 ty
let rec mergesort list = 
    match list with
        | [] -> []
        | [x] -> [x]
        | _ -> let (l1,l2) = split list
               in merge (mergesort l1) (mergesort l2)

Factor

: mergestep ( accum seq1 seq2 -- accum seq1 seq2 )
2dup [ first ] bi@ <
[ [ [ first ] [ rest-slice ] bi [ suffix ] dip ] dip ]
[ [ first ] [ rest-slice ] bi [ swap [ suffix ] dip ] dip ]
if ;

: merge ( seq1 seq2 -- merged )
[ { } ] 2dip
[ 2dup [ length 0 > ] bi@ and ]
[ mergestep ] while
append append ;

: mergesort ( seq -- sorted )
dup length 1 >
[ dup length 2 / floor [ head ] [ tail ] 2bi [ mergesort ] bi@ merge ]
[ ] if ;

( scratchpad ) { 4 2 6 5 7 1 3 } mergesort .
{ 1 2 3 4 5 6 7 }

Forth

This is an in-place mergesort which works on arrays of integers. 

: merge-step ( right mid left -- right mid+ left+ )
  over @ over @ < if
    over @ >r
    2dup - over dup cell+ rot move
    r> over !
    >r cell+ 2dup = if rdrop dup else r> then
  then cell+ ;
: merge ( right mid left -- right left )
  dup >r begin 2dup > while merge-step repeat 2drop r> ;

: mid ( l r -- mid ) over - 2/ cell negate and + ;

: mergesort ( right left -- right left )
  2dup cell+ <= if exit then
  swap 2dup mid recurse rot recurse merge ;
  
: sort ( addr len -- )  cells over + swap mergesort 2drop ;

create test 8 , 1 , 5 , 3 , 9 , 0 , 2 , 7 , 6 , 4 ,

: .array ( addr len -- ) 0 do dup i cells + @ . loop drop ;

test 10 2dup sort .array       \ 0 1 2 3 4 5 6 7 8 9

Fortran

Works with: Fortran version 95 and later and with both free or fixed form syntax.
      program TestMergeSort
        implicit none
        integer, parameter :: N = 8
        integer :: A(N) = (/ 1, 5, 2, 7, 3, 9, 4, 6 /)
        integer :: work((size(A) + 1) / 2)
        write(*,'(A,/,10I3)')'Unsorted array :',A
        call MergeSort(A, work)
        write(*,'(A,/,10I3)')'Sorted array :',A
      contains

      subroutine merge(A, B, C)
        implicit none
! The targe attribute is necessary, because A .or. B might overlap with C.
        integer, target, intent(in) :: A(:), B(:)
        integer, target, intent(inout) :: C(:)
        integer :: i, j, k

        if (size(A) + size(B) > size(C)) stop(1)

        i = 1; j = 1
        do k = 1, size(C)
          if (i <= size(A) .and. j <= size(B)) then
            if (A(i) <= B(j)) then
              C(k) = A(i)
              i = i + 1
            else
              C(k) = B(j)
              j = j + 1
            end if
          else if (i <= size(A)) then
            C(k) = A(i)
            i = i + 1
          else if (j <= size(B)) then
            C(k) = B(j)
            j = j + 1
          end if
        end do
      end subroutine merge

      subroutine swap(x, y)
        implicit none
        integer, intent(inout) :: x, y
        integer :: tmp
        tmp = x; x = y; y = tmp
      end subroutine

      recursive subroutine MergeSort(A, work)
        implicit none
        integer, intent(inout) :: A(:)
        integer, intent(inout) :: work(:)
        integer :: half
        half = (size(A) + 1) / 2
        if (size(A) < 2) then
          continue
        else if (size(A) == 2) then
          if (A(1) > A(2)) then
            call swap(A(1), A(2))
          end if
        else
          call MergeSort(A( : half), work)
          call MergeSort(A(half + 1 :), work)
          if (A(half) > A(half + 1)) then
            work(1 : half) = A(1 : half)
            call merge(work(1 : half), A(half + 1:), A)
          endif
        end if
      end subroutine MergeSort
      end program TestMergeSort

FreeBASIC

Uses 'top down' C-like algorithm in Wikipedia article: 

' FB 1.05.0 Win64

Sub copyArray(a() As Integer, iBegin As Integer, iEnd As Integer, b() As Integer)
  Redim b(iBegin To iEnd - 1) As Integer
  For k As Integer = iBegin To iEnd - 1
    b(k) = a(k)
  Next
End Sub

' Left source half is  a(iBegin  To iMiddle-1).
' Right source half is a(iMiddle To iEnd-1).
' Result is            b(iBegin  To iEnd-1).
Sub topDownMerge(a() As Integer, iBegin As Integer, iMiddle As Integer, iEnd As Integer, b() As Integer)
  Dim i As Integer = iBegin
  Dim j As Integer = iMiddle
    
  ' While there are elements in the left or right runs...
  For k As Integer = iBegin To iEnd - 1 
  ' If left run head exists and is <= existing right run head.
    If i < iMiddle AndAlso (j >= iEnd OrElse a(i) <= a(j)) Then
      b(k) = a(i)
      i += 1
    Else
      b(k) = a(j)
      j += 1    
    End If
  Next 
End Sub

' Sort the given run of array a() using array b() as a source.
' iBegin is inclusive; iEnd is exclusive (a(iEnd) is not in the set).
Sub topDownSplitMerge(b() As Integer, iBegin As Integer, iEnd As Integer, a() As Integer)
  If (iEnd - iBegin) < 2 Then Return  '' If run size = 1, consider it sorted
  ' split the run longer than 1 item into halves
  Dim iMiddle As Integer = (iEnd + iBegin) \ 2  '' iMiddle = mid point
  ' recursively sort both runs from array a() into b()
  topDownSplitMerge(a(), iBegin,  iMiddle, b())  '' sort the left  run
  topDownSplitMerge(a(), iMiddle, iEnd, b())     '' sort the right run
  ' merge the resulting runs from array b() into a()
  topDownMerge(b(), iBegin, iMiddle, iEnd, a())
End Sub

' Array a() has the items to sort; array b() is a work array (empty initially).      
Sub topDownMergeSort(a() As Integer, b() As Integer, n As Integer)
  copyArray(a(), 0, n, b())  '' duplicate array a() into b()           
  topDownSplitMerge(b(), 0, n, a())  '' sort data from b() into a()
End Sub

Sub printArray(a() As Integer)
  For i As Integer = LBound(a) To UBound(a)
    Print Using "####"; a(i);
  Next
  Print
End Sub

Dim a(0 To 9) As Integer = {4, 65, 2, -31, 0, 99, 2, 83, 782, 1}

Dim b() As Integer
Print "Unsorted : ";
printArray(a())
topDownMergeSort a(), b(), 10
Print "Sorted   : ";
printArray(a())
Print
Dim a2(0 To 8) As Integer = {7, 5, 2, 6, 1, 4, 2, 6, 3}
Erase b
Print "Unsorted : ";
printArray(a2())
topDownMergeSort a2(), b(), 9
Print "Sorted   : ";
printArray(a2())
Print
Print "Press any key to quit"
Sleep
Output:
Unsorted :    4  65   2 -31   0  99   2  83 782   1
Sorted   :  -31   0   1   2   2   4  65  83  99 782

Unsorted :    7   5   2   6   1   4   2   6   3
Sorted   :    1   2   2   3   4   5   6   6   7

FunL

def
  sort( [] )          =  []
  sort( [x] )         =  [x]
  sort( xs )          =
    val (l, r) = xs.splitAt( xs.length()\2 )
    merge( sort(l), sort(r) )

  merge( [], xs )     =  xs
  merge( xs, [] )     =  xs
  merge( x:xs, y:ys )
    | x <= y          =  x : merge( xs, y:ys )
    | otherwise       =  y : merge( x:xs, ys )
    
println( sort([94, 37, 16, 56, 72, 48, 17, 27, 58, 67]) )
println( sort(['Sofía', 'Alysha', 'Sophia', 'Maya', 'Emma', 'Olivia', 'Emily']) )
Output:
[16, 17, 27, 37, 48, 56, 58, 67, 72, 94]
[Alysha, Emily, Emma, Maya, Olivia, Sofía, Sophia]

Go

package main

import "fmt"

var a = []int{170, 45, 75, -90, -802, 24, 2, 66}
var s = make([]int, len(a)/2+1) // scratch space for merge step

func main() {
    fmt.Println("before:", a)
    mergeSort(a)
    fmt.Println("after: ", a)
}

func mergeSort(a []int) {
    if len(a) < 2 {
        return
    }
    mid := len(a) / 2
    mergeSort(a[:mid])
    mergeSort(a[mid:])
    if a[mid-1] <= a[mid] {
        return
    }
    // merge step, with the copy-half optimization
    copy(s, a[:mid])
    l, r := 0, mid
    for i := 0; ; i++ {
        if s[l] <= a[r] {
            a[i] = s[l]
            l++
            if l == mid {
                break
            }
        } else {
            a[i] = a[r]
            r++
            if r == len(a) {
                copy(a[i+1:], s[l:mid])
                break
            }
        }
    }
    return
}

Groovy

This is the standard algorithm, except that in the looping phase of the merge we work backwards through the left and right lists to construct the merged list, to take advantage of the Groovy List.pop() method. However, this results in a partially merged list in reverse sort order; so we then reverse it to put in back into correct order. This could play havoc with the sort stability, but we compensate by picking aggressively from the right list (ties go to the right), rather than aggressively from the left as is done in the standard algorithm. 

def merge = { List left, List right ->
    List mergeList = []
    while (left && right) {
        print "."
        mergeList << ((left[-1] > right[-1]) ? left.pop() : right.pop())
    }
    mergeList = mergeList.reverse()
    mergeList = left + right + mergeList
}

def mergeSort;
mergeSort = { List list ->

    def n = list.size()
    if (n < 2) return list
    
    def middle = n.intdiv(2)
    def left = [] + list[0..<middle]
    def right = [] + list[middle..<n]
    left = mergeSort(left)
    right = mergeSort(right)
    
    if (left[-1] <= right[0]) return left + right
    
    merge(left, right)
}

Test: 

println (mergeSort([23,76,99,58,97,57,35,89,51,38,95,92,24,46,31,24,14,12,57,78,4]))
println (mergeSort([88,18,31,44,4,0,8,81,14,78,20,76,84,33,73,75,82,5,62,70,12,7,1]))
println ()
println (mergeSort([10, 10.0, 10.00, 1]))
println (mergeSort([10, 10.00, 10.0, 1]))
println (mergeSort([10.0, 10, 10.00, 1]))
println (mergeSort([10.0, 10.00, 10, 1]))
println (mergeSort([10.00, 10, 10.0, 1]))
println (mergeSort([10.00, 10.0, 10, 1]))

The presence of decimal and integer versions of the same numbers, demonstrates, but of course does not prove, that the sort remains stable.

Output:
.............................................................[4, 12, 14, 23, 24, 24, 31, 35, 38, 46, 51, 57, 57, 58, 76, 78, 89, 92, 95, 97, 99]
....................................................................[0, 1, 4, 5, 7, 8, 12, 14, 18, 20, 31, 33, 44, 62, 70, 73, 75, 76, 78, 81, 82, 84, 88]

....[1, 10, 10.0, 10.00]
....[1, 10, 10.00, 10.0]
....[1, 10.0, 10, 10.00]
....[1, 10.0, 10.00, 10]
....[1, 10.00, 10, 10.0]
....[1, 10.00, 10.0, 10]

Tail recursion version

It is possible to write a version based on tail recursion, similar to that written in Haskell, OCaml or F#. This version also takes into account stack overflow problems induced by recursion for large lists using closure trampolines: 

split = { list ->
    list.collate((list.size()+1)/2 as int)
}

merge = { left, right, headBuffer=[] ->
    if(left.size() == 0) headBuffer+right
    else if(right.size() == 0) headBuffer+left
    else if(left.head() <= right.head()) merge.trampoline(left.tail(), right, headBuffer+left.head())
    else merge.trampoline(right.tail(), left, headBuffer+right.head())
}.trampoline()

mergesort = { List list ->
    if(list.size() < 2) list
    else merge(split(list).collect {mergesort it})
}

assert mergesort((500..1)) == (1..500)
assert mergesort([5,4,6,3,1,2]) == [1,2,3,4,5,6]
assert mergesort([3,3,1,4,6,78,9,1,3,5]) == [1,1,3,3,3,4,5,6,9,78]

which uses List.collate(), alternatively one could write a purely recursive split() closure as: 

split = { list, left=[], right=[] ->
    if(list.size() <2) [list+left, right]
    else split.trampoline(list.tail().tail(), [list.head()]+left,[list.tail().head()]+right)
}.trampoline()

Haskell

Splitting in half in the middle like the normal merge sort does would be inefficient on the singly-linked lists used in Haskell (since you would have to do one pass just to determine the length, and then another half-pass to do the splitting). Instead, the algorithm here splits the list in half in a different way -- by alternately assigning elements to one list and the other. That way we (lazily) construct both sublists in parallel as we traverse the original list. Unfortunately, under this way of splitting we cannot do a stable sort. 

merge []         ys                   = ys
merge xs         []                   = xs
merge xs@(x:xt) ys@(y:yt) | x <= y    = x : merge xt ys
                          | otherwise = y : merge xs yt

split (x:y:zs) = let (xs,ys) = split zs in (x:xs,y:ys)
split [x]      = ([x],[])
split []       = ([],[])

mergeSort []  = []
mergeSort [x] = [x]
mergeSort xs  = let (as,bs) = split xs
                in merge (mergeSort as) (mergeSort bs)

Alternatively, we can use bottom-up mergesort. This starts with lots of tiny sorted lists, and repeatedly merges pairs of them, building a larger and larger sorted list 

mergePairs (sorted1 : sorted2 : sorteds) = merge sorted1 sorted2 : mergePairs sorteds
mergePairs sorteds = sorteds

mergeSortBottomUp list = mergeAll (map (\x -> [x]) list)

mergeAll [sorted] = sorted
mergeAll sorteds = mergeAll (mergePairs sorteds)

The standard library's sort function in GHC takes a similar approach to the bottom-up code, the differece being that, instead of starting with lists of size one, which are sorted by default, it detects runs in original list and uses those: 

sort = sortBy compare
sortBy cmp = mergeAll . sequences
  where
    sequences (a:b:xs)
      | a `cmp` b == GT = descending b [a]  xs
      | otherwise       = ascending  b (a:) xs
    sequences xs = [xs]

    descending a as (b:bs)
      | a `cmp` b == GT = descending b (a:as) bs
    descending a as bs  = (a:as): sequences bs

    ascending a as (b:bs)
      | a `cmp` b /= GT = ascending b (\ys -> as (a:ys)) bs
    ascending a as bs   = as [a]: sequences bs

In this code, mergeAll, mergePairs, and merge are as above, except using the specialized cmp function in merge.

Icon and Unicon

procedure main()                                                         #: demonstrate various ways to sort a list and string 
   demosort(mergesort,[3, 14, 1, 5, 9, 2, 6, 3],"qwerty")
end

procedure mergesort(X,op,lower,upper)                                    #: return sorted list ascending(or descending)
local middle

   if /lower := 1 then {                                                 # top level call setup
      upper := *X   
      op := sortop(op,X)                                                 # select how and what we sort
      }
	  
   if upper ~= lower then {                                              # sort all sections with 2 or more elements
      X := mergesort(X,op,lower,middle := lower + (upper - lower) / 2)
      X := mergesort(X,op,middle+1,upper)
   
      if op(X[middle+1],X[middle]) then                                  # @middle+1 < @middle merge if halves reversed
         X := merge(X,op,lower,middle,upper)
   }	  
   return X                                                              
end

procedure merge(X,op,lower,middle,upper)                                 # merge two list sections within a larger list
local p1,p2,add

   p1 := lower
   p2 := middle + 1
   add := if type(X) ~== "string" then put else "||"                     # extend X, strings require X := add (until ||:= is invocable)
 
   while p1 <= middle & p2 <= upper do 
      if op(X[p1],X[p2]) then {                                          # @p1 < @p2
         X := add(X,X[p1])                                               # extend X temporarily (rather than use a separate temporary list)
         p1 +:= 1
         }
      else {
         X := add(X,X[p2])                                               # extend X temporarily
         p2 +:= 1
         }
		 
   while X := add(X,X[middle >= p1]) do p1 +:= 1                         # and rest of lower or ...
   while X := add(X,X[upper  >= p2]) do p2 +:= 1                         # ... upper trailers if any 
   
   if type(X) ~== "string" then                                          # pull section's sorted elements from extension
      every X[upper to lower by -1] := pull(X)
   else	  
      (X[lower+:(upper-lower+1)] := X[0-:(upper-lower+1)])[0-:(upper-lower+1)] := ""
   
   return X 
end

Note: This example relies on the supporting procedures 'sortop', and 'demosort' in Bubble Sort. The full demosort exercises the named sort of a list with op = "numeric", "string", ">>" (lexically gt, descending),">" (numerically gt, descending), a custom comparator, and also a string.

Output:

Abbreviated sample 

Sorting Demo using procedure mergesort
  on list : [ 3 14 1 5 9 2 6 3 ]
    with op = &null:         [ 1 2 3 3 5 6 9 14 ]   (0 ms)
  ...
  on string : "qwerty"
    with op = &null:         "eqrtwy"   (0 ms)

Io

List do (
    merge := method(lst1, lst2,
        result := list()
        while(lst1 isNotEmpty or lst2 isNotEmpty,
            if(lst1 first <= lst2 first) then(
                result append(lst1 removeFirst)
            ) else (
                result append(lst2 removeFirst)
            )
        )
    result)

    mergeSort := method(
        if (size > 1) then(
            half_size := (size / 2) ceil
            return merge(slice(0, half_size) mergeSort,
                         slice(half_size, size) mergeSort)
        ) else (return self)
    )

    mergeSortInPlace := method(
        copy(mergeSort)
    )
)

lst := list(9, 5, 3, -1, 15, -2)
lst mergeSort println # ==> list(-2, -1, 3, 5, 9, 15)
lst mergeSortInPlace println # ==> list(-2, -1, 3, 5, 9, 15)

Isabelle

theory Mergesort
  imports Main
begin

fun merge :: "int list ⇒ int list ⇒ int list" where
  "merge [] ys = ys"
| "merge xs [] = xs"
| "merge (x#xs) (y#ys) = (if x ≤ y
                          then x # merge xs (y#ys)
                          else y # merge (x # xs) ys)"

text‹example:›
lemma "merge [1,3,6] [1,2,5,8] = [1,1,2,3,5,6,8]" by simp

lemma merge_set: "set (merge xs ys) = set xs ∪ set ys"
  by(induction xs ys rule: merge.induct) auto

lemma merge_sorted:
  "sorted xs ⟹ sorted ys ⟹ sorted (merge xs ys)"
proof(induction xs ys rule: merge.induct)
  case (1 ys)
  then show "sorted (merge [] ys)" by simp
next
  case (2 x xs)
  then show "sorted (merge (x # xs) [])" by simp
next
  case (3 x xs y ys)
  assume premx: "sorted (x # xs)"
     and premy: "sorted (y # ys)"
     and IHx: "x ≤ y ⟹ sorted xs ⟹ sorted (y # ys) ⟹
                 sorted (merge xs (y # ys))"
     and IHy: "¬ x ≤ y ⟹ sorted (x # xs) ⟹ sorted ys ⟹
                 sorted (merge (x # xs) ys)"
  then show "sorted (merge (x # xs) (y # ys))"
  proof(cases "x ≤ y")
    case True
    with premx IHx premy have IH: "sorted (merge xs (y # ys))" by simp
    from ‹x ≤ y› premx premy merge_set have
      "∀z ∈ set (merge xs (y # ys)). x ≤ z" by fastforce
    with ‹x ≤ y› IH show "sorted (merge (x # xs) (y # ys))" by(simp)
  next
    case False
    with premy IHy premx have IH: "sorted (merge (x # xs) ys)" by simp
    from ‹¬x ≤ y› premx premy merge_set have
      "∀z ∈ set (merge (x # xs) ys). y ≤ z" by fastforce
    with ‹¬x ≤ y› IH show "sorted (merge (x # xs) (y # ys))" by(simp)
  qed
qed

fun mergesort :: "int list ⇒ int list" where
  "mergesort [] = []"
| "mergesort [x] = [x]"
| "mergesort xs = merge (mergesort (take (length xs div 2) xs))
                        (mergesort (drop (length xs div 2) xs))"

theorem mergesort_set: "set xs = set (mergesort xs)"
proof(induction xs rule: mergesort.induct)
  case 1
  show "set [] = set (mergesort [])" by simp
next
  case (2 x)
  show "set [x] = set (mergesort [x])" by simp
next
  case (3 x1 x2 xs)
  from 3 have IH_simplified_take:
    "set (mergesort (x1 # take (length xs div 2) (x2 # xs))) =
     insert x1 (set (take (length xs div 2) (x2 # xs)))"
  and IH_simplified_drop:
    "set (mergesort (drop (length xs div 2) (x2 # xs))) = 
     set (drop (length xs div 2) (x2 # xs))" by simp+

  have "(set (take n as) ∪ set (drop n as)) = set as"
    for n and as::"int list"
  proof -
    from set_append[of "take n as" "drop n as"] have
      "(set (take n as) ∪ set (drop n as)) =
       set (take n as @ drop n as)" by simp
    moreover have
      "set (take n as @ drop n as) =
       set as" using append_take_drop_id by simp
    ultimately show ?thesis by simp
  qed
  hence "(set (take (length xs div 2) (x2 # xs)) ∪
        set (drop (length xs div 2) (x2 # xs))) =
        set (x2 # xs)"by(simp)
  with IH_simplified_take IH_simplified_drop show
    "set (x1 # x2 # xs) = set (mergesort (x1 # x2 # xs))"
    by(simp add: merge_set)
qed

theorem mergesort_sorted: "sorted (mergesort xs)"
  by(induction xs rule: mergesort.induct) (simp add: merge_sorted)+

text‹example:›
lemma "mergesort [42, 5, 1, 3, 67, 3, 9, 0, 33, 32] =
                 [0, 1, 3, 3, 5, 9, 32, 33, 42, 67]" by simp
end

J

Generally, this task should be accomplished in J using /:~. Here we take an approach that's more comparable with the other examples on this page.

Recursive Solution 

mergesort=: {{
  if. 2>#y do. y return.end.
  middle=. <.-:#y
  X=. mergesort middle{.y
  Y=. mergesort middle}.y
  X merge Y
}}

merge=: {{ r=. y#~ i=. j=. 0
  while. (i<#x)*(j<#y) do. a=. i{x [b=. j{y
    if. a<b do. r=. r,a [i=. i+1
       else.    r=. r,b [j=. j+1 end.
  end.
  if. i<#x do. r=. r, i}.x end.
  if. j<#y do. r=. r, j}.y end.
}}

Non-Recursive Solution

(This uses the same merge): 

mergesort=: {{  r=. y [  stride=. 1
  while. stride < #r do. stride=. 2*mid=. stride
    r=. ;(-stride) (mid&}. <@merge (mid<.#) {.])\ r
  end.
}}

Example use: 

   mergesort 18 2 8 1 5 14 9 19 11 13 16 0 3 10 17 15 12 4 7 6
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

But use J's /:~ if you really need this function. 

   (/:~ -: mergesort) ?~?10000
1

Tacit Recursive Solution 

case=.      (0 = # x=. @:[) + 2 * (0 = # y=. @:])
merge=.     ({.x , }.x $: ])`(({.y , }.y $: [))@.({.x > {.y)`]`[@.case
mergesort=. (<. o -: o # ($: o {. merge $: (o=. @:) }.) ]) ^:(1 < #)

Example use: 

   mergesort 18 2 8 1 5 14 9 19 11 13 16 0 3 10 17 15 12 4 7 6
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Java

Works with: Java version 1.5+
import java.util.List;
import java.util.ArrayList;
import java.util.Iterator;

public class Merge{
    public static <E extends Comparable<? super E>> List<E> mergeSort(List<E> m){
        if(m.size() <= 1) return m;

        int middle = m.size() / 2;
        List<E> left = m.subList(0, middle);
        List<E> right = m.subList(middle, m.size());

        right = mergeSort(right);
        left = mergeSort(left);
        List<E> result = merge(left, right);

        return result;
    }

    public static <E extends Comparable<? super E>> List<E> merge(List<E> left, List<E> right){
        List<E> result = new ArrayList<E>();
        Iterator<E> it1 = left.iterator();
        Iterator<E> it2 = right.iterator();

	E x = it1.next();
	E y = it2.next();
        while (true){
            //change the direction of this comparison to change the direction of the sort
            if(x.compareTo(y) <= 0){
		result.add(x);
		if(it1.hasNext()){
		    x = it1.next();
		}else{
		    result.add(y);
		    while(it2.hasNext()){
			result.add(it2.next());
		    }
		    break;
		}
	    }else{
		result.add(y);
		if(it2.hasNext()){
		    y = it2.next();
		}else{
		    result.add(x);
		    while (it1.hasNext()){
			result.add(it1.next());
		    }
		    break;
		}
	    }
        }
        return result;
    }
}

JavaScript

function mergeSort(v) {
    if (v.length <= 1) {
        return v;
    }

    let m = Math.floor(v.length / 2);
    let l = mergeSort(v.slice(0, m));
    let r = mergeSort(v.slice(m));
    return merge(l, r);

    function merge(a, b) {
        let i = 0, j = 0;
        let n = a.length + b.length;
        let c = [];
        while (c.length < n) {
            if (i < a.length && (j >= b.length || a[i] < b[j])) {
                c.push(a[i++]);
            } else {
                c.push(b[j++]);
            }
        }
        return c;
    }
}

function mergeSortInPlace(v) {
    if (v.length <= 1) {
        return;
    }

    let m = Math.floor(v.length / 2);
    let l = v.slice(0, m);
    let r = v.slice(m);
    mergeSortInPlace(l);
    mergeSortInPlace(r);
    merge(l, r, v);

    // merge a + b -> c
    function merge(a, b, c) {
        let i = 0, j = 0;
        for (let k = 0; k < c.length; k++) {
            if (i < a.length && (j >= b.length || a[i] < b[j])) {
                c[k] = a[i++];
            } else {
                c[k] = b[j++];
            }
        }
    }
}

// even faster
function mergeSortInPlaceFast(v) {
    sort(v, 0, v.length, v.slice());

    function sort(v, lo, hi, t) {
        let n = hi - lo;
        if (n <= 1) {
            return;
        }
        let mid = lo + Math.floor(n / 2);
        sort(v, lo, mid, t);
        sort(v, mid, hi, t);
        for (let i = lo; i < hi; i++) {
            t[i] = v[i];
        }
        let i = lo, j = mid;
        for (let k = lo; k < hi; k++) {
            if (i < mid && (j >= hi || t[i] < t[j])) {
                v[k] = t[i++];
            } else {
                v[k] = t[j++];
            }
        }
    }
}

function merge(left, right, arr) {
  var a = 0;

  while (left.length && right.length) {
    arr[a++] = (right[0] < left[0]) ? right.shift() : left.shift();
  }
  while (left.length) {
    arr[a++] = left.shift();
  }
  while (right.length) {
    arr[a++] = right.shift();
  }
}

function mergeSort(arr) {
  var len = arr.length;

  if (len === 1) { return; }

  var mid = Math.floor(len / 2),
      left = arr.slice(0, mid),
      right = arr.slice(mid);

  mergeSort(left);
  mergeSort(right);
  merge(left, right, arr);
}

var arr = [1, 5, 2, 7, 3, 9, 4, 6, 8];
mergeSort(arr); // arr will now: 1, 2, 3, 4, 5, 6, 7, 8, 9

// here is improved faster version, also often faster than QuickSort!

function mergeSort2(a) {
  if (a.length <= 1) return
  const mid = Math.floor(a.length / 2), left = a.slice(0, mid), right = a.slice(mid)
  mergeSort2(left)
  mergeSort2(right)
  let ia = 0, il = 0, ir = 0
  while (il < left.length && ir < right.length)
    a[ia++] = left[il] < right[ir] ? left[il++] : right[ir++]
  while (il < left.length)
    a[ia++] = left[il++]
  while (ir < right.length)
    a[ia++] = right[ir++]
}

jq

The sort function defined here will sort any JSON array. 

# Input: [x,y] -- the two arrays to be merged
# If x and y are sorted as by "sort", then the result will also be sorted:
def merge:
  def m:  # state: [x, y, array]  (array being the answer)
    .[0] as $x
    | .[1] as $y
    | if   0 == ($x|length) then .[2] + $y
      elif 0 == ($y|length) then .[2] + $x
      else
        (if $x[0] <= $y[0] then [$x[1:], $y,     .[2] + [$x[0] ]] 
         else                   [$x,     $y[1:], .[2] + [$y[0] ]]
         end) | m
      end;
   [.[0], .[1], []] | m;

def merge_sort:
  if length <= 1 then .
  else
    (length/2 |floor) as $len
    | . as $in
    | [ ($in[0:$len] | merge_sort), ($in[$len:] | merge_sort) ] | merge
  end;

Example: 

( [1, 3, 8, 9, 0, 0, 8, 7, 1, 6],
  [170, 45, 75, 90, 2, 24, 802, 66],
  [170, 45, 75, 90, 2, 24, -802, -66] )
| (merge_sort == sort)
Output:
true
true
true

Julia

function mergesort(arr::Vector)
    if length(arr) ≤ 1 return arr end
    mid = length(arr) ÷ 2
    lpart = mergesort(arr[1:mid])
    rpart = mergesort(arr[mid+1:end])
    rst = similar(arr)
    i = ri = li = 1
    @inbounds while li ≤ length(lpart) && ri ≤ length(rpart)
        if lpart[li] ≤ rpart[ri]
            rst[i] = lpart[li]
            li += 1
        else
            rst[i] = rpart[ri]
            ri += 1
        end
        i += 1
    end
    if li ≤ length(lpart)
        copyto!(rst, i, lpart, li)
    else
        copyto!(rst, i, rpart, ri)
    end
    return rst
end

v = rand(-10:10, 10)
println("# unordered: $v\n -> ordered: ", mergesort(v))
Output:
# unordered: [8, 6, 7, 1, -1, 0, -4, 7, -7, 0]
 -> ordered: [-7, -4, -1, 0, 0, 1, 6, 7, 7, 8]

Kotlin

fun mergeSort(list: List<Int>): List<Int> {
    if (list.size <= 1) {
        return list
    }

    val left = mutableListOf<Int>()
    val right = mutableListOf<Int>()

    val middle = list.size / 2
    list.forEachIndexed { index, number ->
        if (index < middle) {
            left.add(number)
        } else {
            right.add(number)
        }
    }

    fun merge(left: List<Int>, right: List<Int>): List<Int> = mutableListOf<Int>().apply {
        var indexLeft = 0
        var indexRight = 0

        while (indexLeft < left.size && indexRight < right.size) {
            if (left[indexLeft] <= right[indexRight]) {
                add(left[indexLeft])
                indexLeft++
            } else {
                add(right[indexRight])
                indexRight++
            }
        }

        while (indexLeft < left.size) {
            add(left[indexLeft])
            indexLeft++
        }

        while (indexRight < right.size) {
            add(right[indexRight])
            indexRight++
        }
    }

    return merge(mergeSort(left), mergeSort(right))
}

fun main(args: Array<String>) {
    val numbers = listOf(5, 2, 3, 17, 12, 1, 8, 3, 4, 9, 7)
    println("Unsorted: $numbers")
    println("Sorted: ${mergeSort(numbers)}")
}
Output:
Unsorted: [5, 2, 3, 17, 12, 1, 8, 3, 4, 9, 7]
Sorted:   [1, 2, 3, 3, 4, 5, 7, 8, 9, 12, 17]

Lambdatalk

A close translation from Picolisp. In lambdatalk lists are implemented as dynamical arrays with list-like functions, cons is A.addfirst!, car is A.first, cdr is A.rest, nil is A.new and so on. 

{def alt
 {lambda {:list}
  {if {A.empty? :list}
   then {A.new}
   else {A.addfirst! {A.first :list}
                     {alt {A.rest {A.rest :list}}}} }}}
-> alt

{def merge
 {lambda {:l1 :l2}
  {if {A.empty? :l2}
   then :l1
   else {if {< {A.first :l1} {A.first :l2}}
   then {A.addfirst! {A.first :l1} {merge :l2 {A.rest :l1}}}
   else {A.addfirst! {A.first :l2} {merge :l1 {A.rest :l2}}} }}}}
-> merge

{def mergesort
 {lambda {:list}
  {if {A.empty? {A.rest :list}}
   then :list
   else {merge {mergesort {alt :list}}
               {mergesort {alt {A.rest :list}}}} }}}
-> mergesort

{mergesort {A.new 8 1 5 3 9 0 2 7 6 4}}
-> [0,1,2,3,4,5,6,7,8,9]

Liberty BASIC

    itemCount = 20
    dim A(itemCount)
    dim tmp(itemCount)    'merge sort needs additionally same amount of storage

    for i = 1 to itemCount
        A(i) = int(rnd(1) * 100)
    next i

    print "Before Sort"
    call printArray itemCount

    call mergeSort 1,itemCount

    print "After Sort"
    call printArray itemCount
end

'------------------------------------------
sub mergeSort start, theEnd
    if theEnd-start < 1 then exit sub
    if theEnd-start = 1 then
        if A(start)>A(theEnd) then
            tmp=A(start)
            A(start)=A(theEnd)
            A(theEnd)=tmp
        end if
        exit sub
    end if
    middle = int((start+theEnd)/2)
    call mergeSort start, middle
    call mergeSort middle+1, theEnd
    call merge start, middle, theEnd
end sub

sub merge start, middle, theEnd
    i = start: j = middle+1: k = start
    while i<=middle OR j<=theEnd
        select case
        case i<=middle AND j<=theEnd
            if A(i)<=A(j) then
                tmp(k)=A(i)
                i=i+1
            else
                tmp(k)=A(j)
                j=j+1
            end if
            k=k+1
        case i<=middle
            tmp(k)=A(i)
            i=i+1
            k=k+1
        case else    'j<=theEnd
            tmp(k)=A(j)
            j=j+1
            k=k+1
        end select
    wend

    for i = start to theEnd
        A(i)=tmp(i)
    next
end sub

'===========================================
sub printArray itemCount
    for i = 1 to itemCount
        print using("###", A(i));
    next i
    print
end sub

Works with: UCB Logo
to split :size :front :list
  if :size < 1 [output list :front :list]
  output split :size-1 (lput first :list :front) (butfirst :list)
end

to merge :small :large
  if empty? :small [output :large]
  ifelse lessequal? first :small first :large ~
    [output fput first :small merge butfirst :small :large] ~
    [output fput first :large merge butfirst :large :small]
end

to mergesort :list
  localmake "half split (count :list) / 2 [] :list
  if empty? first :half [output :list]
  output merge mergesort first :half mergesort last :half
end

Logtalk

msort([], []) :- !.
msort([X], [X]) :- !.
msort([X, Y| Xs], Ys) :-
    split([X, Y| Xs], X1s, X2s),
    msort(X1s, Y1s),
    msort(X2s, Y2s),
    merge(Y1s, Y2s, Ys).

split([], [], []).
split([X| Xs], [X| Ys], Zs) :-
    split(Xs, Zs, Ys).

merge([X| Xs], [Y| Ys], [X| Zs]) :-
    X @=< Y, !,
    merge(Xs, [Y| Ys], Zs).
merge([X| Xs], [Y| Ys], [Y| Zs]) :-
    X @> Y, !,
    merge([X | Xs], Ys, Zs).
merge([], Xs, Xs) :- !.
merge(Xs, [], Xs).

Lua

local function merge(left_container, left_container_begin, left_container_end, right_container, right_container_begin, right_container_end, result_container, result_container_begin, comparator)
	while left_container_begin <= left_container_end do
		if right_container_begin > right_container_end then
			for i = left_container_begin, left_container_end do
				result_container[result_container_begin] = left_container[i]
				result_container_begin = result_container_begin + 1
			end

			return
		end

		if comparator(right_container[right_container_begin], left_container[left_container_begin]) then
			result_container[result_container_begin] = right_container[right_container_begin]
			right_container_begin = right_container_begin + 1
		else
			result_container[result_container_begin] = left_container[left_container_begin]
			left_container_begin = left_container_begin + 1
		end

		result_container_begin = result_container_begin + 1
	end

	for i = right_container_begin, right_container_end do
		result_container[result_container_begin] = right_container[i]
		result_container_begin = result_container_begin + 1
	end
end

local function mergesort_impl(container, container_begin, container_end, comparator)
	local range_length = (container_end - container_begin) + 1
	if range_length < 2 then return end
	local copy = {}
	local copy_len = 0

	for it = container_begin, container_end do
		copy_len = copy_len + 1
		copy[copy_len] = container[it]
	end

	local middle = bit.rshift(range_length, 1) -- or math.floor(range_length / 2)
	mergesort_impl(copy, 1, middle, comparator)
	mergesort_impl(copy, middle + 1, copy_len, comparator)
	merge(copy, 1, middle, copy, middle + 1, copy_len, container, container_begin, comparator)
end

local function mergesort_default_comparator(a, b)
	return a < b
end

function table.mergesort(container, comparator)
	if not comparator then
		comparator = mergesort_default_comparator
	end

	mergesort_impl(container, 1, #container, comparator)
end

function getLower(a,b)
  local i,j=1,1
  return function() 
    if not b[j] or a[i] and a[i]<b[j] then
      i=i+1; return a[i-1]
    else
      j=j+1; return b[j-1]
    end
  end  
end

function merge(a,b)
  local res={}
  for v in getLower(a,b) do res[#res+1]=v end
  return res
end

function mergesort(list)
  if #list<=1 then return list end
  local s=math.floor(#list/2)
  return merge(mergesort{unpack(list,1,s)}, mergesort{unpack(list,s+1)})
end

Lucid

[2] 

msort(a) = if iseod(first next a) then a else merge(msort(b0),msort(b1)) fi
  where
   p = false fby not p;
   b0 = a whenever p;
   b1 = a whenever not p;
   just(a) = ja
      where
         ja = a fby if iseod ja then eod else next a fi;
      end;
   merge(x,y) = if takexx then xx else yy fi
     where
      xx = (x) upon takexx;
      yy = (y) upon not takexx;
      takexx = if iseod(yy) then true elseif
                  iseod(xx) then false else xx <= yy fi;
     end;
  end;

M2000 Interpreter

module checkit {
	\\ merge sort
	group merge {
		function sort(right as stack) {
			if len(right)<=1 then =right : exit
			left=.sort(stack up right, len(right) div 2 )
			right=.sort(right)
			\\ stackitem(right) is same as stackitem(right,1)
			if stackitem(left, len(left))<=stackitem(right) then
				\\ !left take items from left for merging
				\\ so after this left and right became empty stacks
				=stack:=!left, !right
				exit
			end if
			=.merge(left, right)
		}
		function sortdown(right as stack) {
			if len(right)<=1 then =right : exit
			left=.sortdown(stack up right, len(right) div 2 )
			right=.sortdown(right)
			if stackitem(left, len(left))>stackitem(right) then
				=stack:=!left, !right : exit
			end if
			=.mergedown(left, right)
		}
		\\ left and right are pointers to stack objects
		\\ here we pass by value the pointer not the data
		function merge(left as stack, right as stack) {			
			result=stack
			while len(left) > 0 and len(right) > 0
				if stackitem(left,1) <= stackitem(right) then
					result=stack:=!result, !(stack up left, 1)
				else
					result=stack:=!result, !(stack up right, 1)
				end if
			end while
			if len(right) > 0 then  result=stack:= !result,!right
			if len(left) > 0 then result=stack:= !result,!left
			=result
		}
		function mergedown(left as stack, right as stack) {			
			result=stack
			while len(left) > 0 and len(right) > 0
				if stackitem(left,1) > stackitem(right) then
					result=stack:=!result, !(stack up left, 1)
				else
					result=stack:=!result, !(stack up right, 1)
				end if
			end while
			if len(right) > 0 then  result=stack:= !result,!right
			if len(left) > 0 then result=stack:= !result,!left
			=result
		}
	}
	k=stack:=7, 5, 2, 6, 1, 4, 2, 6, 3
	print merge.sort(k)
	print len(k)=0   ' we have to use merge.sort(stack(k)) to pass a copy of k
	
	\\ input array  (arr is a pointer to array)
	arr=(10,8,9,7,5,6,2,3,0,1)
	\\ stack(array pointer) return a stack with a copy of array items
	\\ array(stack pointer) return an array, empty the stack
	
	arr2=array(merge.sort(stack(arr)))
	Print type$(arr2)
	Dim a()
	\\ a() is an array as a value, so we just copy arr2 to a()
	a()=arr2
	\\ to prove we add 1 to each element of arr2
	arr2++
	Print a()  ' 0,1,2,3,4,5,6,7,8,9
	Print arr2  ' 1,2,3,4,5,6,7,8,9,11
	p=a()  ' we get a pointer
	\\ a() has a double pointer inside
	\\ so a() get just the inner pointer
	a()=array(merge.sortdown(stack(p)))
	\\ so now p (which use the outer pointer)
	\\ still points to a()
	print p   ' p point to a()
	
}
checkit

Maple

merge := proc(arr, left, mid, right)
	local i, j, k, n1, n2, L, R;
	n1 := mid-left+1: 
	n2 := right-mid:
	L := Array(1..n1):
	R := Array(1..n2):
	for i from 0 to n1-1 do
		L(i+1) :=arr(left+i):
	end do:
	for j from 0 to n2-1 do
		R(j+1) := arr(mid+j+1):
	end do:
	i := 1:
	j := 1:
	k := left:
	while(i <= n1 and j <= n2) do
		if (L[i] <= R[j]) then
			arr[k] := L[i]:
			i++:
		else
			arr[k] := R[j]:
			j++:
		end if:
		k++:
	end do:
	while(i <= n1) do
		arr[k] := L[i]:
		i++:
		k++:
	end do:
	while(j <= n2) do
		arr[k] := R[j]:
		j++:
		k++:
	end do:
end proc:
arr := Array([17,3,72,0,36,2,3,8,40,0]);
mergeSort(arr,1,numelems(arr)):
arr;
Output:
[0,0,2,3,3,8,17,36,40,72]

Mathematica / Wolfram Language

Works with: Mathematica version 7.0
MergeSort[m_List] := Module[{middle},
  If[Length[m] >= 2,
   middle = Ceiling[Length[m]/2];
   Apply[Merge, 
    Map[MergeSort, Partition[m, middle, middle, {1, 1}, {}]]],
   m
   ]
  ]
  
Merge[left_List, right_List] := Module[
  {leftIndex = 1, rightIndex = 1},
  Table[
   Which[
    leftIndex > Length[left], right[[rightIndex++]],
    rightIndex > Length[right], left[[leftIndex++]],
    left[[leftIndex]] <= right[[rightIndex]], left[[leftIndex++]],
    True, right[[rightIndex++]]],
   {Length[left] + Length[right]}]
  ]

MATLAB

function list = mergeSort(list)

    if numel(list) <= 1
        return
    else
        middle = ceil(numel(list) / 2);
        left = list(1:middle);
        right = list(middle+1:end);
        
        left = mergeSort(left);
        right = mergeSort(right);
        
        if left(end) <= right(1)
            list = [left right];
            return
        end
        
        %merge(left,right)
        counter = 1;
        while (numel(left) > 0) && (numel(right) > 0)
            if(left(1) <= right(1))
                list(counter) = left(1);
                left(1) = [];
            else
                list(counter) = right(1);
                right(1) = [];
            end           
            counter = counter + 1;   
        end

        if numel(left) > 0
            list(counter:end) = left;
        elseif numel(right) > 0
            list(counter:end) = right;
        end
        %end merge        
    end %if
end %mergeSort

Sample Usage: 

>> mergeSort([4 3 1 5 6 2])

ans =

     1     2     3     4     5     6

Maxima

merge(a, b) := block(
   [c: [ ], i: 1, j: 1, p: length(a), q: length(b)],
   while i <= p and j <= q do (
      if a[i] < b[j] then (
         c: endcons(a[i], c),
         i: i + 1
      ) else (
         c: endcons(b[j], c),
         j: j + 1
      )
   ),
   if i > p then append(c, rest(b, j - 1)) else append(c, rest(a, i - 1))
)$

mergesort(u) := block(
   [n: length(u), k, a, b],
   if n <= 1 then u else (
      a: rest(u, k: quotient(n, 2)),
      b: rest(u, k - n),
      merge(mergesort(a), mergesort(b))
   )
)$

MAXScript

fn mergesort arr =
(
	local left = #()
	local right = #()
	local result = #()
	if arr.count < 2 then return arr
	else
	(
		local mid = arr.count/2
		for i = 1 to mid do
		(
			append left arr[i]
		)
		for i = (mid+1) to arr.count do
		(
			append right arr[i]
		)
		left = mergesort left
		right = mergesort right
		if left[left.count] <= right[1] do
		(
			join left right
			return left
		)
		result = _merge left right
		return result
	)
)

fn _merge a b =
(
	local result = #()
	while a.count > 0 and b.count > 0 do
	(
		if a[1] <= b[1] then
		(
			append result a[1] 
			a = for i in 2 to a.count collect a[i]
		)
		else
		(
			append result b[1]
			b = for i in 2 to b.count collect b[i]
		)
	)
	if a.count > 0 do
	(
		join result a
	)
	if b.count > 0 do
	(
		join result b
	)
	return result
)

Output: 

a = for i in 1 to 15 collect random -5 20
#(-3, 13, 2, -2, 13, 9, 17, 7, 16, 19, 0, 0, 20, 18, 1)
mergeSort a
#(-3, -2, 0, 0, 1, 2, 7, 9, 13, 13, 16, 17, 18, 19, 20)

Mercury

This version of a sort will sort a list of any type for which there is an ordering predicate defined. Both a function form and a predicate form are defined here with the function implemented in terms of the predicate. Some of the ceremony has been elided. 

:- module merge_sort.

:- interface.

:- import_module list.

:- type split_error ---> split_error.

:- func merge_sort(list(T)) = list(T).
:- pred merge_sort(list(T)::in, list(T)::out) is det.

:- implementation.

:- import_module int, exception.

merge_sort(U) = S :- merge_sort(U, S).
 
merge_sort(U, S) :- merge_sort(list.length(U), U, S).
 
:- pred merge_sort(int::in, list(T)::in, list(T)::out) is det.
merge_sort(L, U, S) :-
    ( L > 1 ->
        H = L // 2,
        ( split(H, U, F, B) ->
            merge_sort(H, F, SF),
            merge_sort(L - H, B, SB),
            merge_sort.merge(SF, SB, S)
        ; throw(split_error) )
    ; S = U ).
 
:- pred split(int::in, list(T)::in, list(T)::out, list(T)::out) is semidet.
split(N, L, S, E) :-
    ( N = 0 -> S = [], E = L
    ; N > 0, L = [H | L1], S = [H | S1],
      split(N - 1, L1, S1, E) ).
 
:- pred merge(list(T)::in, list(T)::in, list(T)::out) is det.
merge([], [], []).
merge([X|Xs], [], [X|Xs]).
merge([], [Y|Ys], [Y|Ys]).
merge([X|Xs], [Y|Ys], M) :-
    ( compare(>, X, Y) ->
        merge_sort.merge([X|Xs], Ys, M0),
        M = [Y|M0]
    ; merge_sort.merge(Xs, [Y|Ys], M0),
        M = [X|M0] ).

Miranda

main :: [sys_message]
main = [Stdout ("Before: " ++ show testlist ++ "\n"),
        Stdout ("After:  " ++ show (mergesort testlist) ++ "\n")]
       where testlist = [4,65,2,-31,0,99,2,83,782,1]

mergesort :: [*]->[*]
mergesort []  = []
mergesort [x] = [x]
mergesort xs  = merge (mergesort l) (mergesort r)
                where (l, r)              = split [] [] xs
                      split l r []        = (l,r)
                      split l r [x]       = (x:l,r)
                      split l r (x:y:xs)  = split (x:l) (y:r) xs
                      merge xs     []     = xs
                      merge []     ys     = ys
                      merge (x:xs) (y:ys) = x:y:merge xs ys, if x<y
                                          = y:x:merge xs ys, if x>=y
Output:
Before: [4,65,2,-31,0,99,2,83,782,1]
After:  [-31,0,1,2,2,83,4,99,65,782]

Modula-2

Iterative

Works with: TopSpeed (JPI) Modula-2 under DOSBox-X

Divides the input into blocks of 2 entries, and sorts each block by swapping if necessary. Then merges blocks of 2 into blocks of 4, blocks of 4 into blocks of 8, and so on. 

DEFINITION MODULE MSIterat;

PROCEDURE IterativeMergeSort( VAR a : ARRAY OF INTEGER);

END MSIterat.

IMPLEMENTATION MODULE MSIterat;

IMPORT Storage;

PROCEDURE IterativeMergeSort( VAR a : ARRAY OF INTEGER);
VAR
  n, bufLen, len, endBuf : CARDINAL;
  k, nL, nR, b, h, i, j, startR, endR: CARDINAL;
  temp : INTEGER; (* array element *)
  pbuf : POINTER TO ARRAY CARDINAL OF INTEGER;
BEGIN
  n := HIGH(a) + 1; (* length of array *)
  IF (n < 2) THEN RETURN; END;
  (* Sort blocks of length 2 by swapping elements if necessary.
     Start at high end of array; ignore a[0] if n is odd.*)
  k := n;
  REPEAT
    DEC(k, 2);
    IF (a[k] > a[k + 1]) THEN
      temp := a[k]; a[k] := a[k + 1]; a[k + 1] := temp;
    END;
  UNTIL (k < 2);
  IF (n = 2) THEN RETURN; END;

  (* Set up a buffer for temporary storage when merging. *)
  (* TopSpeed Modula-2 doesn't seem to have dynamic arrays,
     so we use a workaround *)
  bufLen := n DIV 2;
  Storage.ALLOCATE( pbuf, bufLen*SIZE(INTEGER));

  nR := 2; (* length of right-hand block when merging *)
  REPEAT
    len := 2*nR; (* maximum length of a merged block in this iteration *)
    k := n; (* start at the high end of the array *)
    WHILE (k > nR) DO
      IF (k >= len) THEN
        nL := nR; DEC(k, len);
      ELSE
        nL := k - nR; k := 0; END;

      (* Merging 2 adjacent blocks, already sorted.
         k = start index of left block;
         nL, nR = lengths of left and right blocks *)
      startR := k + nL;  endR := startR + nR;

      (* Skip elements in left block that are already in correct place *)
      temp := a[startR]; (* first (smallest) element in right block *)
      j := k;
      WHILE (j < startR) AND (a[j] <= temp) DO INC(j); END;

      endBuf := startR - j; (* length of buffer actually used *)
      IF (endBuf > 0) THEN (* if endBuf = 0 then already sorted *)
        (* Copy from left block to buffer, omitting elements
           that are already in correct place *)
        h := j;
        FOR b := 0 TO endBuf - 1 DO
          pbuf^[b] := a[h]; INC(h);
        END;
        (* Fill in values from right block or buffer *)
        b := 0;
        i := startR;
     (* j = startR - endBuf from above *)
        WHILE (b < endBuf) AND (i < endR) DO
          IF (pbuf^[b] <= a[i]) THEN
            a[j] := pbuf^[b]; INC(b)
          ELSE
            a[j] := a[i]; INC(i); END;
          INC(j);
        END;
        (* If now b = endBuf then the merge is complete.
           Else just copy the remaining elements in the buffer. *)
        WHILE (b < endBuf) DO
          a[j] := pbuf^[b]; INC(j); INC(b);
        END;
      END;
    END;
    nR := len;
  UNTIL (nR >= n);
  Storage.DEALLOCATE( pbuf, bufLen*SIZE(INTEGER));
END IterativeMergeSort;

END MSIterat.

MODULE MSItDemo;
(* Demo of iterative merge sort *)

IMPORT IO, Lib;
FROM MSIterat IMPORT IterativeMergeSort;

(* Procedure to display the values in the demo array *)
PROCEDURE Display( VAR a : ARRAY OF INTEGER);
VAR
  j, nrInLine : CARDINAL;
BEGIN
  nrInLine := 0;
  FOR j := 0 TO HIGH(a) DO
    IO.WrCard( a[j], 5); INC( nrInLine);
    IF (nrInLine = 10) THEN IO.WrLn; nrInLine := 0; END;
  END;
  IF (nrInLine > 0) THEN IO.WrLn; END;
END Display;

(* Main routine *)
CONST
  ArrayLength = 50;
VAR
  arr : ARRAY [0..ArrayLength - 1] OF INTEGER;
  m : CARDINAL;
BEGIN
  Lib.RANDOMIZE;
  FOR m := 0 TO ArrayLength - 1 DO arr[m] := Lib.RANDOM( 1000); END;
  IO.WrStr( 'Before:'); IO.WrLn; Display( arr);
  IterativeMergeSort( arr);
  IO.WrStr( 'After:'); IO.WrLn; Display( arr);
END MSItDemo.
Output:
Before:
  236  542  526  549  869  632  446  518  909  270
  826  562  469  258  681  604  921  772  548  328
  147  679   71  239  772  106  477  556  451   64
  941  207   87  486  280  206  380  689  964  376
  298  635  552  887  387   70  287   77  610  605
After:
   64   70   71   77   87  106  147  206  207  236
  239  258  270  280  287  298  328  376  380  387
  446  451  469  477  486  518  526  542  548  549
  552  556  562  604  605  610  632  635  679  681
  689  772  772  826  869  887  909  921  941  964

Recursive on linked list

Works with: TopSpeed (JPI) Modula-2 under DOSBox-X

According to Wikipedia, "merge sort is often the best choice for sorting a linked list". The code below shows a general procedure for merge-sorting a linked list. As in the improved Delphi version, only the pointers are moved. To carry out the Rosetta Code task, the demo program sorts an array of records on an integer-valued field.

The method for splitting a linked list is taken from "Merge sort algorithm for a singly linked list" on Techie Delight. Two pointers step through the list, one at twice the speed of the other. When the fast pointer reaches the end, the slow pointer marks the halfway point. 

DEFINITION MODULE MergSort;

TYPE MSCompare = PROCEDURE( ADDRESS, ADDRESS) : INTEGER;
TYPE MSGetNext = PROCEDURE( ADDRESS) : ADDRESS;
TYPE MSSetNext = PROCEDURE( ADDRESS, ADDRESS);

PROCEDURE DoMergeSort( VAR start : ADDRESS;
                       Compare : MSCompare;
                       GetNext : MSGetNext;
                       SetNext : MSSetNext);
(*
  Procedures to be supplied by the caller:
  Compare(a1, a2) returns -1 if a1^ is to be placed before a2^;
    +1 if after; 0 if no priority.
  GetNext(a) returns address of next item after a^.
  SetNext(a, n) sets address of next item after a^ to n.
  If a^ is last item, then address of next item is NIL.
  It can be assumed that a, a1, a2 are not NIL.
*)
END MergSort.

IMPLEMENTATION MODULE MergSort;

PROCEDURE DoMergeSort( VAR start : ADDRESS;
                       Compare : MSCompare;
                       GetNext : MSGetNext;
                       SetNext : MSSetNext);
VAR
  p1, p2, q : ADDRESS;
BEGIN
  (* If list has < 2 items, do nothing *)
  IF (start = NIL) THEN RETURN; END;
  p1 := GetNext( start); IF (p1 = NIL) THEN RETURN; END;

  (* If list has only 2 items, we'll not use recursion *)
  p2 := GetNext( p1);
  IF (p2 = NIL) THEN
    IF (Compare( start, p1) > 0) THEN
      q := start; SetNext( p1, q); SetNext( q, NIL);
      start := p1;
    END;
    RETURN;
  END;

  (* List has > 2 items: split list in half *)
  p1 := start;
  REPEAT
    p1 := GetNext( p1);
    p2 := GetNext( p2);
    IF (p2 <> NIL) THEN p2 := GetNext( p2); END;
  UNTIL (p2 = NIL);
  (* Now p1 points to last item in first half of list *)
  p2 := GetNext( p1); SetNext( p1, NIL);
  p1 := start;

  (* Recursive calls to sort each half; p1 and p2 will be updated *)
  DoMergeSort( p1, Compare, GetNext, SetNext);
  DoMergeSort( p2, Compare, GetNext, SetNext);

  (* Merge the sorted halves *)
  IF Compare( p1, p2) < 0 THEN
    start := p1; p1 := GetNext( p1);
  ELSE
    start := p2; p2 := GetNext( p2);
  END;
  q := start;
  WHILE (p1 <> NIL) AND (p2 <> NIL) DO
    IF Compare( p1, p2) < 0 THEN
      SetNext( q, p1); q := p1; p1 := GetNext( p1);
    ELSE
      SetNext( q, p2); q := p2; p2 := GetNext( p2);
    END;
  END;
  IF (p1 = NIL) THEN SetNext( q, p2) ELSE SetNext( q, p1) END;
END DoMergeSort;
END MergSort.

MODULE MergDemo;

IMPORT IO, Lib, MergSort;

TYPE PTestRec = POINTER TO TestRec;
TYPE TestRec = RECORD
  Value : INTEGER;
  Next : PTestRec;
END;

PROCEDURE Compare( a1, a2 : ADDRESS) : INTEGER;
VAR
  p1, p2 : PTestRec;
BEGIN
  p1 := a1; p2 := a2;
  IF (p1^.Value < p2^.Value) THEN RETURN -1
  ELSIF (p1^.Value > p2^.Value) THEN RETURN 1
  ELSE RETURN 0; END;
END Compare;

PROCEDURE GetNext( a : ADDRESS) : ADDRESS;
VAR
  p : PTestRec;
BEGIN
  p := a; RETURN p^.Next;
END GetNext;

PROCEDURE SetNext( a, n : ADDRESS);
VAR
  p : PTestRec;
BEGIN
  p := a; p^.Next := n;
END SetNext;

(* Display the values in the linked list *)
PROCEDURE Display( p : PTestRec);
VAR
  nrInLine : CARDINAL;
BEGIN
  nrInLine := 0;
  WHILE (p <> NIL) DO
    IO.WrCard( p^.Value, 5);
    p := p^.Next;
    INC( nrInLine);
    IF (nrInLine = 10) THEN IO.WrLn; nrInLine := 0; END;
  END;
  IF (nrInLine > 0) THEN IO.WrLn; END;
END Display;

(* Main routine *)
CONST ArraySize = 50;
VAR
  arr : ARRAY [0..ArraySize - 1] OF TestRec;
  j : CARDINAL;
  start, p : PTestRec;
BEGIN
  (* Fill values with random integers *)
  FOR j := 0 TO ArraySize - 1 DO
    arr[j].Value := Lib.RANDOM( 1000);
  END;
  (* Set up the links *)
  IF (ArraySize > 1) THEN (* FOR loop 0 TO -1 crashes program *)
    FOR j := 0 TO ArraySize - 2 DO
      arr[j].Next := ADR( arr[j + 1]);
    END;
  END;
  arr[ArraySize - 1].Next := NIL;
  (* Demonstrate merge sort on the linked list *)
  start := ADR( arr[0]);
  IO.WrStr( 'Before:'); IO.WrLn;
  Display( start);
  MergSort.DoMergeSort( start, Compare, GetNext, SetNext);
  IO.WrStr( 'After:'); IO.WrLn;
  Display( start);
END MergDemo.
Output:
Before:
  683   68  458  645  223  801  485  101  255  590
  381  149   29  298  226  937  866  130  297  153
  551  159  760  403  380  770  296  701  399  775
  236  758  249  314  230  106  626  804  956  149
  706  625  651  727  323   38   66  534   85  663
After:
   29   38   66   68   85  101  106  130  149  149
  153  159  223  226  230  236  249  255  296  297
  298  314  323  380  381  399  403  458  485  534
  551  590  625  626  645  651  663  683  701  706
  727  758  760  770  775  801  804  866  937  956

Nemerle

This is a translation of a Standard ML example from Wikipedia. 

using System;
using System.Console;
using Nemerle.Collections;

module Mergesort
{
    MergeSort[TEnu, TItem] (sort_me : TEnu) : list[TItem]
      where TEnu  : Seq[TItem]
      where TItem : IComparable
    {
        def split(xs) {
            def loop (zs, xs, ys) {
                |(x::y::zs, xs, ys) => loop(zs, x::xs, y::ys)
                |(x::[], xs, ys) => (x::xs, ys)
                |([], xs, ys) => (xs, ys)
            }
            
            loop(xs, [], [])
        }
        
        def merge(xs, ys) {
            def loop(res, xs, ys) {
                |(res, [], []) => res.Reverse()
                |(res, x::xs, []) => loop(x::res, xs, [])
                |(res, [], y::ys) => loop(y::res, [], ys)
                |(res, x::xs, y::ys) => if (x.CompareTo(y) < 0) loop(x::res, xs, y::ys)
                                        else loop(y::res, x::xs, ys)
            }
            loop ([], xs, ys)
        }
        
        def ms(xs) {
            |[] => []
            |[x] => [x]
            |_ => { def (left, right) = split(xs); merge(ms(left), ms(right)) }
        }
        
        ms(sort_me.NToList())
    }
    
    Main() : void
    {
        def test1 = MergeSort([1, 5, 9, 2, 7, 8, 4, 6, 3]);
        def test2 = MergeSort(array['a', 't', 'w', 'f', 'c', 'y', 'l']);
        WriteLine(test1);
        WriteLine(test2);
    }
}
Output:
[1, 2, 3, 4, 5, 6, 7, 8, 9]
[a, c, f, l, t, w, y]

NetRexx

/* NetRexx */
options replace format comments java crossref savelog symbols binary

import java.util.List

placesList = [String -
    "UK  London",     "US  New York",   "US  Boston",     "US  Washington" -
  , "UK  Washington", "US  Birmingham", "UK  Birmingham", "UK  Boston"     -
]

lists = [ -
    placesList -
  , mergeSort(String[] Arrays.copyOf(placesList, placesList.length)) -
]

loop ln = 0 to lists.length - 1
  cl = lists[ln]
  loop ct = 0 to cl.length - 1
    say cl[ct]
    end ct
    say
  end ln

return

method mergeSort(m = String[]) public constant binary returns String[]

  rl = String[m.length]
  al = List mergeSort(Arrays.asList(m))
  al.toArray(rl)

  return rl

method mergeSort(m = List) public constant binary returns ArrayList

  result = ArrayList(m.size)
  left   = ArrayList()
  right  = ArrayList()
  if m.size > 1 then do
    middle = m.size % 2
    loop x_ = 0 to middle - 1
      left.add(m.get(x_))
      end x_
    loop x_ = middle to m.size - 1
      right.add(m.get(x_))
      end x_
    left  = mergeSort(left)
    right = mergeSort(right)
    if (Comparable left.get(left.size - 1)).compareTo(Comparable right.get(0)) <= 0 then do
      left.addAll(right)
      result.addAll(m)
      end
    else do
      result = merge(left, right)
      end
    end
  else do
    result.addAll(m)
    end

  return result

method merge(left = List, right = List) public constant binary returns ArrayList

  result = ArrayList()
  loop label mx while left.size > 0 & right.size > 0
    if (Comparable left.get(0)).compareTo(Comparable right.get(0)) <= 0 then do
      result.add(left.get(0))
      left.remove(0)
      end
    else do
      result.add(right.get(0))
      right.remove(0)
      end
    end mx
    if left.size > 0 then do
      result.addAll(left)
      end
    if right.size > 0 then do
      result.addAll(right)
      end

  return result
Output:
UK  London
US  New York
US  Boston
US  Washington
UK  Washington
US  Birmingham
UK  Birmingham
UK  Boston

UK  Birmingham
UK  Boston
UK  London
UK  Washington
US  Birmingham
US  Boston
US  New York
US  Washington

Nim

proc merge[T](a, b: var openarray[T]; left, middle, right: int) =
  let
    leftLen = middle - left
    rightLen = right - middle
  var
    l = 0
    r = leftLen
 
  for i in left ..< middle:
    b[l] = a[i]
    inc l
  for i in middle ..< right:
    b[r] = a[i]
    inc r
 
  l = 0
  r = leftLen
  var i = left
 
  while l < leftLen and r < leftLen + rightLen:
    if b[l] < b[r]:
      a[i] = b[l]
      inc l
    else:
      a[i] = b[r]
      inc r
    inc i
 
  while l < leftLen:
    a[i] = b[l]
    inc l
    inc i
  while r < leftLen + rightLen:
    a[i] = b[r]
    inc r
    inc i
 
proc mergeSort[T](a, b: var openarray[T]; left, right: int) =
  if right - left <= 1: return
 
  let middle = (left + right) div 2
  mergeSort(a, b, left, middle)
  mergeSort(a, b, middle, right)
  merge(a, b, left, middle, right)
 
proc mergeSort[T](a: var openarray[T]) =
  var b = newSeq[T](a.len)
  mergeSort(a, b, 0, a.len)
 
var a = @[4, 65, 2, -31, 0, 99, 2, 83, 782]
mergeSort a
echo a
Output:
@[-31, 0, 2, 2, 4, 65, 83, 99, 782]

OCaml

let rec split_at n xs =
  match n, xs with
      0, xs ->
        [], xs
    | _, [] ->
        failwith "index too large"
    | n, x::xs when n > 0 ->
        let xs', xs'' = split_at (pred n) xs in
          x::xs', xs''
    | _, _ ->
        invalid_arg "negative argument"

let rec merge_sort cmp = function
    [] -> []
  | [x] -> [x]
  | xs ->
      let xs, ys = split_at (List.length xs / 2) xs in
        List.merge cmp (merge_sort cmp xs) (merge_sort cmp ys)

let _ =
  merge_sort compare [8;6;4;2;1;3;5;7;9]

Oz

declare
  fun {MergeSort Xs}
     case Xs
     of nil then nil
     [] [X] then [X]
     else
        Middle = {Length Xs} div 2
        Left Right
        {List.takeDrop Xs Middle ?Left ?Right}
     in
        {List.merge {MergeSort Left} {MergeSort Right} Value.'<'}
     end
  end
in
  {Show {MergeSort [3 1 4 1 5 9 2 6 5]}}

PARI/GP

Note also that the built-in vecsort and listsort use a merge sort internally. 

mergeSort(v)={
  if(#v<2, return(v));
  my(m=#v\2,left=vector(m,i,v[i]),right=vector(#v-m,i,v[m+i]));
  left=mergeSort(left);
  right=mergeSort(right);
  merge(left, right)
};
merge(u,v)={
	my(ret=vector(#u+#v),i=1,j=1);
	for(k=1,#ret,
		if(i<=#u & (j>#v | u[i]<v[j]),
			ret[k]=u[i];
			i++
		,
			ret[k]=v[j];
			j++
		)
	);
	ret
};

Pascal

Works with: FPC
program MergeSortDemo;

{$mode objfpc}{$h+}

procedure MergeSort(var A: array of Integer);
var
  Buf: array of Integer;
  procedure Merge(L, M, R: Integer);
  var
    I, J, K: Integer;
  begin
    I := L;
    J := Succ(M);
    for K := 0 to R - L do
      if (J > R) or (I <= M) and (A[I] <= A[J]) then begin
        Buf[K] := A[I];
        Inc(I);
      end else begin
        Buf[K] := A[J];
        Inc(J);
      end;
    Move(Buf[0], A[L], Succ(R - L) * SizeOf(Integer));
  end;
  procedure MSort(L, R: Integer);
  var
    M: Integer;
  begin
    if R > L then begin
      {$push}{$q-}{$r-}M := (L + R) shr 1;{$pop}
      MSort(L, M);
      MSort(M + 1, R);
      if A[M] > A[M + 1] then
        Merge(L, M, R);
    end;
  end;
begin
  if Length(A) > 1 then begin
    SetLength(Buf, Length(A));
    MSort(0, High(A));
  end;
end;

procedure PrintArray(const Name: string; const A: array of Integer);
var
  I: Integer;
begin
  Write(Name, ': [');
  for I := 0 to High(A) - 1 do
    Write(A[I], ', ');
  WriteLn(A[High(A)], ']');
end;

var
  a1: array[-7..5] of Integer = (27, -47, 14, 39, 47, -2, -8, 20, 18, 22, -49, -40, -8);
  a2: array of Integer = (9, -25, -16, 24, 39, 42, 20, 20, 39, 10, -47, 28);
begin
  MergeSort(a1);
  PrintArray('a1', a1);
  MergeSort(a2);
  PrintArray('a2', a2);
end.
Output:
a1: [-49, -47, -40, -8, -8, -2, 14, 18, 20, 22, 27, 39, 47]
a2: [-47, -25, -16, 9, 10, 20, 20, 24, 28, 39, 39, 42]

improvement

uses "only" one halfsized temporary array for merging, which are set to the right size in before. small sized fields are sorted via insertion sort. Only an array of Pointers is sorted, so no complex data transfers are needed.Sort for X,Y or whatever is easy to implement.

Works with ( Turbo -) Delphi too. 

{$IFDEF FPC}
  {$MODE DELPHI}
  {$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE}
{$ELSE}
  {$APPTYPE CONSOLE}
{$ENDIF}
uses
  sysutils; //for timing
type
  tDataElem  =  record
                  myText : AnsiString;
                  myX,
                  myY : double;
                  myTag,
                  myOrgIdx : LongInt;
                end;
                
  tpDataElem = ^tDataElem;
  tData = array of tDataElem;
 
  tSortData = array of tpDataElem;
  tCompFunc = function(A,B:tpDataElem):integer;
var
  Data    : tData;
  Sortdata,
  tmpData : tSortData;
 
procedure InitData(var D:tData;cnt: LongWord);
var
  i,k: LongInt;
begin
  Setlength(D,cnt);
  Setlength(SortData,cnt);
  Setlength(tmpData,cnt shr 1 +1 );
  k := 10*cnt;
  For i := cnt-1 downto 0 do
  Begin
    Sortdata[i] := @D[i];
    with D[i] do
    Begin
      myText := Format('_%.9d',[random(cnt)+1]);
      myX := Random*k;
      myY := Random*k;
      myTag := Random(k);
      myOrgIdx := i;
    end;
  end;
end;
 
procedure FreeData(var D:tData);
begin
  Setlength(tmpData,0);
  Setlength(SortData,0);
  Setlength(D,0);
end;

function CompLowercase(A,B:tpDataElem):integer;
var
  lcA,lcB: String;
Begin
  lcA := lowercase(A^.myText);
  lcB := lowercase(B^.myText);  
  result := ORD(lcA > lcB)-ORD(lcA < lcB);  
end;  

function myCompText(A,B:tpDataElem):integer;
{sort an array (or list) of strings in order of descending length, 
  and in ascending lexicographic order for strings of equal length.}
var
  lA,lB:integer;
  
Begin
  lA := Length(A^.myText);
  lB := Length(B^.myText);
  result := ORD(lA<lB)-ORD(lA>lB);  
  IF result = 0 then
    result := CompLowercase(A,B);
end;
 
function myCompX(A,B:tpDataElem):integer;
//same as sign without jumps in assembler code
begin
  result := ORD(A^.myX > B^.myX)-ORD(A^.myX < B^.myX);
end;
 
function myCompY(A,B:tpDataElem):integer;
Begin
  result := ORD(A^.myY > B^.myY)-ORD(A^.myY < B^.myY);
end;
 
function myCompTag(A,B:tpDataElem):integer;
Begin
  result := ORD(A^.myTag > B^.myTag)-ORD(A^.myTag < B^.myTag);
end;
 
procedure InsertionSort(left,right:integer;var a: tSortData;CompFunc: tCompFunc);
var
   Pivot : tpDataElem;
   i,j  : LongInt;
begin
 for i:=left+1 to right do
 begin
   j :=i;
   Pivot := A[j];
   while (j>left) AND (CompFunc(A[j-1],Pivot)>0) do
   begin
     A[j] := A[j-1];
     dec(j);
   end;
   A[j] :=PiVot;// s.o.
 end;
end;
 
 
procedure mergesort(left,right:integer;var a: tSortData;CompFunc: tCompFunc);
var
  i,j,k,mid :integer;
begin
{// without insertion sort
  If right>left then
}
//{ test insertion sort
  If right-left<=14 then
     InsertionSort(left,right,a,CompFunc)
  else
//}
  begin
    //recursion
    mid := (right+left) div 2;
    mergesort(left, mid,a,CompFunc);
    mergesort(mid+1, right,a,CompFunc);
    //already sorted ?
    IF CompFunc(A[Mid],A[Mid+1])<0 then
      exit;
 
    //##########  Merge  ##########
    //copy lower half to temporary array
    move(A[left],tmpData[0],(mid-left+1)*SizeOf(Pointer));
    i := 0;
    j := mid+1;
    k := left;
    // re-integrate
    while (k<j) AND (j<=right) do
      begin
      IF CompFunc(tmpData[i],A[j])<=0 then
        begin
        A[k] := tmpData[i];
        inc(i);
        end
      else
        begin
        A[k]:= A[j];
        inc(j);
        end;
      inc(k);
      end;
    //the rest of tmpdata a move should do too, in next life
    while (k<j) do
      begin
      A[k] := tmpData[i];
      inc(i);
      inc(k);
      end;
  end;
end;
 
var
  T1,T0: TDateTime;
  i : integer;
Begin
  randomize;
  InitData(Data,1*1000*1000);
 
  T0 := Time;
  mergesort(Low(SortData),High(SortData),SortData,@myCompText);
  T1 := Time;
  Writeln('myText ',FormatDateTime('NN:SS.ZZZ',T1-T0));
//  For i := 0 to High(Data) do  Write(SortData[i].myText);  writeln;  
  T0 := Time;
  mergesort(Low(SortData),High(SortData),SortData,@myCompX);
  T1 := Time;
  Writeln('myX    ',FormatDateTime('NN:SS.ZZZ',T1-T0));
 //check
  For i := 1 to High(Data) do
    IF myCompX(SortData[i-1],SortData[i]) = 1 then
      Write(i:8);
 
  T0 := Time;
  mergesort(Low(SortData),High(SortData),SortData,@myCompY);
  T1 := Time;
  Writeln('myY    ',FormatDateTime('NN:SS.ZZZ',T1-T0));
 
  T0 := Time;
  mergesort(Low(SortData),High(SortData),SortData,@myCompTag);
  T1 := Time;
  Writeln('myTag  ',FormatDateTime('NN:SS.ZZZ',T1-T0));
 
  FreeData (Data);
end.
output
Free pascal 2.6.4 32bit / Win7 / i 4330 3.5 Ghz
myText 00:03.158 / nearly worst case , all strings same sized and starting with '_000..'
myX    00:00.360
myY    00:00.363
myTag  00:00.283

Perl

sub merge_sort {
    my @x = @_;
    return @x if @x < 2;
    my $m = int @x / 2;
    my @a = merge_sort(@x[0 .. $m - 1]);
    my @b = merge_sort(@x[$m .. $#x]);
    for (@x) {
        $_ = !@a            ? shift @b
           : !@b            ? shift @a
           : $a[0] <= $b[0] ? shift @a
           :                  shift @b;
    }
    @x;
}

my @a = (4, 65, 2, -31, 0, 99, 83, 782, 1);
@a = merge_sort @a;
print "@a\n";

Also note, the built-in function sort uses mergesort.

Phix

with javascript_semantics

function merge(sequence left, sequence right)
sequence result = {}
    while length(left)>0 and length(right)>0 do
        if left[1]<=right[1] then
            result = append(result, left[1])
            left = left[2..$]
        else
            result = append(result, right[1])
            right = right[2..$]
        end if
    end while
    return result & left & right
end function
 
function mergesort(sequence m)
    if length(m)<=1 then return m end if
    integer middle = floor(length(m)/2)
    sequence left = mergesort(m[1..middle]),
            right = mergesort(m[middle+1..$])
    if left[$]<=right[1] then
        return left & right
    elsif right[$]<=left[1] then
        return right & left
    end if
    return merge(left, right)
end function
 
constant s = shuffle(tagset(10))
? s
? mergesort(deep_copy(s))
Output:
{8,1,2,5,10,3,9,6,7,4}
{1,2,3,4,5,6,7,8,9,10}

PHP

function mergesort($arr){
	if(count($arr) == 1 ) return $arr;
	$mid = count($arr) / 2;
    $left = array_slice($arr, 0, $mid);
    $right = array_slice($arr, $mid);
	$left = mergesort($left);
	$right = mergesort($right);
	return merge($left, $right);
}

function merge($left, $right){
	$res = array();
	while (count($left) > 0 && count($right) > 0){
		if($left[0] > $right[0]){
			$res[] = $right[0];
			$right = array_slice($right , 1);
		}else{
			$res[] = $left[0];
			$left = array_slice($left, 1);
		}
	}
	while (count($left) > 0){
		$res[] = $left[0];
		$left = array_slice($left, 1);
	}
	while (count($right) > 0){
		$res[] = $right[0];
		$right = array_slice($right, 1);
	}
	return $res;
}

$arr = array( 1, 5, 2, 7, 3, 9, 4, 6, 8);
$arr = mergesort($arr);
echo implode(',',$arr);
Output:
1,2,3,4,5,6,7,8,9

Picat

Translation of: Prolog
% True if S is a sorted copy of L, using merge sort
msort([],[]).
msort([X],[X]).
msort(U,S) :-
  split(U, L, R),
  msort(L, SL),
  msort(R, SR),
  merge(SL, SR, S).
 
% split(LIST,L,R)
% Alternate elements of LIST in L and R
split([],[],[]).
split([X],[X],[]).
split([L,R|T],[L|LT],[R|RT]) :-
  split( T, LT, RT ).
 
% merge( LS, RS, M )
% Assuming LS and RS are sorted, True if M is the sorted merge of the two
merge([],RS,RS).
merge(LS,[],LS).
merge([L|LS],[R|RS],[L|T]) :-
    L @=< R, 
    merge(LS,[R|RS],T).
merge([L|LS],[R|RS],[R|T]) :-
    L @> R,
    merge([L|LS],RS,T).


PicoLisp

PicoLisp's built-in sort routine uses merge sort. This is a high level implementation. 

(de alt (List)
   (if List (cons (car List) (alt (cddr List))) ()) )

(de merge (L1 L2)
   (cond
      ((not L2) L1)
      ((< (car L1) (car L2))
         (cons (car L1) (merge L2 (cdr L1))))
      (T (cons (car L2) (merge L1 (cdr L2)))) ) )

(de mergesort (List)
   (if (cdr List)
      (merge (mergesort (alt List)) (mergesort (alt (cdr List))))
      List) )

(mergesort (8 1 5 3 9 0 2 7 6 4))

PL/I

MERGE: PROCEDURE (A,LA,B,LB,C);

/* Merge A(1:LA) with B(1:LB), putting the result in C 
   B and C may share the same memory, but not with A.
*/
   DECLARE (A(*),B(*),C(*)) BYADDR POINTER;
   DECLARE (LA,LB) BYVALUE NONASGN FIXED BIN(31);
   DECLARE (I,J,K) FIXED BIN(31);
   DECLARE (SX) CHAR(58) VAR BASED (PX);
   DECLARE (SY) CHAR(58) VAR BASED (PY);
   DECLARE (PX,PY) POINTER;

   I=1; J=1; K=1;
   DO WHILE ((I <= LA) & (J <= LB));
      PX=A(I); PY=B(J);
      IF(SX <= SY) THEN
         DO; C(K)=A(I); K=K+1; I=I+1; END;
      ELSE
         DO; C(K)=B(J); K=K+1; J=J+1; END;
   END;
   DO WHILE (I <= LA);
      C(K)=A(I); I=I+1; K=K+1;
   END;
   RETURN;
END MERGE;

MERGESORT: PROCEDURE (AP,N) RECURSIVE ;

/* Sort the array AP containing N pointers to strings */

     DECLARE (AP(*))              BYADDR POINTER;
     DECLARE (N)                  BYVALUE NONASGN FIXED BINARY(31);
     DECLARE (M,I)                FIXED BINARY;
     DECLARE AMP1(1)              POINTER BASED(PAM);
     DECLARE (pX,pY,PAM) POINTER;
     DECLARE SX CHAR(58) VAR BASED(pX);
     DECLARE SY CHAR(58) VAR BASED(pY);

   IF (N=1) THEN RETURN;
   M = trunc((N+1)/2);
   IF (M>1) THEN CALL MERGESORT(AP,M);
   PAM=ADDR(AP(M+1));
   IF (N-M > 1) THEN CALL MERGESORT(AMP1,N-M);
   pX=AP(M); pY=AP(M+1);
   IF SX <= SY then return;     /* Skip Merge */
   DO I=1 to M; TP(I)=AP(I); END;
   CALL MERGE(TP,M,AMP1,N-M,AP);
   RETURN;
END MERGESORT;

PowerShell

function MergeSort([object[]] $SortInput)
{
	# The base case exits for minimal lists that are sorted by definition
	if ($SortInput.Length -le 1) {return $SortInput}
	
	# Divide and conquer
	[int] $midPoint = $SortInput.Length/2
	# The @() operators ensure a single result remains typed as an array
	[object[]] $left = @(MergeSort @($SortInput[0..($midPoint-1)]))
	[object[]] $right = @(MergeSort @($SortInput[$midPoint..($SortInput.Length-1)]))

	# Merge
	[object[]] $result = @()
	while (($left.Length -gt 0) -and ($right.Length -gt 0))
	{
		if ($left[0] -lt $right[0])
		{
			$result += $left[0]
			# Use an if/else rather than accessing the array range as $array[1..0]
			if ($left.Length -gt 1){$left = $left[1..$($left.Length-1)]}
			else {$left = @()}
		}
		else
		{
			$result += $right[0]
			# Without the if/else, $array[1..0] would return the whole array when $array.Length == 1
			if ($right.Length -gt 1){$right = $right[1..$($right.Length-1)]}
			else {$right = @()}
		}
	}
	
	# If we get here, either $left or $right is an empty array (or both are empty!).  Since the
	# rest of the unmerged array is already sorted, we can simply string together what we have.
	# This line outputs the concatenated result.  An explicit 'return' statement is not needed.
	$result + $left + $right
}

Prolog

% msort( L, S )
% True if S is a sorted copy of L, using merge sort
msort( [], [] ).
msort( [X], [X] ).
msort( U, S ) :- split(U, L, R), msort(L, SL), msort(R, SR), merge(SL, SR, S).

% split( LIST, L, R )
% Alternate elements of LIST in L and R
split( [], [], [] ).
split( [X], [X], [] ).
split( [L,R|T], [L|LT], [R|RT] ) :- split( T, LT, RT ).

% merge( LS, RS, M )
% Assuming LS and RS are sorted, True if M is the sorted merge of the two
merge( [], RS, RS ).
merge( LS, [], LS ).
merge( [L|LS], [R|RS], [L|T] ) :- L =< R, merge(    LS, [R|RS], T).
merge( [L|LS], [R|RS], [R|T] ) :- L > R,  merge( [L|LS],   RS,  T).

PureBasic

A non-optimized version with lists. 

Procedure display(List m())
  ForEach m()
    Print(LSet(Str(m()), 3," "))
  Next
  PrintN("")
EndProcedure

;overwrites list m() with the merger of lists ma() and mb()
Procedure merge(List m(), List ma(), List mb())
  FirstElement(m())
  Protected ma_elementExists = FirstElement(ma())
  Protected mb_elementExists = FirstElement(mb()) 
  Repeat
    If ma() <= mb()
      m() = ma(): NextElement(m())
      ma_elementExists = NextElement(ma())
    Else
      m() = mb(): NextElement(m())
      mb_elementExists = NextElement(mb())
    EndIf
  Until Not (ma_elementExists And mb_elementExists)

  If ma_elementExists
    Repeat
      m() = ma(): NextElement(m())
    Until Not NextElement(ma())
  ElseIf mb_elementExists
    Repeat
      m() = mb(): NextElement(m())
    Until Not NextElement(mb())
  EndIf
EndProcedure

Procedure mergesort(List m())
  Protected NewList ma()
  Protected NewList mb()
  
  If ListSize(m()) > 1
    Protected current, middle = (ListSize(m()) / 2 ) - 1
    
    FirstElement(m())
    While current <= middle
      AddElement(ma())
      ma() = m()
      NextElement(m()): current + 1
    Wend
    
    PreviousElement(m())
    While NextElement(m())
      AddElement(mb())
      mb() = m()
    Wend
    
    mergesort(ma())
    mergesort(mb())
    LastElement(ma()): FirstElement(mb())
    If ma() <= mb() 
      FirstElement(m())
      FirstElement(ma())
      Repeat
        m() = ma(): NextElement(m())
      Until Not NextElement(ma())
      Repeat
        m() = mb(): NextElement(m())
      Until Not NextElement(mb())
    Else 
      merge(m(), ma(), mb())
    EndIf 
  EndIf 
EndProcedure
  
If OpenConsole()
  Define i
  NewList x()
  
  For i = 1 To 21: AddElement(x()): x() = Random(60): Next
  display(x())
  mergesort(x())
  display(x())
  
  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit")
  Input()
  CloseConsole()
EndIf
Sample output:
22 51 31 59 58 45 11 2  16 56 38 42 2  10 23 41 42 25 45 28 42
2  2  10 11 16 22 23 25 28 31 38 41 42 42 42 45 45 51 56 58 59

Python

Works with: Python version 2.6+
from heapq import merge

def merge_sort(m):
    if len(m) <= 1:
        return m

    middle = len(m) // 2
    left = m[:middle]
    right = m[middle:]

    left = merge_sort(left)
    right = merge_sort(right)
    return list(merge(left, right))

Pre-2.6, merge() could be implemented like this: 

def merge(left, right):
    result = []
    left_idx, right_idx = 0, 0
    while left_idx < len(left) and right_idx < len(right):
        # change the direction of this comparison to change the direction of the sort
        if left[left_idx] <= right[right_idx]:
            result.append(left[left_idx])
            left_idx += 1
        else:
            result.append(right[right_idx])
            right_idx += 1

    if left_idx < len(left):
        result.extend(left[left_idx:])
    if right_idx < len(right):
        result.extend(right[right_idx:])
    return result

using only recursions 

def merge(x, y):
    if x==[]: return y
    if y==[]: return x
    return [x[0]] + merge(x[1:], y) if x[0]<y[0] else [y[0]] + merge(x, y[1:])

def sort(a, n):
    m = n//2
    return a if n<=1 else merge(sort(a[:m], m), sort(a[m:], n-m))

a = list(map(int, input().split()))
print(sort(a, len(a)))

Quackery

[ [] temp put
  [ dup  [] != while
    over [] != while
    over 0 peek
    over 0 peek
    > not if dip
      [ 1 split
        temp take
        rot join
        temp put ]
      again ]
    join
    temp take swap join ] is merge     ( [ [ --> [ )

[ dup size 2 < if done
  dup size 2 / split
  swap recurse
  swap recurse
  merge ]                 is mergesort (   [ --> [ )

R

mergesort <- function(m)
{
   merge_ <- function(left, right)
   {
      result <- c()
      while(length(left) > 0 && length(right) > 0)
      {
         if(left[1] <= right[1])
         {
            result <- c(result, left[1])
            left <- left[-1]
         } else
         {
            result <- c(result, right[1])
            right <- right[-1]
         }         
      }
      if(length(left) > 0) result <- c(result, left)
      if(length(right) > 0) result <- c(result, right)
      result
   }
   
   len <- length(m)
   if(len <= 1) m else
   {
      middle <- length(m) / 2
      left <- m[1:floor(middle)]
      right <- m[floor(middle+1):len]
      left <- mergesort(left)
      right <- mergesort(right)
      if(left[length(left)] <= right[1])
      {
         c(left, right)
      } else
      {
         merge_(left, right)
      } 
   }
}
mergesort(c(4, 65, 2, -31, 0, 99, 83, 782, 1)) # -31   0   1   2   4  65  83  99 782

Racket

#lang racket

(define (merge xs ys)
  (cond [(empty? xs) ys]
        [(empty? ys) xs]
        [(match* (xs ys)
           [((list* a as) (list* b bs))
            (cond [(<= a b) (cons a (merge as ys))]
                  [         (cons b (merge xs bs))])])]))

(define (merge-sort xs)
  (match xs
    [(or (list) (list _)) xs]
    [_ (define-values (ys zs) (split-at xs (quotient (length xs) 2)))
       (merge (merge-sort ys) (merge-sort zs))]))

This variation is bottom up: 

#lang racket

(define (merge-sort xs)
  (merge* (map list xs)))

(define (merge* xss)
  (match xss
    [(list)    '()]
    [(list xs) xss]
    [(list xs ys zss ...) 
     (merge* (cons (merge xs ys) (merge* zss)))]))

(define (merge xs ys)
  (cond [(empty? xs) ys]
        [(empty? ys) xs]
        [(match* (xs ys)
           [((list* a as) (list* b bs))
            (cond [(<= a b) (cons a (merge as ys))]
                  [         (cons b (merge xs bs))])])]))

Raku

#| Recursive, single-thread, mergesort implementation
sub mergesort ( @a ) {
	return @a if @a <= 1;

	# recursion step
	my $m = @a.elems div 2;
	my @l = samewith @a[  0 ..^ $m ];
	my @r = samewith @a[ $m ..^ @a ];

	# short cut - in case of no overlapping in left and right parts
	return flat @l, @r if @l[*-1] !after @r[0];
	return flat @r, @l if @r[*-1] !after @l[0];

	# merge step
	return flat gather {
		take @l[0] before @r[0]
				?? @l.shift
				!! @r.shift
		     while @l and @r;

		take @l, @r;
	}
}

Some intial testing 

my @data = 6, 7, 2, 1, 8, 9, 5, 3, 4;
say 'input  = ' ~ @data;
say 'output = ' ~ @data.&merge_sort;
Output:
input  = 6 7 2 1 8 9 5 3 4
output = 1 2 3 4 5 6 7 8 9

concurrent implementation

Let's implement it using parallel sorting. 

#| Recursive, naive multi-thread, mergesort implementation
sub mergesort-parallel-naive ( @a ) {
	return @a if @a <= 1;

	my $m = @a.elems div 2;

	# recursion step launching new thread
    my @l = start { samewith @a[ 0  ..^ $m ] };
	
    # meanwhile recursively sort right side
    my @r =         samewith @a[ $m ..^ @a ]  ;

	# as we went parallel on left side, we need to await the result
	await @l[0] andthen @l = @l[0].result;

	# short cut - in case of no overlapping left and right parts
	return flat @l, @r if @l[*-1] !after @r[0];
	return flat @r, @l if @r[*-1] !after @l[0];

	# merge step
	return flat gather {
		take @l[0] before @r[0]
				?? @l.shift
				!! @r.shift
		     while @l and @r;

		take @l, @r;
	}
}

and tune the batch size required to launch a new thread. 

#| Recursive, batch tuned multi-thread, mergesort implementation
sub mergesort-parallel ( @a, $batch = 2**9 ) {
	return @a if @a <= 1;

	my $m = @a.elems div 2;

	# recursion step
	my @l = $m >= $batch
			  ?? start { samewith @a[ 0 ..^ $m ], $batch }
			  !!         samewith @a[ 0 ..^ $m ], $batch ;

	# meanwhile recursively sort right side
	my @r = samewith @a[ $m ..^ @a ], $batch;

	# if we went parallel on left side, we need to await the result
	await @l[0] andthen @l = @l[0].result if @l[0] ~~ Promise;

	# short cut - in case of no overlapping left and right parts
	return flat @l, @r if @l[*-1] !after @r[0];
	return flat @r, @l if @r[*-1] !after @l[0];

	# merge step
	return flat gather {
		take @l[0] before @r[0]
				?? @l.shift
				!! @r.shift
		     while @l and @r;

		take @l, @r;
	}
}

testing

Let's run some tests ... 

say "x" x 10 ~ " Testing " ~ "x" x 10;
use Test;
my @functions-under-test = &mergesort, &mergesort-parallel-naive, &mergesort-parallel;
my @testcases =
		() => (),
		<a>.List => <a>.List,
		<a a> => <a a>,
		("b", "a", 3) => (3, "a", "b"),
		<h b a c d f e g> => <a b c d e f g h>,
		<a 🎮 3 z 4 🐧> => <a 🎮 3 z 4 🐧>.sort
		;

plan @testcases.elems * @functions-under-test.elems;
for @functions-under-test -> &fun {
	say &fun.name;
	is-deeply &fun(.key), .value, .key ~ "  =>  " ~ .value for @testcases;
}
done-testing;
Output:
xxxxxxxxxx Testing xxxxxxxxxx
1..18
mergesort
ok 1 -   =>
ok 2 - a  =>  a
ok 3 - a a  =>  a a
ok 4 - b a 3  =>  3 a b
ok 5 - h b a c d f e g  =>  a b c d e f g h
ok 6 - a 🎮 3 z 4 🐧  =>  3 4 a z 🎮 🐧
mergesort-parallel-naive
ok 7 -   =>
ok 8 - a  =>  a
ok 9 - a a  =>  a a
ok 10 - b a 3  =>  3 a b
ok 11 - h b a c d f e g  =>  a b c d e f g h
ok 12 - a 🎮 3 z 4 🐧  =>  3 4 a z 🎮 🐧
mergesort-parallel
ok 13 -   =>
ok 14 - a  =>  a
ok 15 - a a  =>  a a
ok 16 - b a 3  =>  3 a b
ok 17 - h b a c d f e g  =>  a b c d e f g h
ok 18 - a 🎮 3 z 4 🐧  =>  3 4 a z 🎮 🐧

benchmarking

and some Benchmarking. 

use Benchmark;
my $runs = 5;
my $elems = 10 * Kernel.cpu-cores * 2**10;
my @unsorted of Str = ('a'..'z').roll(8).join xx $elems;
my UInt $l-batch = 2**13;
my UInt $m-batch = 2**11;
my UInt $s-batch = 2**9;
my UInt $t-batch = 2**7;

say "elements: $elems, runs: $runs, cpu-cores: {Kernel.cpu-cores}, large/medium/small/tiny-batch: $l-batch/$m-batch/$s-batch/$t-batch";

my %results = timethese $runs, {
	single-thread         => { mergesort(@unsorted) },
	parallel-naive        => { mergesort-parallel-naive(@unsorted) },
	parallel-tiny-batch   => { mergesort-parallel(@unsorted, $t-batch) },
	parallel-small-batch  => { mergesort-parallel(@unsorted, $s-batch) },
	parallel-medium-batch => { mergesort-parallel(@unsorted, $m-batch) },
	parallel-large-batch  => { mergesort-parallel(@unsorted, $l-batch) },
}, :statistics;

my @metrics = <mean median sd>;
my $msg-row = "%.4f\t" x @metrics.elems ~ '%s';

say @metrics.join("\t");
for %results.kv -> $name, %m {
	say sprintf($msg-row, %m{@metrics}, $name);
}

elements: 40960, runs: 5, cpu-cores: 4, large/medium/small/tiny-batch: 8192/2048/512/128
mean	median	sd
7.7683	8.0265	0.5724	parallel-naive
3.1354	3.1272	0.0602	parallel-tiny-batch
2.6932	2.6599	0.1831	parallel-medium-batch
2.8139	2.7832	0.0641	parallel-large-batch
3.0908	3.0593	0.0675	parallel-small-batch
5.9989	5.9450	0.1518	single-thread

REBOL

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
]

Refal

$ENTRY Go {
    , 7 6 5 9 8 4 3 1 2 0: e.Arr
    = <Prout e.Arr>
      <Prout <Sort e.Arr>>;
};

Sort {
    = ;
    s.N = s.N;
    e.X, <Split e.X>: (e.L) (e.R) = <Merge (<Sort e.L>) (<Sort e.R>)>;
};

Split {
    (e.L) (e.R) = (e.L) (e.R);
    (e.L) (e.R) s.X = (e.L s.X) (e.R);
    (e.L) (e.R) s.X s.Y e.Z = <Split (e.L s.X) (e.R s.Y) e.Z>;
    e.X = <Split () () e.X>;
};

Merge {
    (e.L) () = e.L;
    () (e.R) = e.R;
    (s.X e.L) (s.Y e.R), <Compare s.X s.Y>: {
        '-' = s.X <Merge (e.L) (s.Y e.R)>;
        s.Z = s.Y <Merge (s.X e.L) (e.R)>;
    };
};
Output:
7 6 5 9 8 4 3 1 2 0
0 1 2 3 4 5 6 7 8 9

REXX

Note:   the array elements can be anything:   integers, floating point (exponentiated), character strings ··· 

/*REXX pgm sorts a stemmed array (numbers and/or chars) using the  merge─sort algorithm.*/
call init                                        /*sinfully initialize the   @   array. */
call show      'before sort'                     /*show the   "before"  array elements. */
                            say copies('▒', 75)  /*display a separator line to the term.*/
call merge          #                            /*invoke the  merge sort  for the array*/
call show      ' after sort'                     /*show the    "after"  array elements. */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
init: @.=;    @.1= '---The seven deadly sins---'  ;    @.4= "avarice"  ;   @.7= 'gluttony'
              @.2= '==========================='  ;    @.5= "wrath"    ;   @.8= 'sloth'
              @.3= 'pride'                        ;    @.6= "envy"     ;   @.9= 'lust'
      do #=1  until @.#==''; end;   #= #-1;   return      /*#:  # of entries in @ array.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: do j=1  for #; say right('element',20) right(j,length(#)) arg(1)":" @.j; end; return
/*──────────────────────────────────────────────────────────────────────────────────────*/
merge: procedure expose @. !.;   parse arg n, L;   if L==''  then do;  !.=;  L= 1;  end
          if n==1  then return;     h= L + 1
          if n==2  then do; if @.L>@.h  then do; _=@.h; @.h=@.L; @.L=_; end; return;  end
          m= n % 2                                     /* [↑]  handle case of two items.*/
          call merge  n-m, L+m                         /*divide items  to the left   ···*/
          call merger m,   L,   1                      /*   "     "     "  "  right  ···*/
          i= 1;                     j= L + m
                     do k=L  while k<j                 /*whilst items on right exist ···*/
                     if j==L+n  |  !.i<=@.j  then do;     @.k= !.i;     i= i + 1;      end
                                             else do;     @.k= @.j;     j= j + 1;      end
                     end   /*k*/
          return
/*──────────────────────────────────────────────────────────────────────────────────────*/
merger: procedure expose @. !.;  parse arg n,L,T
           if n==1  then do;  !.T= @.L;                                       return;  end
           if n==2  then do;  h= L + 1;   q= T + 1;  !.q= @.L;    !.T= @.h;   return;  end
           m= n % 2                                    /* [↑]  handle case of two items.*/
           call merge  m,   L                          /*divide items  to the left   ···*/
           call merger n-m, L+m, m+T                   /*   "     "     "  "  right  ···*/
           i= L;                     j= m + T
                     do k=T  while k<j                 /*whilst items on left exist  ···*/
                     if j==T+n  |  @.i<=!.j  then do;     !.k= @.i;     i= i + 1;      end
                                             else do;     !.k= !.j;     j= j + 1;      end
                     end   /*k*/
           return
output   when using the default input:

(Shown at three-quarter size.) 

             element 1 before sort: ---The seven deadly sins---
             element 2 before sort: ===========================
             element 3 before sort: pride
             element 4 before sort: avarice
             element 5 before sort: wrath
             element 6 before sort: envy
             element 7 before sort: gluttony
             element 8 before sort: sloth
             element 9 before sort: lust
▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
             element 1  after sort: ---The seven deadly sins---
             element 2  after sort: ===========================
             element 3  after sort: avarice
             element 4  after sort: envy
             element 5  after sort: gluttony
             element 6  after sort: lust
             element 7  after sort: pride
             element 8  after sort: sloth
             element 9  after sort: wrath

Ruby

def merge_sort(m)
  return m if m.length <= 1
  
  middle = m.length / 2
  left = merge_sort(m[0...middle])
  right = merge_sort(m[middle..-1])
  merge(left, right)
end

def merge(left, right)
  result = []
  until left.empty? || right.empty?
    result << (left.first<=right.first ? left.shift : right.shift)
  end
  result + left + right
end

ary = [7,6,5,9,8,4,3,1,2,0]
p merge_sort(ary)                  # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]

Here's a version that monkey patches the Array class, with an example that demonstrates it's a stable sort 

class Array
  def mergesort(&comparitor)
    return self if length <= 1
    comparitor ||= proc{|a, b| a <=> b}
    middle = length / 2
    left  = self[0...middle].mergesort(&comparitor)
    right = self[middle..-1].mergesort(&comparitor)
    merge(left, right, comparitor) 
  end
  
  private
  def merge(left, right, comparitor)
    result = []
    until left.empty? || right.empty?
      # change the direction of this comparison to change the direction of the sort
      if comparitor[left.first, right.first] <= 0
        result << left.shift
      else
        result << right.shift
      end
    end
    result + left + right
  end
end

ary = [7,6,5,9,8,4,3,1,2,0]
p ary.mergesort                    # => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
p ary.mergesort {|a, b| b <=> a}   # => [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]

ary = [["UK", "London"], ["US", "New York"], ["US", "Birmingham"], ["UK", "Birmingham"]]
p ary.mergesort
# => [["UK", "Birmingham"], ["UK", "London"], ["US", "Birmingham"], ["US", "New York"]]
p ary.mergesort {|a, b| a[1] <=> b[1]}
# => [["US", "Birmingham"], ["UK", "Birmingham"], ["UK", "London"], ["US", "New York"]]

Rust

Works with: rustc version 1.9.0

Recursive with buffer equal to the size of the sort vector 

pub fn merge_sort1<T: Copy + Ord>(v: &mut [T]) {
    sort(v, &mut Vec::new());

    fn sort<T: Copy + Ord>(v: &mut [T], t: &mut Vec<T>) {
        match v.len() {
            0 | 1 => (),
            // n if n <= 20 => insertion_sort(v),
            n => {
                if t.is_empty() {
                    t.reserve_exact(n);
                    t.resize(n, v[0]);
                }
                let m = n / 2;
                sort(&mut v[..m], t);
                sort(&mut v[m..], t);
                if v[m - 1] <= v[m] {
                    return;
                }
                copy(v, t);
                merge(&t[..m], &t[m..n], v);
            }
        }
    }

    // merge a + b -> c
    #[inline(always)]
    fn merge<T: Copy + Ord>(a: &[T], b: &[T], c: &mut [T]) {
        let (mut i, mut j) = (0, 0);
        for k in 0..c.len() {
            if i < a.len() && (j >= b.len() || a[i] <= b[j]) {
                c[k] = a[i];
                i += 1;
            } else {
                c[k] = b[j];
                j += 1;
            }
        }
    }

    #[inline(always)]
    fn copy<T: Copy>(src: &[T], dst: &mut [T]) {
        for i in 0..src.len() {
            dst[i] = src[i];
        }
    }

    #[inline(always)]
    fn insertion_sort<T: Ord>(v: &mut [T]) {
        for i in 1..v.len() {
            let mut j = i;
            while j > 0 && v[j] < v[j - 1] {
                v.swap(j, j - 1);
                j -= 1;
            }
        }
    }
}

Recursive with buffer equal to half the size of the sort vector 

pub fn merge_sort2<T: Copy + Ord>(v: &mut [T]) {
    sort(v, &mut Vec::new());

    fn sort<T: Copy + Ord>(v: &mut [T], t: &mut Vec<T>) {
        match v.len() {
            0 | 1 => (),
            // n if n <= 20 => insertion_sort(v),
            n => {
                let m = n / 2;
                if t.is_empty() {
                    t.reserve_exact(m);
                    t.resize(m, v[0]);
                }
                sort(&mut v[..m], t);
                sort(&mut v[m..], t);
                if v[m - 1] <= v[m] {
                    return;
                }
                copy(&v[..m], t);
                merge(&t[..m], v);
            }
        }
    }

    // merge a + b[a.len..] -> b
    #[inline(always)]
    fn merge<T: Copy + Ord>(a: &[T], b: &mut [T]) {
        let (mut i, mut j) = (0, a.len());
        for k in 0..b.len() {
            if i < a.len() && (j >= b.len() || a[i] <= b[j]) {
                b[k] = a[i];
                i += 1;
            } else {
                b[k] = b[j];
                j += 1;
            }
        }
    }

    #[inline(always)]
    fn copy<T: Copy>(src: &[T], dst: &mut [T]) {
        for i in 0..src.len() {
            dst[i] = src[i];
        }
    }
}

Version without recursion call: 

pub fn merge_sort3<T: Copy + Ord>(v: &mut [T]) {
    match v.len() {
        0 | 1 => (),
        n => {
            let mut t = Vec::with_capacity(n);
            t.resize(n, v[0]);
            let mut p = 1;
            while p < n {
                p = merge_blocks(v, &mut t, p, n);
                if p >= n {
                    copy(&t, v);
                    return;
                }
                p = merge_blocks(&t, v, p, n);
            }
        }
    }

    #[inline(always)]
    fn merge_blocks<T: Copy + Ord>(a: &[T], b: &mut [T], p: usize, n: usize) -> usize {
        let mut i = 0;
        while i < n {
            if i + p >= n {
                copy(&a[i..], &mut b[i..])
            } else if i + p * 2 > n {
                merge(&a[i..i + p], &a[i + p..], &mut b[i..]);
            } else {
                merge(&a[i..i + p], &a[i + p..i + p * 2], &mut b[i..i + p * 2]);
            }
            i += p * 2;
        }
        p * 2
    }

    // merge a + b -> c
    #[inline(always)]
    fn merge<T: Copy + Ord>(a: &[T], b: &[T], c: &mut [T]) {
        let (mut i, mut j, mut k) = (0, 0, 0);
        while i < a.len() && j < b.len() {
            if a[i] < b[j] {
                c[k] = a[i];
                i += 1;
            } else {
                c[k] = b[j];
                j += 1;
            }
            k += 1;
        }
        if i < a.len() {
            copy(&a[i..], &mut c[k..]);
        }
        if j < b.len() {
            copy(&b[j..], &mut c[k..]);
        }
    }

    #[inline(always)]
    fn copy<T: Copy>(src: &[T], dst: &mut [T]) {
        for i in 0..src.len() {
            dst[i] = src[i];
        }
    }
}

Scala

The use of LazyList as the merge result avoids stack overflows without resorting to tail recursion, which would typically require reversing the result, as well as being a bit more convoluted. 

import scala.language.implicitConversions

object MergeSort extends App {

  def mergeSort(input: List[Int]): List[Int] = {
    def merge(left: List[Int], right: List[Int]): LazyList[Int] = (left, right) match {
      case (x :: xs, y :: ys) if x <= y => x #:: merge(xs, right)
      case (x :: xs, y :: ys) => y #:: merge(left, ys)
      case _ => if (left.isEmpty) right.to(LazyList) else left.to(LazyList)
    }

    def sort(input: List[Int], length: Int): List[Int] = input match {
      case Nil | List(_) => input
      case _ =>
        val middle = length / 2
        val (left, right) = input splitAt middle
        merge(sort(left, middle), sort(right, middle + length % 2)).toList
    }

    sort(input, input.length)
  }

}

Scheme

(define (merge-sort l gt?)
  (define (merge left right)
    (cond
     ((null? left)
      right)
     ((null? right)
      left)
     ((gt? (car left) (car right))
      (cons (car right)
            (merge left (cdr right))))
     (else
      (cons (car left)
            (merge (cdr left) right)))))
  (define (take l n)
    (if (zero? n)
      (list)
      (cons (car l)
            (take (cdr l) (- n 1)))))
  (let ((half (quotient (length l) 2)))
    (if (zero? half)
      l
      (merge (merge-sort (take      l half) gt?)
             (merge-sort (list-tail l half) gt?)))))
(merge-sort '(1 3 5 7 9 8 6 4 2) >)

Seed7

const proc: mergeSort2 (inout array elemType: arr, in integer: lo, in integer: hi, inout array elemType: scratch) is func
  local
    var integer: mid is 0;
    var integer: k is 0;
    var integer: t_lo is 0;
    var integer: t_hi is 0;
  begin
    if lo < hi then
      mid := (lo + hi) div 2;
      mergeSort2(arr, lo, mid, scratch);
      mergeSort2(arr, succ(mid), hi, scratch);
      t_lo := lo;
      t_hi := succ(mid);
      for k range lo to hi do
        if t_lo <= mid and (t_hi > hi or arr[t_lo] <= arr[t_hi]) then
          scratch[k] := arr[t_lo];
          incr(t_lo);
        else
          scratch[k] := arr[t_hi];
          incr(t_hi);
        end if;
      end for;
      for k range lo to hi do
        arr[k] := scratch[k];
      end for;
    end if;
  end func;

const proc: mergeSort2 (inout array elemType: arr) is func
  local
    var array elemType: scratch is 0 times elemType.value;
  begin
    scratch := length(arr) times elemType.value;
    mergeSort2(arr, 1, length(arr), scratch);
  end func;

Original source: [3]

SETL

program merge_sort;
    test := [-8, 241, 9, 316, -6, 3, 413, 9, 10];
    print(test, '=>', mergesort(test));

    proc mergesort(m);
        if #m <= 1 then
            return m;
        end if;

        middle := #m div 2;
        left := mergesort(m(..middle));
        right := mergesort(m(middle+1..));
        if left(#left) <= right(1) then
            return left + right;
        end if;
        return merge(left, right);
    end proc;

    proc merge(left, right);
        result := [];
        loop while left /= [] and right /= [] do
            if left(1) <= right(1) then
                item fromb left;
            else
                item fromb right;
            end if;
            result with:= item;
        end loop;
        return result + left + right;
    end proc;
end program;
Output:
[-8 241 9 316 -6 3 413 9 10] => [-8 -6 3 9 9 10 241 316 413]

Sidef

func merge(left, right) {
    var result = []
    while (left && right) {
        result << [right,left].min_by{.first}.shift
    }
    result + left + right
}
 
func mergesort(array) {
    var len = array.len
    len < 2 && return array
 
    var (left, right) = array.part(len//2)
 
    left  = __FUNC__(left)
    right = __FUNC__(right)
 
    merge(left, right)
}
 
# Numeric sort
var nums = rand(1..100, 10)
say mergesort(nums)
 
# String sort
var strings = rand('a'..'z', 10)
say mergesort(strings)

Standard ML

fun merge cmp ([], ys) = ys
  | merge cmp (xs, []) = xs
  | merge cmp (xs as x::xs', ys as y::ys') =
      case cmp (x, y) of
        GREATER => y :: merge cmp (xs, ys')
      | _       => x :: merge cmp (xs', ys)

fun merge_sort cmp [] = []
  | merge_sort cmp [x] = [x]
  | merge_sort cmp xs = let
      val ys = List.take (xs, length xs div 2)
      val zs = List.drop (xs, length xs div 2)
    in
      merge cmp (merge_sort cmp ys, merge_sort cmp zs)
    end
Poly/ML:
> merge_sort Int.compare [8,6,4,2,1,3,5,7,9];
val it = [1, 2, 3, 4, 5, 6, 7, 8, 9]: int list
> merge_sort String.compare ["Plum", "Pear", "Peach", "Each"];
val it = ["Each", "Peach", "Pear", "Plum"]: string list
> 
</syntaxhighlight>

=={{header|Swift}}==
<syntaxhighlight lang="swift">// Merge Sort in Swift 4.2
// Source: https://github.com/raywenderlich/swift-algorithm-club/tree/master/Merge%20Sort
// NOTE: by use of generics you can make it sort arrays of any type that conforms to
//       Comparable protocol, however this is not always optimal

import Foundation

func mergeSort(_ array: [Int]) -> [Int] {
  guard array.count > 1 else { return array }

  let middleIndex = array.count / 2

  let leftPart = mergeSort(Array(array[0..<middleIndex]))
  let rightPart = mergeSort(Array(array[middleIndex..<array.count]))

  func merge(left: [Int], right: [Int]) -> [Int] {
    var leftIndex = 0
    var rightIndex = 0
  
    var merged = [Int]()
    merged.reserveCapacity(left.count + right.count)
  
    while leftIndex < left.count && rightIndex < right.count {
      if left[leftIndex] < right[rightIndex] {
        merged.append(left[leftIndex])
        leftIndex += 1
      } else if left[leftIndex] > right[rightIndex] {
        merged.append(right[rightIndex])
        rightIndex += 1
      } else {
        merged.append(left[leftIndex])
        leftIndex += 1
        merged.append(right[rightIndex])
        rightIndex += 1
      }
    }
  
    while leftIndex < left.count {
      merged.append(left[leftIndex])
      leftIndex += 1
    }
  
    while rightIndex < right.count {
      merged.append(right[rightIndex])
      rightIndex += 1
    }
  
    return merged
  }

  return merge(left: leftPart, right: rightPart)
}</syntaxhighlight>

=={{header|Tailspin}}==
The standard recursive merge sort
<syntaxhighlight lang="tailspin">
templates mergesort
  templates merge
    @: $(2);
    [ $(1)... -> #, $@...] !

    when <?($@ <[](0)>)
    | ..$@(1)> do
      $ !
    otherwise
      ^@(1) !
      $ -> #
  end merge
  $ -> #

  when <[](0..1)> do $!
  otherwise
    def half: $::length ~/ 2;
    [$(1..$half) -> mergesort, $($half+1..last) -> mergesort] -> merge !
end mergesort

[4,5,3,8,1,2,6,7,9,8,5] -> mergesort -> !OUT::write
</syntaxhighlight>
{{out}}
<pre>
[1, 2, 3, 4, 5, 5, 6, 7, 8, 8, 9]

A little different spin where the array is first split into a list of single-element lists and then merged. 

templates mergesort
  templates merge
    @: $(2);
    $(1)... -> \(
      when <?($@merge<[](0)>)
      | ..$@merge(1)> do
        $ !
      otherwise
        ^@merge(1) !
        $ -> #
     \) !
     $@... !
  end merge

  templates mergePairs
    when <[](1)> do
      $(1) !
    when <[](2..)> do
      [$(1..2) -> merge] !
      $(3..last) -> #
  end mergePairs

  templates mergeAll
    when <[](0)> do
      $ !
    when <[](1)> do
      $(1) !
    otherwise
      [ $ -> mergePairs ] -> #
  end mergeAll

  $ -> [ $... -> [ $ ] ] -> mergeAll !
end mergesort

[4,5,3,8,1,2,6,7,9,8,5] -> mergesort -> !OUT::write
Output:
[1, 2, 3, 4, 5, 5, 6, 7, 8, 8, 9]

Tcl

package require Tcl 8.5

proc mergesort m {
    set len [llength $m]
    if {$len <= 1} {
        return $m
    }
    set middle [expr {$len / 2}]
    set left [lrange $m 0 [expr {$middle - 1}]]
    set right [lrange $m $middle end]
    return [merge [mergesort $left] [mergesort $right]]
}

proc merge {left right} {
    set result [list]
    while {[set lleft [llength $left]] > 0 && [set lright [llength $right]] > 0} {
        if {[lindex $left 0] <= [lindex $right 0]} {
            set left [lassign $left value]
        } else {
            set right [lassign $right value]
        }
        lappend result $value
    }
    if {$lleft > 0} {
        lappend result {*}$left
    }
    if {$lright > 0} {
        set result [concat $result $right] ;# another way append elements
    }
    return $result
}

puts [mergesort {8 6 4 2 1 3 5 7 9}] ;# => 1 2 3 4 5 6 7 8 9

Also note that Tcl's built-in lsort command uses the mergesort algorithm.

Unison

mergeSortBy : (i ->{𝕖} i ->{𝕖} Boolean) ->{𝕖} [i] ->{𝕖} [i]
mergeSortBy cmp =
  merge l1 l2 =
    match (l1, l2) with
      (xs, [])           -> xs
      ([], ys)           -> ys
      (x +: xs, y +: ys) -> if cmp x y then x +: merge xs l2 else y +: merge l1 ys
      ([], [])           -> []
  cases
    []  -> []
    [x] -> [x]
    lst ->
      match halve lst with
        (left, right) -> merge (mergeSortBy cmp left) (mergeSortBy cmp right)

UnixPipes

Works with: Zsh
split() {
   (while read a b ; do
       echo $a > $1 ; echo $b > $2
   done)
}

mergesort() {
 xargs -n 2 | (read a b; test -n "$b" && (
     lc="1.$1" ; gc="2.$1"
     (echo $a $b;cat)|split >(mergesort $lc >$lc) >( mergesort $gc >$gc)
     sort -m $lc $gc
     rm -f $lc $gc;
 ) || echo $a)
}

cat to.sort | mergesort

Ursala

#import std

mergesort "p" = @iNCS :-0 ~&B^?a\~&YaO "p"?abh/~&alh2faltPrXPRC ~&arh2falrtPXPRC

#show+

example = mergesort(lleq) <'zoh','zpb','hhh','egi','bff','cii','yid'>
Output:
bff
cii
egi
hhh
yid
zoh
zpb

The mergesort function could also have been defined using the built in sorting operator, -<, because the same algorithm is used. 

mergesort "p" = "p"-<

V

merge uses the helper mergei to merge two lists. The mergei takes a stack of the form [mergedlist] [list1] [list2] it then extracts one element from list2, splits the list1 with it, joins the older merged list, first part of list1 and the element that was used for splitting (taken from list2) into the new merged list. the new list1 is the second part of the split on older list1. new list2 is the list remaining after the element e2 was extracted from it. 

[merge
   [mergei
       uncons [swap [>] split] dip
       [[*m] e2 [*a1] b1 a2 : [*m *a1 e2] b1 a2] view].
    
   [a b : [] a b] view
   [size zero?] [pop concat]
       [mergei]
   tailrec].

[msort
  [splitat [arr a : [arr a take arr a drop]] view i].
  [splitarr dup size 2 / >int splitat].

  [small?] []
    [splitarr]
    [merge]
  binrec].
[8 7 6 5 4 2 1 3 9] msort puts

V (Vlang)

fn main() {
    mut a := [170, 45, 75, -90, -802, 24, 2, 66]
    println("before: $a")
    a = merge_sort(a)
    println("after: $a")
}
 
fn merge_sort(m []int) []int {
    if m.len <= 1{
        return m
    } else {
        mid := m.len / 2
        mut left := merge_sort(m[..mid])
        mut right := merge_sort(m[mid..])
        if m[mid-1] <= m[mid] {
            left << right
            return left
        }
        return merge(mut left, mut right)
    }
}

fn merge(mut left []int,mut right []int) []int {
    mut result := []int{}
    for left.len > 0 && right.len > 0 {
        if left[0] <= right[0]{
            result << left[0]
            left = left[1..]
        } else {
            result << right[0]
            right = right[1..]
        }
    }
    if left.len > 0  {
        result << left
    }
    if right.len > 0 {
        result << right
    }
    return result
}

Wren

var merge = Fn.new { |left, right|
    var result = []
    while (left.count > 0 && right.count > 0) {
        if (left[0] <= right[0]) {
            result.add(left[0])
            left = left[1..-1]
        } else {
            result.add(right[0])
            right = right[1..-1]
        }
    }
    if (left.count > 0) result.addAll(left)
    if (right.count > 0) result.addAll(right)
    return result
}

var mergeSort // recursive
mergeSort = Fn.new { |m|
    var len = m.count
    if (len <= 1) return m
    var middle = (len/2).floor
    var left = m[0...middle]
    var right = m[middle..-1]
    left = mergeSort.call(left)
    right = mergeSort.call(right)
    if (left[-1] <= right[0]) {
        left.addAll(right)
        return left
    }
    return merge.call(left, right)
}

var array = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in array) {
    System.print("Before: %(a)")
    a = mergeSort.call(a)
    System.print("After : %(a)")
    System.print()
}
Output:
Before: [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]
After : [-31, 0, 1, 2, 2, 4, 65, 83, 99, 782]

Before: [7, 5, 2, 6, 1, 4, 2, 6, 3]
After : [1, 2, 2, 3, 4, 5, 6, 6, 7]


Alternatively we can just call a library method.

Library: Wren-sort
import "./sort" for Sort

var array = [ [4, 65, 2, -31, 0, 99, 2, 83, 782, 1], [7, 5, 2, 6, 1, 4, 2, 6, 3] ]
for (a in array) {
    System.print("Before: %(a)")
    a = Sort.merge(a)
    System.print("After : %(a)")
    System.print()
}
Output:
As above.

XPL0

This is based on an example in "Fundamentals of Computer Algorithms" by Horowitz & Sahni. 

code Reserve=3, ChOut=8, IntOut=11;

proc MergeSort(A, Low, High);   \Sort array A from Low to High
int  A, Low, High;
int  B, Mid, H, I, J, K;
[if Low >= High then return;
Mid:= (Low+High) >> 1;          \split array in half (roughly)
MergeSort(A, Low, Mid);         \sort left half
MergeSort(A, Mid+1, High);      \sort right half
\Merge the two halves in to sorted order
B:= Reserve((High-Low+1)*4);    \reserve space for working array (4 bytes/int)
H:= Low;  I:= Low;  J:= Mid+1;
while H<=Mid & J<=High do       \merge while both halves have items
    if A(H) <= A(J) then [B(I):= A(H);  I:= I+1;  H:= H+1]
                    else [B(I):= A(J);  I:= I+1;  J:= J+1];
if H > Mid then                 \copy any remaining elements
     for K:= J to High do [B(I):= A(K);  I:= I+1]
else for K:= H to Mid  do [B(I):= A(K);  I:= I+1];
for K:= Low to High do A(K):= B(K);
];

int  A, I;
[A:= [3, 1, 4, 1, -5, 9, 2, 6, 5, 4];
MergeSort(A, 0, 10-1);
for I:= 0 to 10-1 do [IntOut(0, A(I));  ChOut(0, ^ )];
]
Output:
-5 1 1 2 3 4 4 5 6 9


Yabasic

Translation of: FreeBASIC
dim b(9)

sub copyArray(a(), inicio, final, b())
    dim b(final - 1)
    for k = inicio to final - 1
        b(k) = a(k)
    next
end sub

// La mitad izquierda es  a(inicio to mitad-1).
// La mitad derecha es    a(mitad  to final-1).
// El resultado es        b(inicio to final-1).
sub topDownMerge(a(), inicio, mitad, final, b())
    i = inicio
    j = mitad
    
    // Si bien hay elementos en los recorridos izquierdo o derecho ...
    for k = inicio to final - 1 
        // Si existe un inicio de recorrido izquierdo y es <= inicio de recorrido derecho existente.
        if (i < mitad) and (j >= final or a(i) <= a(j)) then
            b(k) = a(i)
            i = i + 1
        else
            b(k) = a(j)
            j = j + 1    
        end if
    next 
end sub

// Ordenar la matriz a() usando la matriz b() como fuente.
// inicio es inclusivo; final es exclusivo (a(final) no está en el conjunto).
sub topDownSplitMerge(b(), inicio, final, a())
    if (final - inicio) < 2 then return : fi // Si la diferencia = 1, considérelo ordenado
    // dividir la ejecución de más de 1 elemento en mitades
    mitad = int((final + inicio) / 2)  // mitad = punto medio
    // recursively sort both runs from array a() into b()
    topDownSplitMerge(a(), inicio,  mitad, b())  // ordenar la parte izquierda
    topDownSplitMerge(a(), mitad, final, b())    // ordenar la parte derecha
    // fusionar las ejecuciones resultantes de la matriz b() en a()
    topDownMerge(b(), inicio, mitad, final, a())
end sub

// El array a() tiene los elementos para ordenar; array b() es una matriz de trabajo (inicialmente vacía).
sub topDownMergeSort(a(), b(), n)
    copyArray(a(), 0, n, b())          // duplicar la matriz a() en b()
    topDownSplitMerge(b(), 0, n, a())  // ordenar los datos de b() en a()
end sub

sub printArray(a())
    for i = 1 to arraysize(a(),1)
        print a(i) using "####";
    next
    print
end sub


//--------------------------  
label a1
data 4, 65, 2, -31, 0, 99, 2, 83, 782, 1
label a2
data 7, 5, 2, 6, 1, 4, 2, 6, 3

dim a(9)
restore a1
for i = 0 to 9
    read p 
    a(i) = p
next i
 
dim a2(8)
restore a2
for i = 0 to 8 
    read p 
    a2(i) = p  
next i

print "unsort ";
printArray(a())
topDownMergeSort (a(), b(), 10)
print "  sort ";
printArray(a())
print
print "unsort ";
printArray(a2())
topDownMergeSort (a2(), b(), 9)
print "  sort ";
printArray(a2())
end


ZED

Source -> http://ideone.com/uZEPL4 Compiled -> http://ideone.com/SJ5EGu

This is a bottom up version of merge sort: 

(append) list1 list2
comment:
#true
(003) "append" list1 list2

(car) pair
comment:
#true
(002) "car" pair

(cdr) pair
comment:
#true
(002) "cdr" pair

(cons) one two
comment:
#true
(003) "cons" one two

(map) function list
comment:
#true
(003) "map" function list

(merge) comparator list1 list2
comment:
#true
(merge1) comparator list1 list2 nil

(merge1) comparator list1 list2 collect
comment:
(null?) list2
(append) (reverse) collect list1

(merge1) comparator list1 list2 collect
comment:
(null?) list1
(append) (reverse) collect list2

(merge1) comparator list1 list2 collect
comment:
(003) comparator (car) list2 (car) list1
(merge1) comparator list1 (cdr) list2 (cons) (car) list2 collect

(merge1) comparator list1 list2 collect
comment:
#true
(merge1) comparator (cdr) list1 list2 (cons) (car) list1 collect

(null?) value
comment:
#true
(002) "null?" value

(reverse) list
comment:
#true
(002) "reverse" list

(sort) comparator jumble
comment:
#true
(car) (sort11) comparator (sort1) jumble

(sort1) jumble
comment:
#true
(map) "list" jumble

(sort11) comparator jumble
comment:
(null?) jumble
nil

(sort11) comparator jumble
comment:
(null?) (cdr) jumble
jumble

(sort11) comparator jumble
comment:
#true
(sort11) comparator
         (cons) (merge) comparator (car) jumble (002) "cadr" jumble
                (sort11) comparator (002) "cddr" jumble

zkl

Pretty wasteful memory wise, probably not suitable for large sorts.

Translation of: Clojure
fcn _merge(left,right){
   if (not left)  return(right);
   if (not right) return(left);
   l:=left[0]; r:=right[0];
   if (l<=r) return(L(l).extend(self.fcn(left[1,*],right)));
   else      return(L(r).extend(self.fcn(left,right[1,*])));
}

fcn merge_sort(L){
   if (L.len()<2) return(L);
   n:=L.len()/2;
   return(_merge(self.fcn(L[0,n]), self.fcn(L[n,*])));
}
merge_sort(T(1,3,5,7,9,8,6,4,2)).println();
merge_sort("big fjords vex quick waltz nymph").concat().println();
Output:
L(1,2,3,4,5,6,7,8,9)
     abcdefghiijklmnopqrstuvwxyz

Or, for lists only: 

fcn mergeSort(L){
   if (L.len()<2) return(L.copy());
   n:=L.len()/2;
   self.fcn(L[0,n]).merge(self.fcn(L[n,*]));
}
mergeSort(T(1,3,5,7,9,8,6,4,2)).println();
mergeSort("big fjords vex quick waltz nymph".split("")).concat().println();
Output:
L(1,2,3,4,5,6,7,8,9)
     abcdefghiijklmnopqrstuvwxyz
Retrieved from "https://rosettacode.org/wiki/Sorting_algorithms/Merge_sort?oldid=363880"