view release on metacpan or  search on metacpan

Permute.xs  view on Meta::CPAN

    if (RETVAL->ptr_head == NULL)
        XSRETURN_UNDEF;
    q = RETVAL->ptr_head;
    RETVAL->ptr  = safemalloc(sizeof(listrecord*) * (num + 1));
    if (RETVAL->ptr == NULL)
        XSRETURN_UNDEF;
    RETVAL->pred = safemalloc(sizeof(listrecord*) * (num + 1));
    if (RETVAL->pred == NULL)
        XSRETURN_UNDEF;
#else
    RETVAL->p = (UINT*) safemalloc(sizeof(UINT) * (num + 1));
    if (RETVAL->p == NULL)
        XSRETURN_UNDEF;
    RETVAL->loc = (UINT*) safemalloc(sizeof(UINT) * (num + 1));
    if (RETVAL->loc == NULL)
        XSRETURN_UNDEF;
#endif

    /* initialize items, p, and loc */
    for (i = 1; i <= num; i++) {
        if (has_combination) {
            *(RETVAL->items + i) = &PL_sv_undef;
        } else {
            *(RETVAL->items + i) = av_shift(av);
        }
#ifdef USE_LINKEDLIST
        q->link = safemalloc(sizeof(listrecord));
        if (q->link == NULL)
            XSRETURN_UNDEF;
        q = q->link;

        q->info = num - i + 1;
        RETVAL->ptr[q->info] = q;
        RETVAL->pred[i] = RETVAL->ptr_head; /* all predecessors point to ptr_head */
#else
        *(RETVAL->p + i) = num - i + 1;
        *(RETVAL->loc + i) = 1;
#endif
    }
#ifdef USE_LINKEDLIST
    q->link = NULL; /* the tail of list points to NULL */
#endif

    if (has_combination) {
        if(!reset_combination(RETVAL, av, r)) {
            XSRETURN_UNDEF;
        }
    }

    OUTPUT:
    RETVAL

void
next(self)
    Permute *self
    PREINIT:
    int i;
#ifdef USE_LINKEDLIST
    listrecord *q; /* temporary holder */
#endif
    PPCODE:
    if (self->is_done) { /* done permutation for all combination */
        if (self->c) {
            free_combination(self->c);
            self->c = NULL;
        }
        XSRETURN_EMPTY;
    }
    else {
        EXTEND(sp, self->num);  
#ifdef USE_LINKEDLIST
        q = self->ptr_head->link;
        while (q) {
            PUSHs(sv_2mortal(newSVsv(*(self->items + q->info))));
            /* PerlIO_stdoutf("%d\n", q->info); */
            q = q->link;
        }
        self->is_done = _next(self->num, self->ptr_head, self->ptr, self->pred);
#else
        for (i = 1; i <= self->num; i++) {
            PUSHs(sv_2mortal(newSVsv(*(self->items + *(self->p + i)))));
        }
        self->is_done = _next(self->num, self->p, self->loc);
#endif
    }
    /* generate next combination if necessary */
    if (self->is_done && self->c) { /* permutation done */
        self->is_done = coollex(self->c); /* generate next combination */
#ifdef USE_LINKEDLIST
        q = self->ptr_head;
        for (i = 1; i <= self->num; i++) {
            q = q->link;
            q->info = self->num - i + 1;
            self->pred[i] = self->ptr_head;
        }
        /* q->link = NULL; */ 
        assert(q->link == NULL); /* should point to NULL */
#else
        /* reset self->p and self->loc */
        for (i = 1; i <= self->num; i++) {
            *(self->p + i) = self->num - i + 1;
            *(self->loc + i) = 1;
        }
#endif
        /* and update self->items */
        coollex_visit(self->c, self->items + 1);
    }

void
DESTROY(self)
    Permute *self
    PREINIT:
    int i;
#ifdef USE_LINKEDLIST
    listrecord *q;
#endif
    CODE:
    SvREFCNT_dec(self->aryref);
#ifdef USE_LINKEDLIST
    q = self->ptr_head;
    for (i = 1; i <= self->num; i++) {
        safefree(self->ptr[i]);
        /* No need to deallocate this, in fact, it would be disaster */
        /* safefree(self->pred[i]); */
        SvREFCNT_dec(*(self->items + i));
    }
    safefree(self->ptr);
    safefree(self->pred);
    safefree(self->ptr_head);
#else
    safefree(self->p); /* must free elements first? */
    safefree(self->loc); 
    for (i = 1; i <= self->num; i++) { /* leakproof! */
        SvREFCNT_dec(*(self->items + i));
    }
#endif
    safefree(self->items);
    safefree(self);

void 
peek(self)
    Permute *self
    PREINIT:
#ifdef USE_LINKEDLIST
    listrecord *q;
#else
    int i;
#endif
    PPCODE: 
    if (self->is_done) 
        XSRETURN_EMPTY;
    EXTEND(sp, self->num);
#ifdef USE_LINKEDLIST
    q = self->ptr_head->link;
    while (q) {
        PUSHs(sv_2mortal(newSVsv(*(self->items + q->info))));
        q = q->link;
    }
#else
    for (i = 1; i <= self->num; i++)
        PUSHs(sv_2mortal(newSVsv(*(self->items + *(self->p + i)))));
#endif

void
reset(self)
    Permute *self
    PREINIT:
    int i;
    AV* av;
    COMBINATION *c;
    UV n;
#ifdef USE_LINKEDLIST
    listrecord *q;
#endif
    CODE:
    self->is_done = FALSE;

    reset_combination(self, (AV*)(SvRV(self->aryref)), self->num);
#ifdef USE_LINKEDLIST
    q = self->ptr_head;
    for (i = 1; i <= self->num; i++) {
        q = q->link;
        q->info = self->num - i + 1;
        self->pred[i] = self->ptr_head;
    }
    assert(q->link == NULL);
#else
    for (i = 1; i <= self->num; i++) {
        *(self->p + i) = self->num - i + 1;
        *(self->loc + i) = 1;     
    }
#endif

void
permute(callback_sv, array_sv)
SV* callback_sv;
SV* array_sv;
  PROTOTYPE: &\@
  PREINIT:
    CV*           callback;
    GV*           agv;
    I32           x;
    PERL_CONTEXT* cx;
    I32           gimme = G_VOID;  /* We call our callback in VOID context */

    bool          old_catch;
    struct afp_cache *c;
    I32 hasargs = 0;
    SV** newsp;
  PPCODE:
{
    if (!SvROK(callback_sv) || SvTYPE(SvRV(callback_sv)) != SVt_PVCV)
        Perl_croak(aTHX_ "Callback is not a CODE reference");
    if (!SvROK(array_sv)    || SvTYPE(SvRV(array_sv))    != SVt_PVAV)
        Perl_croak(aTHX_ "Array is not an ARRAY reference");
    
    c = malloc(sizeof(struct afp_cache));
    callback = (CV*)SvRV(callback_sv);
    c->array    = (AV*)SvRV(array_sv);
    c->len      = 1 + av_len(c->array);
    
    agv = gv_fetchpv("A", TRUE, SVt_PVAV);
    SAVESPTR(GvSV(agv));

    if (SvREADONLY(c->array))
        Perl_croak(aTHX_ "Can't permute a read-only array");

    if (c->len == 0) {
        /* Should we warn here? */
        free(c);
        return;
    }
    
    c->array_array = AvARRAY(c->array);
    c->array_flags = SvFLAGS(c->array);
    c->array_fill  = AvFILLp(c->array);

    /* Magical array. Realise it temporarily. */
    if (SvRMAGICAL(c->array)) {
        c->copy = (SV**) malloc (c->len * sizeof *(c->copy));
        for (x = 0; x < c->len; x++) {
            SV **svp = av_fetch(c->array, x, FALSE);
            c->copy[x] = (svp) ? SvREFCNT_inc(*svp) : &PL_sv_undef;
        }
        SvRMAGICAL_off(c->array);
        AvARRAY_set(c->array, c->copy);
        AvFILLp(c->array) = c->len - 1;
    } else {
        c->copy = 0;
    }
    
    SvREADONLY_on(c->array); /* Can't change the array during permute */ 
    
    /* Allocate memory for the engine to scribble on */   
    c->tmparea = (SV***) malloc((c->len + 1) * sizeof *(c->tmparea));
    for (x = c->len; x >= 0; x--)
        c->tmparea[x]  = malloc(c->len * sizeof **(c->tmparea));
    
    {
        dMULTICALL;
        PUSH_MULTICALL(callback);
        SAVEDESTRUCTOR(afp_destructor, c);
        permute_engine(c->array, AvARRAY(c->array), 0, c->len, 
            c->tmparea, multicall_cop);
        POP_MULTICALL;
    }
}