URL https://opencores.org/ocsvn/an-fpga-implementation-of-low-latency-noc-based-mpsoc/an-fpga-implementation-of-low-latency-noc-based-mpsoc/trunk

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [Integration_test/] [synthetic_sim/] [perl_lib/] [List/] [MoreUtils/] [PP.pm] - Blame information for rev 56

Details | Compare with Previous | View Log


package List::MoreUtils::PP;
 
use 5.008_001;
use strict;
use warnings;
 
our $VERSION = '0.430';
 
=pod
 
=head1 NAME
 
List::MoreUtils::PP - Provide List::MoreUtils pure Perl implementation
 
=head1 SYNOPSIS
 
  BEGIN { $ENV{LIST_MOREUTILS_PP} = 1; }
  use List::MoreUtils qw(:all);
 
=cut
 
## no critic (Subroutines::ProhibitSubroutinePrototypes, Subroutines::RequireArgUnpacking)
## no critic (Subroutines::ProhibitManyArgs)
 
sub any (&@)
{
    my $f = shift;
    foreach (@_)
    {
        return 1 if $f->();
    }
    return 0;
}
 
sub all (&@)
{
    my $f = shift;
    foreach (@_)
    {
        return 0 unless $f->();
    }
    return 1;
}
 
sub none (&@)
{
    my $f = shift;
    foreach (@_)
    {
        return 0 if $f->();
    }
    return 1;
}
 
sub notall (&@)
{
    my $f = shift;
    foreach (@_)
    {
        return 1 unless $f->();
    }
    return 0;
}
 
sub one (&@)
{
    my $f     = shift;
    my $found = 0;
    foreach (@_)
    {
        $f->() and $found++ and return 0;
    }
    return $found;
}
 
sub any_u (&@)
{
    my $f = shift;
    return if !@_;
    $f->() and return 1 foreach (@_);
    return 0;
}
 
sub all_u (&@)
{
    my $f = shift;
    return if !@_;
    $f->() or return 0 foreach (@_);
    return 1;
}
 
sub none_u (&@)
{
    my $f = shift;
    return if !@_;
    $f->() and return 0 foreach (@_);
    return 1;
}
 
sub notall_u (&@)
{
    my $f = shift;
    return if !@_;
    $f->() or return 1 foreach (@_);
    return 0;
}
 
sub one_u (&@)
{
    my $f = shift;
    return if !@_;
    my $found = 0;
    foreach (@_)
    {
        $f->() and $found++ and return 0;
    }
    return $found;
}
 
sub reduce_u(&@)
{
    my $code = shift;
 
    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};
    };
 
    ## no critic (Variables::RequireInitializationForLocalVars)
    local (*$caller_a, *$caller_b);
    *$caller_a = \();
    for (0 .. $#_)
    {
        *$caller_b = \$_[$_];
        *$caller_a = \($code->());
    }
 
    return ${*$caller_a};
}
 
sub reduce_0(&@)
{
    my $code = shift;
 
    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};
    };
 
    ## no critic (Variables::RequireInitializationForLocalVars)
    local (*$caller_a, *$caller_b);
    *$caller_a = \0;
    for (0 .. $#_)
    {
        *$caller_b = \$_[$_];
        *$caller_a = \($code->());
    }
 
    return ${*$caller_a};
}
 
sub reduce_1(&@)
{
    my $code = shift;
 
    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};
    };
 
    ## no critic (Variables::RequireInitializationForLocalVars)
    local (*$caller_a, *$caller_b);
    *$caller_a = \1;
    for (0 .. $#_)
    {
        *$caller_b = \$_[$_];
        *$caller_a = \($code->());
    }
 
    return ${*$caller_a};
}
 
sub true (&@)
{
    my $f     = shift;
    my $count = 0;
    $f->() and ++$count foreach (@_);
    return $count;
}
 
sub false (&@)
{
    my $f     = shift;
    my $count = 0;
    $f->() or ++$count foreach (@_);
    return $count;
}
 
sub firstidx (&@)
{
    my $f = shift;
    foreach my $i (0 .. $#_)
    {
        local *_ = \$_[$i];
        return $i if $f->();
    }
    return -1;
}
 
sub firstval (&@)
{
    my $test = shift;
    foreach (@_)
    {
        return $_ if $test->();
    }
    ## no critic (Subroutines::ProhibitExplicitReturnUndef)
    return undef;
}
 
sub firstres (&@)
{
    my $test = shift;
    foreach (@_)
    {
        my $testval = $test->();
        $testval and return $testval;
    }
    ## no critic (Subroutines::ProhibitExplicitReturnUndef)
    return undef;
}
 
sub onlyidx (&@)
{
    my $f = shift;
    my $found;
    foreach my $i (0 .. $#_)
    {
        local *_ = \$_[$i];
        $f->() or next;
        defined $found and return -1;
        $found = $i;
    }
    return defined $found ? $found : -1;
}
 
sub onlyval (&@)
{
    my $test   = shift;
    my $result = undef;
    my $found  = 0;
    foreach (@_)
    {
        $test->() or next;
        $result = $_;
        ## no critic (Subroutines::ProhibitExplicitReturnUndef)
        $found++ and return undef;
    }
    return $result;
}
 
sub onlyres (&@)
{
    my $test   = shift;
    my $result = undef;
    my $found  = 0;
    foreach (@_)
    {
        my $rv = $test->() or next;
        $result = $rv;
        ## no critic (Subroutines::ProhibitExplicitReturnUndef)
        $found++ and return undef;
    }
    return $found ? $result : undef;
}
 
sub lastidx (&@)
{
    my $f = shift;
    foreach my $i (reverse 0 .. $#_)
    {
        local *_ = \$_[$i];
        return $i if $f->();
    }
    return -1;
}
 
sub lastval (&@)
{
    my $test = shift;
    my $ix;
    for ($ix = $#_; $ix >= 0; $ix--)
    {
        local *_ = \$_[$ix];
        my $testval = $test->();
 
        # Simulate $_ as alias
        $_[$ix] = $_;
        return $_ if $testval;
    }
    ## no critic (Subroutines::ProhibitExplicitReturnUndef)
    return undef;
}
 
sub lastres (&@)
{
    my $test = shift;
    my $ix;
    for ($ix = $#_; $ix >= 0; $ix--)
    {
        local *_ = \$_[$ix];
        my $testval = $test->();
 
        # Simulate $_ as alias
        $_[$ix] = $_;
        return $testval if $testval;
    }
    ## no critic (Subroutines::ProhibitExplicitReturnUndef)
    return undef;
}
 
sub insert_after (&$\@)
{
    my ($f, $val, $list) = @_;
    my $c = &firstidx($f, @$list);
    @$list = (@{$list}[0 .. $c], $val, @{$list}[$c + 1 .. $#$list],) and return 1 if $c != -1;
    return 0;
}
 
sub insert_after_string ($$\@)
{
    my ($string, $val, $list) = @_;
    my $c = firstidx { defined $_ and $string eq $_ } @$list;
    @$list = (@{$list}[0 .. $c], $val, @{$list}[$c + 1 .. $#$list],) and return 1 if $c != -1;
    return 0;
}
 
sub apply (&@)
{
    my $action = shift;
    &$action foreach my @values = @_;
    return wantarray ? @values : $values[-1];
}
 
sub after (&@)
{
    my $test = shift;
    my $started;
    my $lag;
    ## no critic (BuiltinFunctions::RequireBlockGrep)
    return grep $started ||= do
    {
        my $x = $lag;
        $lag = $test->();
        $x;
    }, @_;
}
 
sub after_incl (&@)
{
    my $test = shift;
    my $started;
    return grep { $started ||= $test->() } @_;
}
 
sub before (&@)
{
    my $test = shift;
    my $more = 1;
    return grep { $more &&= !$test->() } @_;
}
 
sub before_incl (&@)
{
    my $test = shift;
    my $more = 1;
    my $lag  = 1;
    ## no critic (BuiltinFunctions::RequireBlockGrep)
    return grep $more &&= do
    {
        my $x = $lag;
        $lag = !$test->();
        $x;
    }, @_;
}
 
sub indexes (&@)
{
    my $test = shift;
    return grep {
        local *_ = \$_[$_];
        $test->()
    } 0 .. $#_;
}
 
sub pairwise (&\@\@)
{
    my $op = shift;
 
    # Symbols for caller's input arrays
    use vars qw{ @A @B };
    local (*A, *B) = @_;
 
    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};
    };
 
    # Loop iteration limit
    my $limit = $#A > $#B ? $#A : $#B;
 
    ## no critic (Variables::RequireInitializationForLocalVars)
    # This map expression is also the return value
    local (*$caller_a, *$caller_b);
    ## no critic (BuiltinFunctions::ProhibitComplexMappings)
    return map {
        # Assign to $a, $b as refs to caller's array elements
        (*$caller_a, *$caller_b) = \($#A < $_ ? undef : $A[$_], $#B < $_ ? undef : $B[$_]);
 
        # Perform the transformation
        $op->();
    } 0 .. $limit;
}
 
sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
{
    return each_arrayref(@_);
}
 
sub each_arrayref
{
    my @list  = @_;    # The list of references to the arrays
    my $index = 0;     # Which one the caller will get next
    my $max   = 0;     # Number of elements in longest array
 
    # Get the length of the longest input array
    foreach (@list)
    {
        unless (ref $_ eq 'ARRAY')
        {
            require Carp;
            Carp::croak("each_arrayref: argument is not an array reference\n");
        }
        $max = @$_ if @$_ > $max;
    }
 
    # Return the iterator as a closure wrt the above variables.
    return sub {
        if (@_)
        {
            my $method = shift;
            unless ($method eq 'index')
            {
                require Carp;
                Carp::croak("each_array: unknown argument '$method' passed to iterator.");
            }
 
            ## no critic (Subroutines::ProhibitExplicitReturnUndef)
            return undef if $index == 0 || $index > $max;
            # Return current (last fetched) index
            return $index - 1;
        }
 
        # No more elements to return
        return if $index >= $max;
        my $i = $index++;
 
        # Return ith elements
        ## no critic (BuiltinFunctions::RequireBlockMap)
        return map $_->[$i], @list;
    }
}
 
sub natatime ($@)
{
    my $n    = shift;
    my @list = @_;
    return sub { return splice @list, 0, $n; }
}
 
# "leaks" when lexically hidden in arrayify
my $flatten;
$flatten = sub {
    return map { (ref $_ and ("ARRAY" eq ref $_ or overload::Method($_, '@{}'))) ? ($flatten->(@{$_})) : ($_) } @_;
};
 
sub arrayify
{
    return map { $flatten->($_) } @_;
}
 
sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
{
    my $max = -1;
    $max < $#$_ && ($max = $#$_) foreach @_;
    ## no critic (BuiltinFunctions::ProhibitComplexMappings)
    return map {
        my $ix = $_;
        ## no critic (BuiltinFunctions::RequireBlockMap)
        map $_->[$ix], @_;
    } 0 .. $max;
}
 
sub zip6 (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
{
    my $max = -1;
    $max < $#$_ && ($max = $#$_) foreach @_;
    ## no critic (BuiltinFunctions::ProhibitComplexMappings)
    return map {
        my $ix = $_;
        ## no critic (BuiltinFunctions::RequireBlockMap)
        [map $_->[$ix], @_];
    } 0 .. $max;
}
 
sub listcmp (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
{
    my %ret;
    for (my $i = 0; $i < scalar @_; ++$i)
    {
        my %seen;
        my $k;
        foreach my $w (grep { defined $_ and not $seen{$k = $_}++ } @{$_[$i]})
        {
            $ret{$w} ||= [];
            push @{$ret{$w}}, $i;
        }
    }
    return %ret;
}
 
sub uniq (@)
{
    my %seen = ();
    my $k;
    my $seen_undef;
    return grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
}
 
sub singleton (@)
{
    my %seen = ();
    my $k;
    my $seen_undef;
    return grep { 1 == (defined $_ ? $seen{$k = $_} : $seen_undef) }
      grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
}
 
sub duplicates (@)
{
    my %seen = ();
    my $k;
    my $seen_undef;
    return grep { 1 < (defined $_ ? $seen{$k = $_} : $seen_undef) }
      grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
}
 
sub frequency (@)
{
    my %seen = ();
    my $k;
    my $seen_undef;
    my %h = map { defined $_ ? ($_ => $seen{$k = $_}) : () }
      grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;
    wantarray or return (scalar keys %h) + ($seen_undef ? 1 : 0);
    undef $k;
    return (%h, $seen_undef ? (\$k => $seen_undef) : ());
}
 
sub occurrences (@)
{
    my %seen = ();
    my $k;
    my $seen_undef;
    my @ret;
    foreach my $l (map { $_ } grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_)
    {
        my $n = defined $l ? $seen{$l} : $seen_undef;
        defined $ret[$n] or $ret[$n] = [];
        push @{$ret[$n]}, $l;
    }
    return @ret;
}
 
sub mode (@)
{
    my %seen = ();
    my ($max, $k, $seen_undef) = (1);
 
    foreach (@_) { defined $_ ? ($max < ++$seen{$k = $_} and ++$max) : ($max < ++$seen_undef and ++$max) }
    wantarray or return $max;
 
    my @ret = ($max);
    foreach my $l (grep { $seen{$_} == $max } keys %seen)
    {
        push @ret, $l;
    }
    $seen_undef and $seen_undef == $max and push @ret, undef;
    return @ret;
}
 
sub samples ($@)
{
    my $n = shift;
    if ($n > @_)
    {
        require Carp;
        Carp::croak(sprintf("Cannot get %d samples from %d elements", $n, scalar @_));
    }
 
    for (my $i = @_; @_ - $i > $n;)
    {
        my $idx  = @_ - $i;
        my $swp  = $idx + int(rand(--$i));
        my $xchg = $_[$swp];
        $_[$swp] = $_[$idx];
        $_[$idx] = $xchg;
    }
 
    return splice @_, 0, $n;
}
 
sub minmax (@)
{
    return unless @_;
    my $min = my $max = $_[0];
 
    for (my $i = 1; $i < @_; $i += 2)
    {
        if ($_[$i - 1] <= $_[$i])
        {
            $min = $_[$i - 1] if $min > $_[$i - 1];
            $max = $_[$i]     if $max < $_[$i];
        }
        else
        {
            $min = $_[$i]     if $min > $_[$i];
            $max = $_[$i - 1] if $max < $_[$i - 1];
        }
    }
 
    if (@_ & 1)
    {
        my $i = $#_;
        if ($_[$i - 1] <= $_[$i])
        {
            $min = $_[$i - 1] if $min > $_[$i - 1];
            $max = $_[$i]     if $max < $_[$i];
        }
        else
        {
            $min = $_[$i]     if $min > $_[$i];
            $max = $_[$i - 1] if $max < $_[$i - 1];
        }
    }
 
    return ($min, $max);
}
 
sub minmaxstr (@)
{
    return unless @_;
    my $min = my $max = $_[0];
 
    for (my $i = 1; $i < @_; $i += 2)
    {
        if ($_[$i - 1] le $_[$i])
        {
            $min = $_[$i - 1] if $min gt $_[$i - 1];
            $max = $_[$i]     if $max lt $_[$i];
        }
        else
        {
            $min = $_[$i]     if $min gt $_[$i];
            $max = $_[$i - 1] if $max lt $_[$i - 1];
        }
    }
 
    if (@_ & 1)
    {
        my $i = $#_;
        if ($_[$i - 1] le $_[$i])
        {
            $min = $_[$i - 1] if $min gt $_[$i - 1];
            $max = $_[$i]     if $max lt $_[$i];
        }
        else
        {
            $min = $_[$i]     if $min gt $_[$i];
            $max = $_[$i - 1] if $max lt $_[$i - 1];
        }
    }
 
    return ($min, $max);
}
 
sub part (&@)
{
    my ($code, @list) = @_;
    my @parts;
    push @{$parts[$code->($_)]}, $_ foreach @list;
    return @parts;
}
 
sub bsearch(&@)
{
    my $code = shift;
 
    my $rc;
    my $i = 0;
    my $j = @_;
    ## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)
    do
    {
        my $k = int(($i + $j) / 2);
 
        $k >= @_ and return;
 
        local *_ = \$_[$k];
        $rc = $code->();
 
        $rc == 0
          and return wantarray ? $_ : 1;
 
        if ($rc < 0)
        {
            $i = $k + 1;
        }
        else
        {
            $j = $k - 1;
        }
    } until $i > $j;
 
    return;
}
 
sub bsearchidx(&@)
{
    my $code = shift;
 
    my $rc;
    my $i = 0;
    my $j = @_;
    ## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)
    do
    {
        my $k = int(($i + $j) / 2);
 
        $k >= @_ and return -1;
 
        local *_ = \$_[$k];
        $rc = $code->();
 
        $rc == 0 and return $k;
 
        if ($rc < 0)
        {
            $i = $k + 1;
        }
        else
        {
            $j = $k - 1;
        }
    } until $i > $j;
 
    return -1;
}
 
sub lower_bound(&@)
{
    my $code  = shift;
    my $count = @_;
    my $first = 0;
    while ($count > 0)
    {
        my $step = $count >> 1;
        my $it   = $first + $step;
        local *_ = \$_[$it];
        if ($code->() < 0)
        {
            $first = ++$it;
            $count -= $step + 1;
        }
        else
        {
            $count = $step;
        }
    }
 
    return $first;
}
 
sub upper_bound(&@)
{
    my $code  = shift;
    my $count = @_;
    my $first = 0;
    while ($count > 0)
    {
        my $step = $count >> 1;
        my $it   = $first + $step;
        local *_ = \$_[$it];
        if ($code->() <= 0)
        {
            $first = ++$it;
            $count -= $step + 1;
        }
        else
        {
            $count = $step;
        }
    }
 
    return $first;
}
 
sub equal_range(&@)
{
    my $lb = &lower_bound(@_);
    my $ub = &upper_bound(@_);
    return ($lb, $ub);
}
 
sub binsert (&$\@)
{
    my $lb = &lower_bound($_[0], @{$_[2]});
    splice @{$_[2]}, $lb, 0, $_[1];
    return $lb;
}
 
sub bremove (&\@)
{
    my $lb = &lower_bound($_[0], @{$_[1]});
    return splice @{$_[1]}, $lb, 1;
}
 
sub qsort(&\@)
{
    require Carp;
    Carp::croak("It's insane to use a pure-perl qsort");
}
 
sub slide(&@)
{
    my $op = shift;
    my @l  = @_;
 
    ## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)
    # Localise $a, $b
    my ($caller_a, $caller_b) = do
    {
        my $pkg = caller();
        no strict 'refs';
        \*{$pkg . '::a'}, \*{$pkg . '::b'};
    };
 
    ## no critic (Variables::RequireInitializationForLocalVars)
    # This map expression is also the return value
    local (*$caller_a, *$caller_b);
    ## no critic (BuiltinFunctions::ProhibitComplexMappings)
    return map {
        # Assign to $a, $b as refs to caller's array elements
        (*$caller_a, *$caller_b) = \($l[$_], $l[$_ + 1]);
 
        # Perform the transformation
        $op->();
    } 0 .. ($#l - 1);
}
 
sub slideatatime ($$@)
{
    my ($m, $w, @list) = @_;
    my $n = $w - $m - 1;
    return $n >= 0
      ? sub { my @r = splice @list, 0, $m; $#list < $n and $n = $#list; @r and push @r, (@list ? @list[0 .. $n] : ()); return @r; }
      : sub { return splice @list, 0, $m; };
}
 
sub sort_by(&@)
{
    my ($code, @list) = @_;
    return map { $_->[0] }
      sort     { $a->[1] cmp $b->[1] }
      map      { [$_, scalar($code->())] } @list;
}
 
sub nsort_by(&@)
{
    my ($code, @list) = @_;
    return map { $_->[0] }
      sort     { $a->[1] <=> $b->[1] }
      map      { [$_, scalar($code->())] } @list;
}
 
## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
sub _XScompiled { return 0 }
 
=head1 SEE ALSO
 
L<List::Util>
 
=head1 AUTHOR
 
Jens Rehsack E<lt>rehsack AT cpan.orgE<gt>
 
Adam Kennedy E<lt>adamk@cpan.orgE<gt>
 
Tassilo von Parseval E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>
 
=head1 COPYRIGHT AND LICENSE
 
Some parts copyright 2011 Aaron Crane.
 
Copyright 2004 - 2010 by Tassilo von Parseval
 
Copyright 2013 - 2017 by Jens Rehsack
 
All code added with 0.417 or later is licensed under the Apache License,
Version 2.0 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
 
 http://www.apache.org/licenses/LICENSE-2.0
 
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 
All code until 0.416 is licensed under the same terms as Perl itself,
either Perl version 5.8.4 or, at your option, any later version of
Perl 5 you may have available.
 
=cut
 
1;

Browse

Tools

Subversion Repositories an-fpga-implementation-of-low-latency-noc-based-mpsoc

[/] [an-fpga-implementation-of-low-latency-noc-based-mpsoc/] [trunk/] [mpsoc/] [Integration_test/] [synthetic_sim/] [perl_lib/] [List/] [MoreUtils/] [PP.pm] - Blame information for rev 56

Line No.	Rev	Author	Line
1	56	alirezamon	`package List::MoreUtils::PP;`
2
3			`use 5.008_001;`
4			`use strict;`
5			`use warnings;`
6
7			`our $VERSION = '0.430';`
8
9			`=pod`
10
11			`=head1 NAME`
12
13			`List::MoreUtils::PP - Provide List::MoreUtils pure Perl implementation`
14
15			`=head1 SYNOPSIS`
16
17			`BEGIN { $ENV{LIST_MOREUTILS_PP} = 1; }`
18			`use List::MoreUtils qw(:all);`
19
20			`=cut`
21
22			`## no critic (Subroutines::ProhibitSubroutinePrototypes, Subroutines::RequireArgUnpacking)`
23			`## no critic (Subroutines::ProhibitManyArgs)`
24
25			`sub any (&@)`
26			`{`
27			`my $f = shift;`
28			`foreach (@_)`
29			`{`
30			`return 1 if $f->();`
31			`}`
32			`return 0;`
33			`}`
34
35			`sub all (&@)`
36			`{`
37			`my $f = shift;`
38			`foreach (@_)`
39			`{`
40			`return 0 unless $f->();`
41			`}`
42			`return 1;`
43			`}`
44
45			`sub none (&@)`
46			`{`
47			`my $f = shift;`
48			`foreach (@_)`
49			`{`
50			`return 0 if $f->();`
51			`}`
52			`return 1;`
53			`}`
54
55			`sub notall (&@)`
56			`{`
57			`my $f = shift;`
58			`foreach (@_)`
59			`{`
60			`return 1 unless $f->();`
61			`}`
62			`return 0;`
63			`}`
64
65			`sub one (&@)`
66			`{`
67			`my $f = shift;`
68			`my $found = 0;`
69			`foreach (@_)`
70			`{`
71			`$f->() and $found++ and return 0;`
72			`}`
73			`return $found;`
74			`}`
75
76			`sub any_u (&@)`
77			`{`
78			`my $f = shift;`
79			`return if !@_;`
80			`$f->() and return 1 foreach (@_);`
81			`return 0;`
82			`}`
83
84			`sub all_u (&@)`
85			`{`
86			`my $f = shift;`
87			`return if !@_;`
88			`$f->() or return 0 foreach (@_);`
89			`return 1;`
90			`}`
91
92			`sub none_u (&@)`
93			`{`
94			`my $f = shift;`
95			`return if !@_;`
96			`$f->() and return 0 foreach (@_);`
97			`return 1;`
98			`}`
99
100			`sub notall_u (&@)`
101			`{`
102			`my $f = shift;`
103			`return if !@_;`
104			`$f->() or return 1 foreach (@_);`
105			`return 0;`
106			`}`
107
108			`sub one_u (&@)`
109			`{`
110			`my $f = shift;`
111			`return if !@_;`
112			`my $found = 0;`
113			`foreach (@_)`
114			`{`
115			`$f->() and $found++ and return 0;`
116			`}`
117			`return $found;`
118			`}`
119
120			`sub reduce_u(&@)`
121			`{`
122			`my $code = shift;`
123
124			`# Localise $a, $b`
125			`my ($caller_a, $caller_b) = do`
126			`{`
127			`my $pkg = caller();`
128			`## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)`
129			`no strict 'refs';`
130			`\{$pkg . '::a'}, \{$pkg . '::b'};`
131			`};`
132
133			`## no critic (Variables::RequireInitializationForLocalVars)`
134			`local ($caller_a, $caller_b);`
135			`*$caller_a = \();`
136			`for (0 .. $#_)`
137			`{`
138			`*$caller_b = \$_[$_];`
139			`*$caller_a = \($code->());`
140			`}`
141
142			`return ${*$caller_a};`
143			`}`
144
145			`sub reduce_0(&@)`
146			`{`
147			`my $code = shift;`
148
149			`# Localise $a, $b`
150			`my ($caller_a, $caller_b) = do`
151			`{`
152			`my $pkg = caller();`
153			`## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)`
154			`no strict 'refs';`
155			`\{$pkg . '::a'}, \{$pkg . '::b'};`
156			`};`
157
158			`## no critic (Variables::RequireInitializationForLocalVars)`
159			`local ($caller_a, $caller_b);`
160			`*$caller_a = \0;`
161			`for (0 .. $#_)`
162			`{`
163			`*$caller_b = \$_[$_];`
164			`*$caller_a = \($code->());`
165			`}`
166
167			`return ${*$caller_a};`
168			`}`
169
170			`sub reduce_1(&@)`
171			`{`
172			`my $code = shift;`
173
174			`# Localise $a, $b`
175			`my ($caller_a, $caller_b) = do`
176			`{`
177			`my $pkg = caller();`
178			`## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)`
179			`no strict 'refs';`
180			`\{$pkg . '::a'}, \{$pkg . '::b'};`
181			`};`
182
183			`## no critic (Variables::RequireInitializationForLocalVars)`
184			`local ($caller_a, $caller_b);`
185			`*$caller_a = \1;`
186			`for (0 .. $#_)`
187			`{`
188			`*$caller_b = \$_[$_];`
189			`*$caller_a = \($code->());`
190			`}`
191
192			`return ${*$caller_a};`
193			`}`
194
195			`sub true (&@)`
196			`{`
197			`my $f = shift;`
198			`my $count = 0;`
199			`$f->() and ++$count foreach (@_);`
200			`return $count;`
201			`}`
202
203			`sub false (&@)`
204			`{`
205			`my $f = shift;`
206			`my $count = 0;`
207			`$f->() or ++$count foreach (@_);`
208			`return $count;`
209			`}`
210
211			`sub firstidx (&@)`
212			`{`
213			`my $f = shift;`
214			`foreach my $i (0 .. $#_)`
215			`{`
216			`local *_ = \$_[$i];`
217			`return $i if $f->();`
218			`}`
219			`return -1;`
220			`}`
221
222			`sub firstval (&@)`
223			`{`
224			`my $test = shift;`
225			`foreach (@_)`
226			`{`
227			`return $_ if $test->();`
228			`}`
229			`## no critic (Subroutines::ProhibitExplicitReturnUndef)`
230			`return undef;`
231			`}`
232
233			`sub firstres (&@)`
234			`{`
235			`my $test = shift;`
236			`foreach (@_)`
237			`{`
238			`my $testval = $test->();`
239			`$testval and return $testval;`
240			`}`
241			`## no critic (Subroutines::ProhibitExplicitReturnUndef)`
242			`return undef;`
243			`}`
244
245			`sub onlyidx (&@)`
246			`{`
247			`my $f = shift;`
248			`my $found;`
249			`foreach my $i (0 .. $#_)`
250			`{`
251			`local *_ = \$_[$i];`
252			`$f->() or next;`
253			`defined $found and return -1;`
254			`$found = $i;`
255			`}`
256			`return defined $found ? $found : -1;`
257			`}`
258
259			`sub onlyval (&@)`
260			`{`
261			`my $test = shift;`
262			`my $result = undef;`
263			`my $found = 0;`
264			`foreach (@_)`
265			`{`
266			`$test->() or next;`
267			`$result = $_;`
268			`## no critic (Subroutines::ProhibitExplicitReturnUndef)`
269			`$found++ and return undef;`
270			`}`
271			`return $result;`
272			`}`
273
274			`sub onlyres (&@)`
275			`{`
276			`my $test = shift;`
277			`my $result = undef;`
278			`my $found = 0;`
279			`foreach (@_)`
280			`{`
281			`my $rv = $test->() or next;`
282			`$result = $rv;`
283			`## no critic (Subroutines::ProhibitExplicitReturnUndef)`
284			`$found++ and return undef;`
285			`}`
286			`return $found ? $result : undef;`
287			`}`
288
289			`sub lastidx (&@)`
290			`{`
291			`my $f = shift;`
292			`foreach my $i (reverse 0 .. $#_)`
293			`{`
294			`local *_ = \$_[$i];`
295			`return $i if $f->();`
296			`}`
297			`return -1;`
298			`}`
299
300			`sub lastval (&@)`
301			`{`
302			`my $test = shift;`
303			`my $ix;`
304			`for ($ix = $#_; $ix >= 0; $ix--)`
305			`{`
306			`local *_ = \$_[$ix];`
307			`my $testval = $test->();`
308
309			`# Simulate $_ as alias`
310			`$_[$ix] = $_;`
311			`return $_ if $testval;`
312			`}`
313			`## no critic (Subroutines::ProhibitExplicitReturnUndef)`
314			`return undef;`
315			`}`
316
317			`sub lastres (&@)`
318			`{`
319			`my $test = shift;`
320			`my $ix;`
321			`for ($ix = $#_; $ix >= 0; $ix--)`
322			`{`
323			`local *_ = \$_[$ix];`
324			`my $testval = $test->();`
325
326			`# Simulate $_ as alias`
327			`$_[$ix] = $_;`
328			`return $testval if $testval;`
329			`}`
330			`## no critic (Subroutines::ProhibitExplicitReturnUndef)`
331			`return undef;`
332			`}`
333
334			`sub insert_after (&$\@)`
335			`{`
336			`my ($f, $val, $list) = @_;`
337			`my $c = &firstidx($f, @$list);`
338			`@$list = (@{$list}[0 .. $c], $val, @{$list}[$c + 1 .. $#$list],) and return 1 if $c != -1;`
339			`return 0;`
340			`}`
341
342			`sub insert_after_string ($$\@)`
343			`{`
344			`my ($string, $val, $list) = @_;`
345			`my $c = firstidx { defined $_ and $string eq $_ } @$list;`
346			`@$list = (@{$list}[0 .. $c], $val, @{$list}[$c + 1 .. $#$list],) and return 1 if $c != -1;`
347			`return 0;`
348			`}`
349
350			`sub apply (&@)`
351			`{`
352			`my $action = shift;`
353			`&$action foreach my @values = @_;`
354			`return wantarray ? @values : $values[-1];`
355			`}`
356
357			`sub after (&@)`
358			`{`
359			`my $test = shift;`
360			`my $started;`
361			`my $lag;`
362			`## no critic (BuiltinFunctions::RequireBlockGrep)`
363			`return grep $started \|\|= do`
364			`{`
365			`my $x = $lag;`
366			`$lag = $test->();`
367			`$x;`
368			`}, @_;`
369			`}`
370
371			`sub after_incl (&@)`
372			`{`
373			`my $test = shift;`
374			`my $started;`
375			`return grep { $started \|\|= $test->() } @_;`
376			`}`
377
378			`sub before (&@)`
379			`{`
380			`my $test = shift;`
381			`my $more = 1;`
382			`return grep { $more &&= !$test->() } @_;`
383			`}`
384
385			`sub before_incl (&@)`
386			`{`
387			`my $test = shift;`
388			`my $more = 1;`
389			`my $lag = 1;`
390			`## no critic (BuiltinFunctions::RequireBlockGrep)`
391			`return grep $more &&= do`
392			`{`
393			`my $x = $lag;`
394			`$lag = !$test->();`
395			`$x;`
396			`}, @_;`
397			`}`
398
399			`sub indexes (&@)`
400			`{`
401			`my $test = shift;`
402			`return grep {`
403			`local *_ = \$_[$_];`
404			`$test->()`
405			`} 0 .. $#_;`
406			`}`
407
408			`sub pairwise (&\@\@)`
409			`{`
410			`my $op = shift;`
411
412			`# Symbols for caller's input arrays`
413			`use vars qw{ @A @B };`
414			`local (A, B) = @_;`
415
416			`# Localise $a, $b`
417			`my ($caller_a, $caller_b) = do`
418			`{`
419			`my $pkg = caller();`
420			`## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)`
421			`no strict 'refs';`
422			`\{$pkg . '::a'}, \{$pkg . '::b'};`
423			`};`
424
425			`# Loop iteration limit`
426			`my $limit = $#A > $#B ? $#A : $#B;`
427
428			`## no critic (Variables::RequireInitializationForLocalVars)`
429			`# This map expression is also the return value`
430			`local ($caller_a, $caller_b);`
431			`## no critic (BuiltinFunctions::ProhibitComplexMappings)`
432			`return map {`
433			`# Assign to $a, $b as refs to caller's array elements`
434			`($caller_a, $caller_b) = \($#A < $_ ? undef : $A[$_], $#B < $_ ? undef : $B[$_]);`
435
436			`# Perform the transformation`
437			`$op->();`
438			`} 0 .. $limit;`
439			`}`
440
441			`sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)`
442			`{`
443			`return each_arrayref(@_);`
444			`}`
445
446			`sub each_arrayref`
447			`{`
448			`my @list = @_; # The list of references to the arrays`
449			`my $index = 0; # Which one the caller will get next`
450			`my $max = 0; # Number of elements in longest array`
451
452			`# Get the length of the longest input array`
453			`foreach (@list)`
454			`{`
455			`unless (ref $_ eq 'ARRAY')`
456			`{`
457			`require Carp;`
458			`Carp::croak("each_arrayref: argument is not an array reference\n");`
459			`}`
460			`$max = @$_ if @$_ > $max;`
461			`}`
462
463			`# Return the iterator as a closure wrt the above variables.`
464			`return sub {`
465			`if (@_)`
466			`{`
467			`my $method = shift;`
468			`unless ($method eq 'index')`
469			`{`
470			`require Carp;`
471			`Carp::croak("each_array: unknown argument '$method' passed to iterator.");`
472			`}`
473
474			`## no critic (Subroutines::ProhibitExplicitReturnUndef)`
475			`return undef if $index == 0 \|\| $index > $max;`
476			`# Return current (last fetched) index`
477			`return $index - 1;`
478			`}`
479
480			`# No more elements to return`
481			`return if $index >= $max;`
482			`my $i = $index++;`
483
484			`# Return ith elements`
485			`## no critic (BuiltinFunctions::RequireBlockMap)`
486			`return map $_->[$i], @list;`
487			`}`
488			`}`
489
490			`sub natatime ($@)`
491			`{`
492			`my $n = shift;`
493			`my @list = @_;`
494			`return sub { return splice @list, 0, $n; }`
495			`}`
496
497			`# "leaks" when lexically hidden in arrayify`
498			`my $flatten;`
499			`$flatten = sub {`
500			`return map { (ref $_ and ("ARRAY" eq ref $_ or overload::Method($_, '@{}'))) ? ($flatten->(@{$_})) : ($_) } @_;`
501			`};`
502
503			`sub arrayify`
504			`{`
505			`return map { $flatten->($_) } @_;`
506			`}`
507
508			`sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)`
509			`{`
510			`my $max = -1;`
511			`$max < $#$_ && ($max = $#$_) foreach @_;`
512			`## no critic (BuiltinFunctions::ProhibitComplexMappings)`
513			`return map {`
514			`my $ix = $_;`
515			`## no critic (BuiltinFunctions::RequireBlockMap)`
516			`map $_->[$ix], @_;`
517			`} 0 .. $max;`
518			`}`
519
520			`sub zip6 (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)`
521			`{`
522			`my $max = -1;`
523			`$max < $#$_ && ($max = $#$_) foreach @_;`
524			`## no critic (BuiltinFunctions::ProhibitComplexMappings)`
525			`return map {`
526			`my $ix = $_;`
527			`## no critic (BuiltinFunctions::RequireBlockMap)`
528			`[map $_->[$ix], @_];`
529			`} 0 .. $max;`
530			`}`
531
532			`sub listcmp (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)`
533			`{`
534			`my %ret;`
535			`for (my $i = 0; $i < scalar @_; ++$i)`
536			`{`
537			`my %seen;`
538			`my $k;`
539			`foreach my $w (grep { defined $_ and not $seen{$k = $_}++ } @{$_[$i]})`
540			`{`
541			`$ret{$w} \|\|= [];`
542			`push @{$ret{$w}}, $i;`
543			`}`
544			`}`
545			`return %ret;`
546			`}`
547
548			`sub uniq (@)`
549			`{`
550			`my %seen = ();`
551			`my $k;`
552			`my $seen_undef;`
553			`return grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;`
554			`}`
555
556			`sub singleton (@)`
557			`{`
558			`my %seen = ();`
559			`my $k;`
560			`my $seen_undef;`
561			`return grep { 1 == (defined $_ ? $seen{$k = $_} : $seen_undef) }`
562			`grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;`
563			`}`
564
565			`sub duplicates (@)`
566			`{`
567			`my %seen = ();`
568			`my $k;`
569			`my $seen_undef;`
570			`return grep { 1 < (defined $_ ? $seen{$k = $_} : $seen_undef) }`
571			`grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;`
572			`}`
573
574			`sub frequency (@)`
575			`{`
576			`my %seen = ();`
577			`my $k;`
578			`my $seen_undef;`
579			`my %h = map { defined $_ ? ($_ => $seen{$k = $_}) : () }`
580			`grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_;`
581			`wantarray or return (scalar keys %h) + ($seen_undef ? 1 : 0);`
582			`undef $k;`
583			`return (%h, $seen_undef ? (\$k => $seen_undef) : ());`
584			`}`
585
586			`sub occurrences (@)`
587			`{`
588			`my %seen = ();`
589			`my $k;`
590			`my $seen_undef;`
591			`my @ret;`
592			`foreach my $l (map { $_ } grep { defined $_ ? not $seen{$k = $_}++ : not $seen_undef++ } @_)`
593			`{`
594			`my $n = defined $l ? $seen{$l} : $seen_undef;`
595			`defined $ret[$n] or $ret[$n] = [];`
596			`push @{$ret[$n]}, $l;`
597			`}`
598			`return @ret;`
599			`}`
600
601			`sub mode (@)`
602			`{`
603			`my %seen = ();`
604			`my ($max, $k, $seen_undef) = (1);`
605
606			`foreach (@_) { defined $_ ? ($max < ++$seen{$k = $_} and ++$max) : ($max < ++$seen_undef and ++$max) }`
607			`wantarray or return $max;`
608
609			`my @ret = ($max);`
610			`foreach my $l (grep { $seen{$_} == $max } keys %seen)`
611			`{`
612			`push @ret, $l;`
613			`}`
614			`$seen_undef and $seen_undef == $max and push @ret, undef;`
615			`return @ret;`
616			`}`
617
618			`sub samples ($@)`
619			`{`
620			`my $n = shift;`
621			`if ($n > @_)`
622			`{`
623			`require Carp;`
624			`Carp::croak(sprintf("Cannot get %d samples from %d elements", $n, scalar @_));`
625			`}`
626
627			`for (my $i = @_; @_ - $i > $n;)`
628			`{`
629			`my $idx = @_ - $i;`
630			`my $swp = $idx + int(rand(--$i));`
631			`my $xchg = $_[$swp];`
632			`$_[$swp] = $_[$idx];`
633			`$_[$idx] = $xchg;`
634			`}`
635
636			`return splice @_, 0, $n;`
637			`}`
638
639			`sub minmax (@)`
640			`{`
641			`return unless @_;`
642			`my $min = my $max = $_[0];`
643
644			`for (my $i = 1; $i < @_; $i += 2)`
645			`{`
646			`if ($_[$i - 1] <= $_[$i])`
647			`{`
648			`$min = $_[$i - 1] if $min > $_[$i - 1];`
649			`$max = $_[$i] if $max < $_[$i];`
650			`}`
651			`else`
652			`{`
653			`$min = $_[$i] if $min > $_[$i];`
654			`$max = $_[$i - 1] if $max < $_[$i - 1];`
655			`}`
656			`}`
657
658			`if (@_ & 1)`
659			`{`
660			`my $i = $#_;`
661			`if ($_[$i - 1] <= $_[$i])`
662			`{`
663			`$min = $_[$i - 1] if $min > $_[$i - 1];`
664			`$max = $_[$i] if $max < $_[$i];`
665			`}`
666			`else`
667			`{`
668			`$min = $_[$i] if $min > $_[$i];`
669			`$max = $_[$i - 1] if $max < $_[$i - 1];`
670			`}`
671			`}`
672
673			`return ($min, $max);`
674			`}`
675
676			`sub minmaxstr (@)`
677			`{`
678			`return unless @_;`
679			`my $min = my $max = $_[0];`
680
681			`for (my $i = 1; $i < @_; $i += 2)`
682			`{`
683			`if ($_[$i - 1] le $_[$i])`
684			`{`
685			`$min = $_[$i - 1] if $min gt $_[$i - 1];`
686			`$max = $_[$i] if $max lt $_[$i];`
687			`}`
688			`else`
689			`{`
690			`$min = $_[$i] if $min gt $_[$i];`
691			`$max = $_[$i - 1] if $max lt $_[$i - 1];`
692			`}`
693			`}`
694
695			`if (@_ & 1)`
696			`{`
697			`my $i = $#_;`
698			`if ($_[$i - 1] le $_[$i])`
699			`{`
700			`$min = $_[$i - 1] if $min gt $_[$i - 1];`
701			`$max = $_[$i] if $max lt $_[$i];`
702			`}`
703			`else`
704			`{`
705			`$min = $_[$i] if $min gt $_[$i];`
706			`$max = $_[$i - 1] if $max lt $_[$i - 1];`
707			`}`
708			`}`
709
710			`return ($min, $max);`
711			`}`
712
713			`sub part (&@)`
714			`{`
715			`my ($code, @list) = @_;`
716			`my @parts;`
717			`push @{$parts[$code->($_)]}, $_ foreach @list;`
718			`return @parts;`
719			`}`
720
721			`sub bsearch(&@)`
722			`{`
723			`my $code = shift;`
724
725			`my $rc;`
726			`my $i = 0;`
727			`my $j = @_;`
728			`## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)`
729			`do`
730			`{`
731			`my $k = int(($i + $j) / 2);`
732
733			`$k >= @_ and return;`
734
735			`local *_ = \$_[$k];`
736			`$rc = $code->();`
737
738			`$rc == 0`
739			`and return wantarray ? $_ : 1;`
740
741			`if ($rc < 0)`
742			`{`
743			`$i = $k + 1;`
744			`}`
745			`else`
746			`{`
747			`$j = $k - 1;`
748			`}`
749			`} until $i > $j;`
750
751			`return;`
752			`}`
753
754			`sub bsearchidx(&@)`
755			`{`
756			`my $code = shift;`
757
758			`my $rc;`
759			`my $i = 0;`
760			`my $j = @_;`
761			`## no critic (ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions)`
762			`do`
763			`{`
764			`my $k = int(($i + $j) / 2);`
765
766			`$k >= @_ and return -1;`
767
768			`local *_ = \$_[$k];`
769			`$rc = $code->();`
770
771			`$rc == 0 and return $k;`
772
773			`if ($rc < 0)`
774			`{`
775			`$i = $k + 1;`
776			`}`
777			`else`
778			`{`
779			`$j = $k - 1;`
780			`}`
781			`} until $i > $j;`
782
783			`return -1;`
784			`}`
785
786			`sub lower_bound(&@)`
787			`{`
788			`my $code = shift;`
789			`my $count = @_;`
790			`my $first = 0;`
791			`while ($count > 0)`
792			`{`
793			`my $step = $count >> 1;`
794			`my $it = $first + $step;`
795			`local *_ = \$_[$it];`
796			`if ($code->() < 0)`
797			`{`
798			`$first = ++$it;`
799			`$count -= $step + 1;`
800			`}`
801			`else`
802			`{`
803			`$count = $step;`
804			`}`
805			`}`
806
807			`return $first;`
808			`}`
809
810			`sub upper_bound(&@)`
811			`{`
812			`my $code = shift;`
813			`my $count = @_;`
814			`my $first = 0;`
815			`while ($count > 0)`
816			`{`
817			`my $step = $count >> 1;`
818			`my $it = $first + $step;`
819			`local *_ = \$_[$it];`
820			`if ($code->() <= 0)`
821			`{`
822			`$first = ++$it;`
823			`$count -= $step + 1;`
824			`}`
825			`else`
826			`{`
827			`$count = $step;`
828			`}`
829			`}`
830
831			`return $first;`
832			`}`
833
834			`sub equal_range(&@)`
835			`{`
836			`my $lb = &lower_bound(@_);`
837			`my $ub = &upper_bound(@_);`
838			`return ($lb, $ub);`
839			`}`
840
841			`sub binsert (&$\@)`
842			`{`
843			`my $lb = &lower_bound($_[0], @{$_[2]});`
844			`splice @{$_[2]}, $lb, 0, $_[1];`
845			`return $lb;`
846			`}`
847
848			`sub bremove (&\@)`
849			`{`
850			`my $lb = &lower_bound($_[0], @{$_[1]});`
851			`return splice @{$_[1]}, $lb, 1;`
852			`}`
853
854			`sub qsort(&\@)`
855			`{`
856			`require Carp;`
857			`Carp::croak("It's insane to use a pure-perl qsort");`
858			`}`
859
860			`sub slide(&@)`
861			`{`
862			`my $op = shift;`
863			`my @l = @_;`
864
865			`## no critic (TestingAndDebugging::ProhibitNoStrict, ValuesAndExpressions::ProhibitCommaSeparatedStatements)`
866			`# Localise $a, $b`
867			`my ($caller_a, $caller_b) = do`
868			`{`
869			`my $pkg = caller();`
870			`no strict 'refs';`
871			`\{$pkg . '::a'}, \{$pkg . '::b'};`
872			`};`
873
874			`## no critic (Variables::RequireInitializationForLocalVars)`
875			`# This map expression is also the return value`
876			`local ($caller_a, $caller_b);`
877			`## no critic (BuiltinFunctions::ProhibitComplexMappings)`
878			`return map {`
879			`# Assign to $a, $b as refs to caller's array elements`
880			`($caller_a, $caller_b) = \($l[$_], $l[$_ + 1]);`
881
882			`# Perform the transformation`
883			`$op->();`
884			`} 0 .. ($#l - 1);`
885			`}`
886
887			`sub slideatatime ($$@)`
888			`{`
889			`my ($m, $w, @list) = @_;`
890			`my $n = $w - $m - 1;`
891			`return $n >= 0`
892			`? sub { my @r = splice @list, 0, $m; $#list < $n and $n = $#list; @r and push @r, (@list ? @list[0 .. $n] : ()); return @r; }`
893			`: sub { return splice @list, 0, $m; };`
894			`}`
895
896			`sub sort_by(&@)`
897			`{`
898			`my ($code, @list) = @_;`
899			`return map { $_->[0] }`
900			`sort { $a->[1] cmp $b->[1] }`
901			`map { [$_, scalar($code->())] } @list;`
902			`}`
903
904			`sub nsort_by(&@)`
905			`{`
906			`my ($code, @list) = @_;`
907			`return map { $_->[0] }`
908			`sort { $a->[1] <=> $b->[1] }`
909			`map { [$_, scalar($code->())] } @list;`
910			`}`
911
912			`## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)`
913			`sub _XScompiled { return 0 }`
914
915			`=head1 SEE ALSO`
916
917			`L<List::Util>`
918
919			`=head1 AUTHOR`
920
921			`Jens Rehsack E<lt>rehsack AT cpan.orgE<gt>`
922
923			`Adam Kennedy E<lt>adamk@cpan.orgE<gt>`
924
925			`Tassilo von Parseval E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>`
926
927			`=head1 COPYRIGHT AND LICENSE`
928
929			`Some parts copyright 2011 Aaron Crane.`
930
931			`Copyright 2004 - 2010 by Tassilo von Parseval`
932
933			`Copyright 2013 - 2017 by Jens Rehsack`
934
935			`All code added with 0.417 or later is licensed under the Apache License,`
936			`Version 2.0 (the "License"); you may not use this file except in compliance`
937			`with the License. You may obtain a copy of the License at`
938
939			`http://www.apache.org/licenses/LICENSE-2.0`
940
941			`Unless required by applicable law or agreed to in writing, software`
942			`distributed under the License is distributed on an "AS IS" BASIS,`
943			`WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.`
944			`See the License for the specific language governing permissions and`
945			`limitations under the License.`
946
947			`All code until 0.416 is licensed under the same terms as Perl itself,`
948			`either Perl version 5.8.4 or, at your option, any later version of`
949			`Perl 5 you may have available.`
950
951			`=cut`
952
953			`1;`