view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

SV* binsearch_pos( SV* block, SV* needle, SV* aref_haystack ) {
  dTHX;
  dSP;
  dMULTICALL;
  GV *gv;
  HV *stash;
  I32 gimme    = G_SCALAR;
  CV *cv       = sv_2cv(block, &stash, &gv, 0);
  I32 low      = 0;
  I32 high     = 0;
  GV *agv      = gv_fetchpv("a", GV_ADD, SVt_PV);
  GV *bgv      = gv_fetchpv("b", GV_ADD, SVt_PV);
  AV *haystack = 0;
  SAVESPTR(GvSV(agv));
  SAVESPTR(GvSV(bgv));

  /* We must have a valid subref, and aref for the haystack. */
  if( cv == Nullcv )
    croak("Not a subroutine reference.");
  if( ! SvROK( aref_haystack ) || SvTYPE(SvRV(aref_haystack)) != SVt_PVAV )
    croak( "Argument must be an array ref.\n" );

  haystack = (AV*)SvRV(aref_haystack);
  high = av_len(haystack) + 1; /* scalar @{$aref} (Perl 5.16 introduced av_top_index synonym.) */

  if( high <= 0 ) return newSViv(low); /* Empty list; insert at zero. */

  PUSH_MULTICALL(cv);

  while( low < high ) {

    I32 cur = ( high - low ) / 2 + low;
    
    /* Fetch value at aref_haystack->[mid] */
    GvSV(agv) = needle;
    GvSV(bgv) = *av_fetch(haystack,cur,0);  /* Hay */

    MULTICALL;
    if( SvIV( *PL_stack_sp ) > 0 ) {  /* if ($a<=>$b) > 0 */
      low = cur + 1;
    }
    else {
      high = cur;
    }
  }
  POP_MULTICALL;
  return newSViv(low);
}



MODULE = List::BinarySearch::XS   PACKAGE = List::BinarySearch::XS
PROTOTYPES: ENABLE

SV *
binsearch (block, needle, aref_haystack)
  SV *  block
  SV *  needle
  SV *  aref_haystack
  PROTOTYPE: &$\@
  PPCODE:
    /* We need binsearch to return undef or empty list on no match, depending
     * on context.  This snippet detects an undef rv, and just massages it
     * into an empty list.
     */
    I32 rv = binsearch( block, needle, aref_haystack );
    if( rv == -1 ) {
      XSRETURN_EMPTY;
    }
    else {
      SV* output = sv_2mortal(newSViv(rv));
      PUSHs(output);
    }
    /* In other words, only return something if our search was successful. */


SV *
binsearch_pos (block, needle, aref_haystack)
  SV *  block
  SV *  needle
  SV *  aref_haystack
  PROTOTYPE: &$\@