view release on metacpan or  search on metacpan

XS.xs  view on Meta::CPAN

        shuffle_tied_av_last_num_elements(av, len, num);
    } else {
        static SSize_t rand_index, cur_index;
        SV **pav = AvARRAY(av);
        SV* a;

        cur_index = std::move(len);

        while (cur_index >= 0) {
            rand_index = (cur_index + 1) * Drand01(); // rand() % (cur_index + 1);
            //warn("cur_index = %i\trnd = %i\n", (int)cur_index, (int)rand_index);
            a = std::move((SV*) pav[rand_index]);
            pav[rand_index] = std::move(pav[cur_index]);
            pav[cur_index] = std::move(a);
            cur_index--;
        }
    }
}

inline static void shuffle_av_first_num_elements (AV *av, SSize_t len, SSize_t num) {

    len++;

    //call_srand_if_required();

    if (SvTIED_mg((SV *)av, PERL_MAGIC_tied)) {
        shuffle_tied_av_first_num_elements(av, len, num);
    } else {
        static SSize_t rand_index, cur_index;
        SV* a;
        SV **pav = AvARRAY(av);

        cur_index = 0;

        while (cur_index <= num) {
            rand_index = cur_index + (len - cur_index) * Drand01(); // cur_index + rand() % (len - cur_index);
            //warn("cur_index = %i\trnd = %i\n", (int)cur_index, (int)rand_index);

            a = std::move((SV*) pav[rand_index]);
            pav[rand_index] = std::move(pav[cur_index]);
            pav[cur_index] = std::move(a);
            cur_index++;
        }
    }
}

MODULE = List::Helpers::XS      PACKAGE = List::Helpers::XS

PROTOTYPES: DISABLE

BOOT:
#if (PERL_VERSION >= 14)
    sv_setpv((SV*)GvCV(gv_fetchpvs("List::Helpers::XS::shuffle", 0, SVt_PVCV)), "+");
#else
    sv_setpv((SV*)GvCV(gv_fetchpvs("List::Helpers::XS::shuffle", 0, SVt_PVCV)), "\\@");
#endif

AV* random_slice (av, num)
    AV* av
    IV num
PPCODE:

    if (num < 0)
        croak("The slice's size can't be less than 0");

    if (num != 0) {

        static SSize_t last_index;

        last_index = std::move(av_top_index(av));
        num -= 1;

        if (num < last_index) {

            AV *slice;

            // shuffling for usual and tied arrays
            shuffle_av_first_num_elements(av, last_index, num);

            if (SvTIED_mg((SV *)av, PERL_MAGIC_tied)) {
                static SSize_t k;
                SV *sv, **svp;
                slice = newAV();
                for (k = 0; k <= num; k++) {
                    svp = av_fetch(av,  k, 0);
                    sv = (svp ? newSVsv(*svp) : &PL_sv_undef);
                    av_push(slice, sv);
                    mg_set(sv);
                }
            }
            else if (GIMME_V == G_VOID) {
                av_fill(av, num);
                XSRETURN_EMPTY;
            }
            else
                slice = av_make(num + 1, av_fetch(av, 0, 0));

            ST(0) = sv_2mortal(newRV_noinc( (SV *) slice )); // mXPUSHs(newRV_noinc( (SV *) slice ));
        }
    }

    XSRETURN(1);


void shuffle (av)
    AV *av
PPCODE:
    SSize_t len = av_len(av);
    /* it's faster than "shuffle_av_first_num_elements" */
    shuffle_av_last_num_elements(av, len, len);
    XSRETURN_EMPTY;


void shuffle_multi(av, ...)
    AV* av;
PPCODE:
    static SSize_t i;
    static SSize_t len;
    SV* sv;
    SV *ref;

    if (items == 0)
        croak("Wrong amount of arguments");

    for (i = 0; i < items; i++) {
        sv = ST(i);
        if (!SvOK(sv)) // skip undefs
            continue;
        if (!SvROK(sv)) // isn't a ref type
            croak_sv_is_not_an_arrayref(i);
        ref = SvRV(sv);
        if (SvTYPE(ref) == SVt_PVAV) { // $ref eq "ARRAY"
            av = (AV *) ref;
            len = av_len(av);
            shuffle_av_last_num_elements(av, len, len);
        }
        else // $ref ne "ARRAY"
            croak_sv_is_not_an_arrayref(i);
    }
    // if (items < X) EXTEND(SP, X);

    XSRETURN_EMPTY;