@prog sort.muf
1 9999 d
1 i
: merge (x1 ... xN y1 ... yM N M fn -- z1 ... zN+M N+M)
	over 4 pick + -4 rotate
	( x1 ... xN y1 ... yM N+M N M fn )
	begin
		over 4 pick and
	while
		( x1 ... xN y1 ... yM N+M N M fn )
		over 4 pick + 4 + pick
		( x1 ... xN y1 ... yM N+M N M fn x1 )
		3 pick 5 + pick
		( x1 ... xN y1 ... yM N+M N M fn x1 y1 )
		3 pick exec if
			( x1 ... xN y1 ... yM N+M N M fn )
			rot 1 - -3 rotate
		else
			( x1 ... xN y1 ... yM N+M N M fn )
			over 4 + rotate
			( x1 ... xN y2 ... yM N+M N M fn y1 )
			4 pick 4 pick + 4 + -1 * rotate
			( y1 x1 ... xN y2 ... yM N+M N M fn )
			swap 1 - swap
		then
	loop
	pop pop pop
;
: sort (x1 ... xN N fn -- x1 ... xN N)
(fn is x1 x2 -- i and returns true if the things are correctly ordered.)
	over 2 < if pop exit then
	over 2 / rot over -
	( x1 ... xN fn n1 n2 )
	over 3 + -1 * rotate
	( x1 ... xn2 n2 xn2+1 ... xN fn n1 )
	over over 3 + -1 * rotate swap
	( x1 ... xn2 n2 fn xn2+1 ... xN n1 fn )
	sort
	( x1 ... xn2 n2 fn sn2+1 ... sN n1 )
	dup 2 + pick
	( x1 ... xn2 n2 fn sn2+1 ... sN n1 fn )
	over 4 + pick 3 pick +
	( x1 ... xn2 n2 fn sn2+1 ... sN n1 fn N )
	4 + 3 pick 2 + roll
	( sn2+1 ... sN n1 fn x1 ... xn2 n2 fn )
	sort
	( sn2+1 ... sN n1 fn s1 ... sn2 n2 )
	dup 3 + rotate swap dup 3 + rotate
	( sn2+1 ... sN s1 ... sn2 n1 n2 fn )
	merge
;
.
c
q