#!/usr/bin/perl

use strict;
use warnings;

use Benchmark;

my @heap;
my $M = @ARGV ? shift : 1000;

sub heapify;
sub heapify {
    my ($idx, $cmp) = splice @_ => 0, 2;

    my $max = $idx;
    for my $try (2 * $idx + 1, 2 * $idx + 2) {
        $max = $try if $try < @heap && $cmp -> ($heap [$try], $heap [$max]);
    }
    return if $max == $idx;

    @heap [$idx, $max] = @heap [$max, $idx];
    heapify $max, $cmp;
}

sub extract {
    return unless @heap;
    my $cmp = shift;
    my $min = $heap [0];
    my $tmp = pop @heap;
    if (@heap) {
        $heap [0] = $tmp;
        heapify 0, $cmp;
    }
    return $min;
}

sub heapsort_cmp (&@) {
   (my ($cmp), @heap) = @_;
    for (my $i = int (@heap / 2); $i --;) {
        heapify $i => $cmp;
    }
    my @result;
    push @result => extract $cmp while @heap;

    @result;
}
    
my %cache;
sub heapsort_eval ($@) {
   (my ($cmp), @heap) = @_;
    
    unless ($cache {$cmp}) {
        $cache {$cmp} = 1 + keys %cache;
        my $sub_heapify = "heapify_$cache{$cmp}";
        my $sub_extract = "extract_$cache{$cmp}";

        eval <<"        --";
            sub $sub_heapify;
            sub $sub_heapify {
                my (\$idx) = shift;
    
                my \$max = \$idx;
                for my \$try (2 * \$idx + 1, 2 * \$idx + 2) {
                    \$max = \$try if \$try < \@heap &&
                            \$heap [\$try] $cmp \$heap [\$max];
                }
                return if \$max == \$idx;

                \@heap [\$idx, \$max] = \@heap [\$max, \$idx];
                $sub_heapify \$max;
            }
        
            sub $sub_extract {
                return unless \@heap;
                my \$min = \$heap [0];
                my \$tmp = pop \@heap;
                if (\@heap) {
                    \$heap [0] = \$tmp;
                    $sub_heapify 0;
                }
                return \$min;
            }
        --
        if ($@) {die "eval failed: $@\n"}
    }
        
    no strict 'refs';
    my $sub_heapify = "heapify_$cache{$cmp}";
    my $sub_extract = "extract_$cache{$cmp}";
            
    for (my $i = int (@heap / 2); $i --;) {
        &$sub_heapify ($i);
    }
    my @result;
    push @result => &$sub_extract ($cmp) while @heap;
                    
    @result;
}
                

our @data = 1 .. $M;
for (my $i = @data; $i --;) {
    my $r = rand @data;
    @data [$r, $i] = @data [$i, $r];
}
                
                
timethese -10 => {
    cmp   => 'heapsort_cmp  {$_ [0] < $_ [1]} @::data',
    eval  => 'heapsort_eval "<", @::data'
};
                 
__END__
Benchmark: running cmp, eval for at least 10 CPU seconds...
   cmp: 11 wallclock secs (10.20 usr +  0.01 sys = 10.21 CPU) @  3.23/s (n=33)
  eval: 11 wallclock secs (10.19 usr +  0.00 sys = 10.19 CPU) @  4.61/s (n=47)