use strict;
use warnings;
use Benchmark 'cmpthese';

sub linsearch {
	my ( $array, $item ) = @_;
	my $index = 0;
	$index++ while $index < @$array && $array->[$index] ne $item;
	return $index < @$array ? $index : -1;
}

sub fast_linsearch {
	my ( $array, $item ) = @_;
	my $index = -1;
	push @$array, $item;
	1 while $array->[ ++$index ] ne $item;
	pop @$array;
	return $index < @$array ? $index : -1;
}

our $array = $array =[ 1 .. 100 ];
cmpthese(
	-1,
	{
		lin_s  => 'linsearch($::array,100)',
		fast_s => 'fast_linsearch($::array,100)',
	}
);
__END__
Benchmark: running fast_s, lin_s, each for at least 1 CPU seconds...
    fast_s:  1 wallclock secs ( 1.01 usr +  0.00 sys =  1.01 CPU) @ 11182.81/s (n=11317)
     lin_s:  1 wallclock secs ( 1.03 usr +  0.00 sys =  1.03 CPU) @ 5761.40/s (n=5940)
          Rate  lin_s fast_s
lin_s   5761/s     --   -48%
fast_s 11183/s    94%     --

##</code><code>##

sub straight_merge {
	my ($array)=(@_);
	my $buffer=[];
	$#$buffer=$#$array;
	my $len=1; # starts with "runs" of length 1
	while ($len<@$array) {
		my ($al,$ar)=(0,$#$array);
		my ($bl,$br)=(-1,scalar @$array);
		my $dir=1;
		my ($lremain,$rremain)=($len,$len); # how many elements from each side
		PASS:
		while ($al<=$ar) {
			if ($array->[$al] < $array->[$ar]) {
				$bl+=$dir;
				$buffer->[$bl]=$array->[$al];
				$al++;
				next if --$lremain>0;
				while (1) {
					$bl+=$dir;
					last PASS if $bl==$br;
					$buffer->[$bl]=$array->[$ar];
					$ar--;
					last unless --$rremain;
				}
			} else {
				$bl+=$dir;
				$buffer->[$bl]=$array->[$ar];
				$ar--;
				$rremain--;
				next if $rremain>0;
				while (1) {
					$bl+=$dir;
					last PASS if $bl==$br;
					$buffer->[$bl]=$array->[$al];
					$al++;
					last unless --$lremain;
				}
			}
			#Switch sides
			($lremain,$rremain)=($len,$len);
			$dir=-$dir;
			($bl,$br)=($br,$bl);
			if ($ar-$al<$len) {
				# do a partial copy
				while (1) {
					$bl+=$dir;
					last PASS if $bl==$br;
					$buffer->[$bl]=$array->[$al];
					$al++;
				}
			}
			#eof PASS
		}
		#flip the buffers
		$len+=$len;
		last if $len>@$array;
		($array,$buffer)=($buffer,$array);
	}
	unless ($array==$_[0]) {
		#do a copy
		@$array=@$buffer;
	}
}