sub _unsigned_to_signed { return unpack('i', pack('I', $_[0])); } sub binsearch(&$\@) { my ($compare, $value, $array) = @_; # # If the $value is not found in @array, # the 1s complement of where the $value # should be inserted is returned. So, # $value is found if the return value >= 0. # # When compare is called, $a is an alias for $value, # and $b is an alias for the element of the array # against which $a which be compared. # # Example: # # Add $value to sorted @array, if it's not already there. # $idx = binsearch { $a <=> $b } $value, @array; # splice(@array, ~$idx, 0, $value) if ($idx < 0); # my $i = 0; my $j = $#$array; return $j if ($j == -1); my $ap = do { no strict 'refs'; \*{caller().'::a'} }; my $bp = do { no strict 'refs'; \*{caller().'::b'} }; local *$ap; local *$bp; *$ap = \$value; for (;;) { my $k = int(($i+$j)/2); *$bp = \($array->[$k]); my $cmp = &$compare(); return $k if ($cmp == 0); if ($cmp < 0) { $j = $k-1; return _unsigned_to_signed(~$k) if ($i > $j); } else { $i = $k+1; return _unsigned_to_signed(~$i) if ($i > $j); } } }