MoreUtils.xs   [plain text]


#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"


#ifndef PERL_VERSION
#    include <patchlevel.h>
#    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
#        include <could_not_find_Perl_patchlevel.h>
#    endif
#    define PERL_REVISION	5
#    define PERL_VERSION	PATCHLEVEL
#    define PERL_SUBVERSION	SUBVERSION
#endif

#ifndef aTHX
#  define aTHX
#  define pTHX
#endif

/* multicall.h is all nice and 
 * fine but wont work on perl < 5.6.0 */

#if PERL_VERSION > 5
#   include "multicall.h"
#else
#   define dMULTICALL						\
	OP *_op;						\
	PERL_CONTEXT *cx;					\
	SV **newsp;						\
	U8 hasargs = 0;						\
	bool oldcatch = CATCH_GET
#   define PUSH_MULTICALL(cv)					\
	_op = CvSTART(cv);					\
	SAVESPTR(CvROOT(cv)->op_ppaddr);			\
	CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];		\
	SAVESPTR(PL_curpad);					\
	PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);	\
	SAVETMPS;						\
	SAVESPTR(PL_op);					\
	CATCH_SET(TRUE);					\
	PUSHBLOCK(cx, CXt_SUB, SP);				\
	PUSHSUB(cx)
#   define MULTICALL						\
	PL_op = _op;						\
	CALLRUNOPS()
#   define POP_MULTICALL					\
	POPBLOCK(cx,PL_curpm);					\
	CATCH_SET(oldcatch);					\
	SPAGAIN
#endif

/* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc)
   was not exported. Therefore platforms like win32, VMS etc have problems
   so we redefine it here -- GMB
*/
#if PERL_VERSION < 7
/* Not in 5.6.1. */
#  define SvUOK(sv)           SvIOK_UV(sv)
#  ifdef cxinc
#    undef cxinc
#  endif
#  define cxinc() my_cxinc(aTHX)
static I32
my_cxinc(pTHX)
{
    cxstack_max = cxstack_max * 3 / 2;
    Renew(cxstack, cxstack_max + 1, struct context);      /* XXX should fix CXINC macro */
    return cxstack_ix + 1;
}
#endif

#if PERL_VERSION < 6
#    define NV double
#    define LEAVESUB(cv)	    \
	{			    \
	    if (cv)		{   \
		SvREFCNT_dec(cv);   \
	    }			    \
	}
#endif

#ifdef SVf_IVisUV
#  define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv))
#else
#  define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
#endif

#ifndef Drand01
#    define Drand01()           ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))
#endif

#if PERL_VERSION < 5
#  ifndef gv_stashpvn
#    define gv_stashpvn(n,l,c) gv_stashpv(n,c)
#  endif
#  ifndef SvTAINTED

static bool
sv_tainted(SV *sv)
{
    if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
	MAGIC *mg = mg_find(sv, 't');
	if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
	    return TRUE;
    }
    return FALSE;
}

#    define SvTAINTED_on(sv) sv_magic((sv), Nullsv, 't', Nullch, 0)
#    define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv))
#  endif
#  define PL_defgv defgv
#  define PL_op op
#  define PL_curpad curpad
#  define CALLRUNOPS runops
#  define PL_curpm curpm
#  define PL_sv_undef sv_undef
#  define PERL_CONTEXT struct context
#endif
#if (PERL_VERSION < 5) || (PERL_VERSION == 5 && PERL_SUBVERSION <50)
#  ifndef PL_tainting
#    define PL_tainting tainting
#  endif
#  ifndef PL_stack_base
#    define PL_stack_base stack_base
#  endif
#  ifndef PL_stack_sp
#    define PL_stack_sp stack_sp
#  endif
#  ifndef PL_ppaddr
#    define PL_ppaddr ppaddr
#  endif
#endif

#ifndef PTR2UV
#  define PTR2UV(ptr) (UV)(ptr)
#endif

#ifndef SvPV_nolen
    STRLEN N_A;
#   define SvPV_nolen(sv) SvPV(sv, N_A)
#endif

#ifndef call_sv
#  define call_sv perl_call_sv
#endif

#define WARN_OFF \
    SV *oldwarn = PL_curcop->cop_warnings; \
    PL_curcop->cop_warnings = pWARN_NONE;

#define WARN_ON \
    PL_curcop->cop_warnings = oldwarn;

#define EACH_ARRAY_BODY \
	register int i;									\
	arrayeach_args * args;								\
	HV *stash = gv_stashpv("List::MoreUtils_ea", TRUE);				\
	CV *closure = newXS(NULL, XS_List__MoreUtils__array_iterator, __FILE__);	\
											\
	/* prototype */									\
	sv_setpv((SV*)closure, ";$");							\
											\
	New(0, args, 1, arrayeach_args);						\
	New(0, args->avs, items, AV*);							\
	args->navs = items;								\
	args->curidx = 0;								\
											\
	for (i = 0; i < items; i++) {							\
	    args->avs[i] = (AV*)SvRV(ST(i));						\
	    SvREFCNT_inc(args->avs[i]);							\
	}										\
											\
	CvXSUBANY(closure).any_ptr = args;						\
	RETVAL = newRV_noinc((SV*)closure);						\
											\
	/* in order to allow proper cleanup in DESTROY-handler */			\
	sv_bless(RETVAL, stash)


/* #include "dhash.h" */

/* need this one for array_each() */
typedef struct {
    AV **avs;	    /* arrays over which to iterate in parallel */
    int navs;	    /* number of arrays */
    int curidx;	    /* the current index of the iterator */
} arrayeach_args;

/* used for natatime */
typedef struct {
    SV **svs;
    int nsvs;
    int curidx;
    int natatime;
} natatime_args;

void
insert_after (int idx, SV *what, AV *av) {
    register int i, len;
    av_extend(av, (len = av_len(av) + 1));
    
    for (i = len; i > idx+1; i--) {
	SV **sv = av_fetch(av, i-1, FALSE);
	SvREFCNT_inc(*sv);
	av_store(av, i, *sv);
    }
    if (!av_store(av, idx+1, what))
	SvREFCNT_dec(what);

}
   
MODULE = List::MoreUtils		PACKAGE = List::MoreUtils		

void
any (code,...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    GV *gv;
    HV *stash;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	XSRETURN_UNDEF;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));
	    
    for(i = 1 ; i < items ; ++i) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) {
	    POP_MULTICALL;
	    XSRETURN_YES;
	}
    }
    POP_MULTICALL;
    XSRETURN_NO;
}

void
all (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	XSRETURN_UNDEF;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));
 
    for(i = 1 ; i < items ; i++) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (!SvTRUE(*PL_stack_sp)) {
	    POP_MULTICALL;
	    XSRETURN_NO;
	}
    }
    POP_MULTICALL;
    XSRETURN_YES;
}


void
none (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	XSRETURN_UNDEF;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for(i = 1 ; i < items ; ++i) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) {
	    POP_MULTICALL;
	    XSRETURN_NO;
	}
    }
    POP_MULTICALL;
    XSRETURN_YES;
}

void
notall (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	XSRETURN_UNDEF;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));
	    
    for(i = 1 ; i < items ; ++i) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (!SvTRUE(*PL_stack_sp)) {
	    POP_MULTICALL;
	    XSRETURN_YES;
	}
    }
    POP_MULTICALL;
    XSRETURN_NO;
}

int
true (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    I32 count = 0;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	goto done;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for(i = 1 ; i < items ; ++i) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) 
	    count++;
    }
    POP_MULTICALL;

    done:
    RETVAL = count;
}
OUTPUT:
    RETVAL

int
false (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    I32 count = 0;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	goto done;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for(i = 1 ; i < items ; ++i) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (!SvTRUE(*PL_stack_sp)) 
	    count++;
    }
    POP_MULTICALL;

    done:
    RETVAL = count;
}
OUTPUT:
    RETVAL

int
firstidx (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    RETVAL = -1;
    
    if (items > 1) {
	cv = sv_2cv(code, &stash, &gv, 0);
	PUSH_MULTICALL(cv);
	SAVESPTR(GvSV(PL_defgv));
 
	for (i = 1 ; i < items ; ++i) {
	    GvSV(PL_defgv) = args[i];
	    MULTICALL;
	    if (SvTRUE(*PL_stack_sp)) {
		RETVAL = i-1;
		break;
	    }
	}
	POP_MULTICALL;
    }
}
OUTPUT:
    RETVAL

int
lastidx (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    RETVAL = -1;
    
    if (items > 1) {
	cv = sv_2cv(code, &stash, &gv, 0);
	PUSH_MULTICALL(cv);
	SAVESPTR(GvSV(PL_defgv));
 
	for (i = items-1 ; i > 0 ; --i) {
	    GvSV(PL_defgv) = args[i];
	    MULTICALL;
	    if (SvTRUE(*PL_stack_sp)) {
		RETVAL = i-1;
		break;
	    }
	}
	POP_MULTICALL;
    }
}
OUTPUT:
    RETVAL

int
insert_after (code, val, avref)
    SV *code;
    SV *val;
    SV *avref;
PROTOTYPE: &$\@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    CV *cv;

    AV *av = (AV*)SvRV(avref);
    int len = av_len(av);
    RETVAL = 0;
    
    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for (i = 0; i <= len ; ++i) {
	GvSV(PL_defgv) = *av_fetch(av, i, FALSE);
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) {
	    RETVAL = 1;
	    break;
	}
    }
    
    POP_MULTICALL;

    if (RETVAL) {
	SvREFCNT_inc(val);
	insert_after(i, val, av);
    }
}
OUTPUT:
    RETVAL

int
insert_after_string (string, val, avref)
	SV *string;
	SV *val;
	SV *avref;
    PROTOTYPE: $$\@
    CODE:
    {
	register int i;
	AV *av = (AV*)SvRV(avref);
	int len = av_len(av);
	register SV **sv;
	STRLEN slen = 0, alen;
	register char *str;
	register char *astr;
	RETVAL = 0;
	
	if (SvTRUE(string))
	    str = SvPV(string, slen);
	else 
	    str = NULL;
	    
	for (i = 0; i <= len ; i++) {
	    sv = av_fetch(av, i, FALSE);
	    if (SvTRUE(*sv))
		astr = SvPV(*sv, alen); 
	    else {
		astr = NULL;
		alen = 0;
	    }
	    if (slen == alen && memcmp(astr, str, slen) == 0) {
		RETVAL = 1;
		break;
	    }
	}
	if (RETVAL) {
	    SvREFCNT_inc(val);
	    insert_after(i, val, av);
	}

    }
    OUTPUT:
	RETVAL
	
void
apply (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    CV *cv;
    SV **args = &PL_stack_base[ax];	
    I32 count = 0;
    
    if (items <= 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));
	    
    for(i = 1 ; i < items ; ++i) {
	GvSV(PL_defgv) = newSVsv(args[i]);
	MULTICALL;
	args[i-1] = GvSV(PL_defgv);
    }
    POP_MULTICALL;

    done:
    XSRETURN(items-1);
}

void
after (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i, j;
    HV *stash;
    CV *cv;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];

    if (items <= 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for (i = 1; i < items; i++) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) {
	    break;
	}
    }

    POP_MULTICALL;

    for (j = i + 1; j < items; ++j)
	args[j-i-1] = args[j];

    XSRETURN(items-i-1);
}

void
after_incl (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i, j;
    HV *stash;
    CV *cv;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];

    if (items <= 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for (i = 1; i < items; i++) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) {
	    break;
	}
    }

    POP_MULTICALL;

    for (j = i; j < items; j++)
	args[j-i] = args[j];

    XSRETURN(items-i);
}

void
before (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;
    
    if (items <= 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for (i = 1; i < items; i++) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) {
	    break;
	}
	args[i-1] = args[i];
    }

    POP_MULTICALL;

    XSRETURN(i-1);
}

void
before_incl (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for (i = 1; i < items; ++i) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	args[i-1] = args[i];
	if (SvTRUE(*PL_stack_sp)) {
	    ++i;
	    break;
	}
    }

    POP_MULTICALL;

    XSRETURN(i-1);
}

void
indexes (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i, j;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    if (items <= 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));
    
    for (i = 1, j = 0; i < items; i++) {
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	if (SvTRUE(*PL_stack_sp)) {
	    args[j] = sv_2mortal(newSViv(i-1));
	    /* need to artificially increase ref-count here
	     * because POPBLOCK further below would otherwise
	     * free the items in SP */
	    SvREFCNT_inc(args[j]);
	    j++;
	}
    }
    
    POP_MULTICALL;
    
    XSRETURN(j);
}

SV *
lastval (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];	
    CV *cv;

    RETVAL = &PL_sv_undef;
    
    if (items > 1) {
	cv = sv_2cv(code, &stash, &gv, 0);
	PUSH_MULTICALL(cv);
	SAVESPTR(GvSV(PL_defgv));

	for (i = items-1 ; i > 0 ; --i) {
	    GvSV(PL_defgv) = args[i];
	    MULTICALL;
	    if (SvTRUE(*PL_stack_sp)) {
		/* see comment in indexes() */
		SvREFCNT_inc(RETVAL = args[i]);
		break;
	    }
	}
	POP_MULTICALL;
    }
}
OUTPUT:
    RETVAL

SV *
firstval (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    RETVAL = &PL_sv_undef;
    
    if (items > 1) {
	cv = sv_2cv(code, &stash, &gv, 0);
	PUSH_MULTICALL(cv);
	SAVESPTR(GvSV(PL_defgv));

	for (i = 1; i < items; ++i) {
	    GvSV(PL_defgv) = args[i];
	    MULTICALL;
	    if (SvTRUE(*PL_stack_sp)) {
		/* see comment in indexes() */
		SvREFCNT_inc(RETVAL = args[i]);
		break;
	    }
	}
	POP_MULTICALL;
    }
}
OUTPUT:
    RETVAL

void
_array_iterator (method = "")
    char *method;
    PROTOTYPE: ;$
    CODE:
    {
	register int i;
	int exhausted = 1;
	
	/* 'cv' is the hidden argument with which XS_List__MoreUtils__array_iterator (this XSUB)
	 * is called. The closure_arg struct is stored in this CV. */
#define ME_MYSELF_AND_I cv
	
	arrayeach_args *args = (arrayeach_args*)CvXSUBANY(ME_MYSELF_AND_I).any_ptr;
	
	if (strEQ(method, "index")) {
	    EXTEND(SP, 1);
	    ST(0) = args->curidx > 0 ? sv_2mortal(newSViv(args->curidx-1)) : &PL_sv_undef;
	    XSRETURN(1);
	}
    
	EXTEND(SP, args->navs);

	for (i = 0; i < args->navs; i++) {
	    AV *av = args->avs[i];
	    if (args->curidx <= av_len(av)) {
		ST(i) = sv_2mortal(newSVsv(*av_fetch(av, args->curidx, FALSE)));
		SvREFCNT_inc(ST(i));
		exhausted = 0;
		continue;
	    }
	    ST(i) = &PL_sv_undef;
	}
	
	if (exhausted) 
	    XSRETURN_EMPTY;

	args->curidx++;
	XSRETURN(args->navs);
    }

SV *
each_array (...)
    PROTOTYPE: \@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@
    CODE:
    {
	EACH_ARRAY_BODY;
    }
    OUTPUT:
	RETVAL

SV *
each_arrayref (...)
    CODE:
    {
	EACH_ARRAY_BODY;
    }
    OUTPUT:
	RETVAL

#if 0
void
_pairwise (code, ...)
	SV *code;
    PROTOTYPE: &\@\@
    PPCODE:
    {
#define av_items(a) (av_len(a)+1)
	
	register int i;
	AV *avs[2];
	SV **oldsp;
	
	int nitems = 0, maxitems = 0;

	/* deref AV's for convenience and 
	 * get maximum items */
	avs[0] = (AV*)SvRV(ST(1));
	avs[1] = (AV*)SvRV(ST(2));
	maxitems = av_items(avs[0]);
	if (av_items(avs[1]) > maxitems)
	    maxitems = av_items(avs[1]);
	
	if (!PL_firstgv || !PL_secondgv) {
	    SAVESPTR(PL_firstgv);
	    SAVESPTR(PL_secondgv);
	    PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
	    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
	}
	
	oldsp = PL_stack_base;
	EXTEND(SP, maxitems);
	ENTER;
	for (i = 0; i < maxitems; i++) {
	    int nret;
	    SV **svp = av_fetch(avs[0], i, FALSE);
	    GvSV(PL_firstgv) = svp ? *svp : &PL_sv_undef;
	    svp = av_fetch(avs[1], i, FALSE);
	    GvSV(PL_secondgv) = svp ? *svp : &PL_sv_undef;
	    PUSHMARK(SP);
	    PUTBACK;
	    nret = call_sv(code, G_EVAL|G_ARRAY);
            if (SvTRUE(ERRSV))
                croak("%s", SvPV_nolen(ERRSV));
	    SPAGAIN;
	    nitems += nret;
	    while (nret--) {
		SvREFCNT_inc(*PL_stack_sp++);
	    }
	}
	PL_stack_base = oldsp;
	LEAVE;
	XSRETURN(nitems);
    }

#endif

void
pairwise (code, ...)
	SV *code;
    PROTOTYPE: &\@\@
    PPCODE:
    {
#define av_items(a) (av_len(a)+1)
	
	/* This function is not quite as efficient as it ought to be: We call
	 * 'code' multiple times and want to gather its return values all in
	 * one list. However, each call resets the stack pointer so there is no
	 * obvious way to get the return values onto the stack without making
	 * intermediate copies of the pointers.  The above disabled solution
	 * would be more efficient. Unfortunately it doesn't work (and, as of
	 * now, wouldn't deal with 'code' returning more than one value).
	 *
	 * The current solution is a fair trade-off. It only allocates memory
	 * for a list of SV-pointers, as many as there are return values. It
	 * temporarily stores 'code's return values in this list and, when
	 * done, copies them down to SP. */
	
	register int i, j;
	AV *avs[2];
	SV **oldsp;
	register SV **buf, **p;	/* gather return values here and later copy down to SP */
	int alloc;
	
	int nitems = 0, maxitems = 0;
	register int d;
	
	/* deref AV's for convenience and 
	 * get maximum items */
	avs[0] = (AV*)SvRV(ST(1));
	avs[1] = (AV*)SvRV(ST(2));
	maxitems = av_items(avs[0]);
	if (av_items(avs[1]) > maxitems)
	    maxitems = av_items(avs[1]);
	
	if (!PL_firstgv || !PL_secondgv) {
	    SAVESPTR(PL_firstgv);
	    SAVESPTR(PL_secondgv);
	    PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
	    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
	}

	New(0, buf, alloc = maxitems, SV*);

	ENTER;
	for (d = 0, i = 0; i < maxitems; i++) {
	    int nret;
	    SV **svp = av_fetch(avs[0], i, FALSE);
	    GvSV(PL_firstgv) = svp ? *svp : &PL_sv_undef;
	    svp = av_fetch(avs[1], i, FALSE);
	    GvSV(PL_secondgv) = svp ? *svp : &PL_sv_undef;
	    PUSHMARK(SP);
	    PUTBACK;
	    nret = call_sv(code, G_EVAL|G_ARRAY);
            if (SvTRUE(ERRSV)) {
                Safefree(buf);
                croak("%s", SvPV_nolen(ERRSV));
            }
	    SPAGAIN;
	    nitems += nret;
	    if (nitems > alloc) {
		alloc <<= 2;
		Renew(buf, alloc, SV*);
	    }
	    for (j = nret-1; j >= 0; j--) {
		/* POPs would return elements in reverse order */
		buf[d] = sp[-j];
		SvREFCNT_inc(buf[d]);
		d++;
	    }
	    sp -= nret;
	}
	LEAVE;
	EXTEND(SP, nitems);
	p = buf;
	for (i = 0; i < nitems; i++)
	    ST(i) = *p++;
	
	Safefree(buf);
	XSRETURN(nitems);
    }

void
_natatime_iterator ()
    PROTOTYPE:
    CODE:
    {
	register int i;
	int nret;

	/* 'cv' is the hidden argument with which XS_List__MoreUtils__array_iterator (this XSUB)
	 * is called. The closure_arg struct is stored in this CV. */
#define ME_MYSELF_AND_I cv
	
	natatime_args *args = (natatime_args*)CvXSUBANY(ME_MYSELF_AND_I).any_ptr;
	
	nret = args->natatime;
	
	EXTEND(SP, nret);

	for (i = 0; i < args->natatime; i++) {
	    if (args->nsvs) {
		ST(i) = sv_2mortal(newSVsv(args->svs[args->curidx++]));
		args->nsvs--;
	    }
	    else {
		XSRETURN(i);
	    }
	}

	XSRETURN(nret);
    }

SV *
natatime (n, ...)
    int n;
    PROTOTYPE: $@
    CODE:
    {
	register int i;
	natatime_args * args;
	HV *stash = gv_stashpv("List::MoreUtils_na", TRUE);

	CV *closure = newXS(NULL, XS_List__MoreUtils__natatime_iterator, __FILE__);

	/* must NOT set prototype on iterator:
	 * otherwise one cannot write: &$it */
	/* !! sv_setpv((SV*)closure, ""); !! */

	New(0, args, 1, natatime_args);
	New(0, args->svs, items-1, SV*);
	args->nsvs = items-1;
	args->curidx = 0;
	args->natatime = n;

	for (i = 1; i < items; i++) 
	    SvREFCNT_inc(args->svs[i-1] = ST(i));
	
	CvXSUBANY(closure).any_ptr = args;
	RETVAL = newRV_noinc((SV*)closure);

	/* in order to allow proper cleanup in DESTROY-handler */
	sv_bless(RETVAL, stash);    
    }
    OUTPUT:
	RETVAL

void
mesh (...)
    PROTOTYPE: \@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@
    CODE:
    {
	register int i, j, maxidx = -1;
	AV **avs;
	New(0, avs, items, AV*);
	
	for (i = 0; i < items; i++) {
	    avs[i] = (AV*)SvRV(ST(i));
	    if (av_len(avs[i]) > maxidx)
		maxidx = av_len(avs[i]);
	}

	EXTEND(SP, items * (maxidx + 1));
	for (i = 0; i <= maxidx; i++) 
	    for (j = 0; j < items; j++) {
		SV **svp = av_fetch(avs[j], i, FALSE);
		ST(i*items + j) = svp ? sv_2mortal(newSVsv(*svp)) : &PL_sv_undef;
	    }

	Safefree(avs);
	XSRETURN(items * (maxidx + 1));
    }

void
uniq (...)
    PROTOTYPE: @
    CODE:
    {
	register int i, count = 0;
	HV *hv = newHV();
	
	/* don't build return list in scalar context */
	if (GIMME == G_SCALAR) {
	    for (i = 0; i < items; i++) {
		if (!hv_exists_ent(hv, ST(i), 0)) {
		    count++;
		    hv_store_ent(hv, ST(i), &PL_sv_yes, 0);
		}
	    }
	    SvREFCNT_dec(hv);
	    ST(0) = sv_2mortal(newSViv(count));
	    XSRETURN(1);
	}

	/* list context: populate SP with mortal copies */
	for (i = 0; i < items; i++) {
	    if (!hv_exists_ent(hv, ST(i), 0)) {
		ST(count) = sv_2mortal(newSVsv(ST(i)));
		count++;
		hv_store_ent(hv, ST(i), &PL_sv_yes, 0);
	    }
	}
	SvREFCNT_dec(hv);
	XSRETURN(count);
    }

void
minmax (...)
    PROTOTYPE: @
    CODE:
    {
	register int i;
	register SV *minsv, *maxsv, *asv, *bsv;
	register double min, max, a, b;
	
	if (!items)
	    XSRETURN_EMPTY;

	minsv = maxsv = ST(0);
	min = max = slu_sv_value(minsv);

	for (i = 1; i < items; i += 2) {
	    asv = ST(i-1);
	    bsv = ST(i);
	    a = slu_sv_value(asv);
	    b = slu_sv_value(bsv);
	    if (a <= b) {
		if (min > a) {
		    min = a;
		    minsv = asv;
		}
		if (max < b) {
		    max = b;
		    maxsv = bsv;
		}
	    } else {
		if (min > b) {
		    min = b;
		    minsv = bsv;
		}
		if (max < a) {
		    max = a;
		    maxsv = asv;
		}
	    }
	}

	if (items & 1) {
	    asv = ST(items-2);
	    bsv = ST(items-1);
	    a = slu_sv_value(asv);
	    b = slu_sv_value(bsv);
	    if (a <= b) {
		if (min > a) {
		    min = a;
		    minsv = asv;
		}
		if (max < b) {
		    max = b;
		    maxsv = bsv;
		}
	    } else {
		if (min > b) {
		    min = b;
		    minsv = bsv;
		}
		if (max < a) {
		    max = a;
		    maxsv = asv;
		}
	    }
	}
	ST(0) = minsv;
	ST(1) = maxsv;

	XSRETURN(2);
    }

void
part (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    dMULTICALL;
    register int i, j;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    I32 count = 0;
    SV **args = &PL_stack_base[ax];
    CV *cv;
    
    AV **tmp = NULL;
    int last = 0;
    
    if (items == 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for(i = 1 ; i < items ; ++i) {
	int idx;
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	idx = SvIV(*PL_stack_sp);

	if (idx < 0 && (idx += last) < 0)
	    croak("Modification of non-creatable array value attempted, subscript %i", idx);

	if (idx >= last) {
	    int oldlast = last;
	    last = idx + 1;
	    Renew(tmp, last, AV*);
	    Zero(tmp + oldlast, last - oldlast, AV*);
	}
	if (!tmp[idx])
	    tmp[idx] = newAV();
	av_push(tmp[idx], args[i]);
	SvREFCNT_inc(args[i]);
    }
    POP_MULTICALL;

    EXTEND(SP, last);
    for (i = 0; i < last; ++i) {
	if (!tmp[i]) {
	    ST(i) = &PL_sv_undef;
	    continue;
	}
	ST(i) = newRV_noinc((SV*)tmp[i]);
    }
    
    Safefree(tmp);
    XSRETURN(last);
}

#if 0
void
part_dhash (code, ...)
    SV *code;
PROTOTYPE: &@
CODE:
{
    /* We might want to keep this dhash-implementation.
     * It is currently slower than the above but it uses less
     * memory for sparse parts such as 
     *   @part = part { 10_000_000 } 1 .. 100_000;
     * Maybe there's a way to optimize dhash.h to get more speed
     * from it.
     */
    dMULTICALL;
    register int i, j, lastidx = -1;
    int max;
    HV *stash;
    GV *gv;
    I32 gimme = G_SCALAR;
    I32 count = 0;
    SV **args = &PL_stack_base[ax];
    CV *cv;

    dhash_t *h = dhash_init();

    if (items == 1)
	XSRETURN_EMPTY;

    cv = sv_2cv(code, &stash, &gv, 0);
    PUSH_MULTICALL(cv);
    SAVESPTR(GvSV(PL_defgv));

    for(i = 1 ; i < items ; ++i) {
	int idx;
	GvSV(PL_defgv) = args[i];
	MULTICALL;
	idx = SvIV(*PL_stack_sp);

	if (idx < 0 && (idx += h->max) < 0)
	    croak("Modification of non-creatable array value attempted, subscript %i", idx);

	dhash_store(h, idx, args[i]);
    }
    POP_MULTICALL;

    dhash_sort_final(h);
    
    EXTEND(SP, max = h->max+1);
    i = 0;
    lastidx = -1;
    while (i < h->count) {
	int retidx = h->ary[i].key;
	int fill = retidx - lastidx - 1;
	for (j = 0; j < fill; j++) {
	    ST(retidx - j - 1) = &PL_sv_undef;
	}
	ST(retidx) = newRV_noinc((SV*)h->ary[i].val);
	i++;
	lastidx = retidx;
    }
    
    dhash_destroy(h);
    XSRETURN(max);
}

#endif

void
_XScompiled ()
    CODE:
	XSRETURN_YES;


MODULE = List::MoreUtils                PACKAGE = List::MoreUtils_ea

void
DESTROY(sv)
    SV *sv;
    CODE:
    {
	register int i;
	CV *code = (CV*)SvRV(sv);
	arrayeach_args *args = CvXSUBANY(code).any_ptr;
	if (args) {
	    for (i = 0; i < args->navs; ++i)
		SvREFCNT_dec(args->avs[i]);
	    Safefree(args->avs);
	    Safefree(args);
	    CvXSUBANY(code).any_ptr = NULL;
	}
    }


MODULE = List::MoreUtils                PACKAGE = List::MoreUtils_na

void
DESTROY(sv)
    SV *sv;
    CODE:
    {
	register int i;
	CV *code = (CV*)SvRV(sv);
	natatime_args *args = CvXSUBANY(code).any_ptr;
	if (args) {
	    for (i = 0; i < args->nsvs; ++i)
		SvREFCNT_dec(args->svs[i]);
	    Safefree(args->svs);
	    Safefree(args);
	    CvXSUBANY(code).any_ptr = NULL;
	}
    }