The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#include "xslate.h"

#define TXBM_DECL(name) void name \
    (pTHX_ tx_state_t* const st PERL_UNUSED_DECL, SV* const retval, SV* const method PERL_UNUSED_DECL, SV** MARK)

/* tx_bm _ TYPE _ MONIKER */
#define TXBM_NAME(t, n) CAT2( CAT2(tx_bm, _), CAT2(t, CAT2(_, n)))
#define TXBM(t, moniker) static TXBM_DECL( TXBM_NAME(t, moniker))

#define TXBM_SETUP(t, name, nargs_min, nargs_max) \
    { STRINGIFY(t) "::" STRINGIFY(name), TXBM_NAME(t, name), nargs_min, nargs_max }

typedef struct {
    const char* const name;

    TXBM_DECL( (*body) );

    U8 nargs_min;
    U8 nargs_max;
} tx_builtin_method_t;

#define MY_CXT_KEY "Text::Xslate::Methods::_guts" XS_VERSION
typedef struct {
    tx_state_t* cmparg_st;
    SV*         cmparg_proc;

    HV* pair_stash;
} my_cxt_t;
START_MY_CXT;

static SV*
tx_make_pair(pTHX_ HV* const stash, SV* const key, SV* const val) {
    AV* av;
    SV* pair[2];
    pair[0] = key;
    pair[1] = val;

    av = av_make(2, pair);
    return sv_bless( sv_2mortal( newRV_noinc((SV*)av) ), stash );
}

static I32
tx_pair_cmp(pTHX_ SV* const a, SV* const b) {
    assert(SvROK(a));
    assert(SvTYPE(SvRV(a)) == SVt_PVAV);
    assert(SvROK(b));
    assert(SvTYPE(SvRV(b)) == SVt_PVAV);

    return sv_cmp(
        *av_fetch((AV*)SvRV(a), 0, TRUE),
        *av_fetch((AV*)SvRV(b), 0, TRUE)
    );
}

static SV*
tx_keys(pTHX_ SV* const hvref) {
    HV* const hv    = (HV*)SvRV(hvref);
    AV* const av    = newAV();
    SV* const avref = sv_2mortal(newRV_noinc((SV*)av));
    HE* he;
    I32 i;

    assert(SvROK(hvref));
    assert(SvTYPE(hv) == SVt_PVHV);

    if(HvKEYS(hv) > 0) {
        av_extend(av, HvKEYS(hv) - 1);
    }

    hv_iterinit(hv);
    i = 0;
    while((he = hv_iternext(hv))) {
        SV* const key = hv_iterkeysv(he);
        (void)av_store(av, i++, key);
        SvREFCNT_inc_simple_void_NN(key);
    }
    sortsv(AvARRAY(av), i, Perl_sv_cmp);
    return avref;
}

/* NIL */

/* SCALAR */

/* ARRAY */

TXBM(array, size) {
    sv_setiv(retval, av_len((AV*)SvRV(*MARK)) + 1);
}

TXBM(array, join) {
    dSP;
    AV* const av     = (AV*)SvRV(*MARK);
    I32 const len    = av_len(av) + 1;
    I32 i;

    EXTEND(SP, len);
    for(i = 0; i < len; i++) {
        SV** const svp = av_fetch(av, i, FALSE);
        PUSHs(svp ? *svp : &PL_sv_undef);
    }
    /* don't do PUTBACK */

    MARK++;
    sv_setpvs(retval, "");
    do_join(retval, *MARK, MARK, SP);
}

TXBM(array, reverse) {
    AV* const av        = (AV*)SvRV(*MARK);
    I32 const len       = av_len(av) + 1;
    AV* const result    = newAV();
    SV* const resultref = sv_2mortal(newRV_noinc((SV*)result));
    I32 i;

    av_fill(result, len - 1);
    for(i = 0; i < len; i++) {
        SV** const svp = av_fetch(av, i, FALSE);
        (void)av_store(result, -(i+1), newSVsv(svp ? *svp : &PL_sv_undef));
    }

    sv_setsv(retval, resultref);
}

static I32
tx_sv_cmp(pTHX_ SV* const x, SV* const y) {
    dMY_CXT;
    dSP;
    tx_state_t* const st = MY_CXT.cmparg_st;
    SV* const proc       = MY_CXT.cmparg_proc;
    SV* result;

    assert(st);
    assert(proc);

    PUSHMARK(SP);
    /* no need to extend SP because of the args of the method (sort) is >= 2 */
    PUSHs(x);
    PUSHs(y);
    PUTBACK;
    result = tx_unmark_raw(aTHX_ tx_proccall(aTHX_ st, proc, "sort callback"));
    return SvIV(result);
}

static SVCOMPARE_t
tx_prepare_compare_func(pTHX_ tx_state_t* const st, I32 const items, SV** const MARK) {
    assert(items == 0 || items == 1);
    if(items == 0) {
        return Perl_sv_cmp;
    }
    else {
        dMY_CXT;
        SAVEVPTR(MY_CXT.cmparg_st);
        SAVESPTR(MY_CXT.cmparg_proc);

        MY_CXT.cmparg_st   = st;
        MY_CXT.cmparg_proc = *(MARK + 1);
        return tx_sv_cmp;
    }
}

TXBM(array, sort) {
    dSP;
    I32 const items     = SP - MARK;
    AV* const av        = (AV*)SvRV(*MARK);
    I32 const len       = av_len(av) + 1;
    AV* const result    = newAV();
    SV* const resultref = newRV_noinc((SV*)result);
    SVCOMPARE_t cmpfunc;
    I32 i;

    ENTER;
    SAVETMPS;
    sv_2mortal(resultref);

    cmpfunc = tx_prepare_compare_func(aTHX_ st, items, MARK);

    av_extend(result, len - 1);
    for(i = 0; i < len; i++) {
        SV** const svp = av_fetch(av, i, FALSE);
        (void)av_store(result, i, newSVsv(svp ? *svp : &PL_sv_undef));
    }
    sortsv(AvARRAY(result), len, cmpfunc);

    sv_setsv(retval, resultref);

    FREETMPS;
    LEAVE;
}

TXBM(array, map) {
    AV* const av        = (AV*)SvRV(*MARK);
    SV* const proc      = *(++MARK);
    I32 const len       = av_len(av) + 1;
    AV* const result    = newAV();
    SV* const resultref = newRV_noinc((SV*)result);
    I32 i;

    ENTER;
    SAVETMPS;
    sv_2mortal(resultref);
    av_extend(result, len - 1);
    for(i = 0; i < len; i++) {
        dSP;
        SV** const svp = av_fetch(av, i, FALSE);
        SV* sv;

        PUSHMARK(SP);
        /* no need to extend SP because of the args of the method is > 0 */
        PUSHs(svp ? *svp : &PL_sv_undef);
        PUTBACK;
        sv = tx_proccall(aTHX_ st, proc, "map callback");
        (void)av_store(result, i, newSVsv(sv));
    }
    /* setting retval must be here because retval is actually st->targ */
    sv_setsv(retval, resultref);
    FREETMPS;
    LEAVE;
}

TXBM(array, reduce) {
    AV* const av        = (AV*)SvRV(*MARK);
    SV* const proc      = *(++MARK);
    I32 const len       = av_len(av) + 1;
    SV** svp;
    SV* a;
    I32 i;

    if(len < 2) {
        svp = av_fetch(av, 0, FALSE);
        sv_setsv(retval, svp ? *svp : NULL);
        return;
    }

    ENTER;
    SAVETMPS;
    svp = av_fetch(av, 0, FALSE);
    a = svp ? *svp : &PL_sv_undef;

    for(i = 1; i < len; i++) {
        dSP;
        SV* b;
        svp = av_fetch(av, i, FALSE);
        b   = svp ? *svp : &PL_sv_undef;

        PUSHMARK(SP);
        PUSHs(a);
        PUSHs(b);
        PUTBACK;
        a = tx_proccall(aTHX_ st, proc, "reduce callback");
    }
    /* setting retval must be here because retval is actually st->targ */
    sv_setsv(retval, a);
    FREETMPS;
    LEAVE;
}

TXBM(array, merge) {
    AV* const av        = (AV*)SvRV(*MARK);
    SV* const value     = *(++MARK);
    I32 const len       = av_len(av) + 1;
    AV* const result    = newAV();
    SV* const resultref = newRV_noinc((SV*)result);
    AV* m = NULL;
    I32 mlen;
    I32 i;

    ENTER;
    SAVETMPS;
    sv_2mortal(resultref);

    if(tx_sv_is_array_ref(aTHX_ value)) {
        m    = (AV*)SvRV(value);
        mlen = av_len(m) + 1;
    }
    else {
        mlen = 1;
    }
    av_extend(result, len + mlen - 1);

    /* copy */
    for(i = 0; i < len; i++) {
        SV** const svp = av_fetch(av, i, FALSE);
        SV* const sv   = svp ? *svp : &PL_sv_undef;
        (void)av_store(result, i, newSVsv(sv));
    }
    /* merge */
    if(m) {
        for(i = 0; i < mlen; i++) {
            SV** const svp = av_fetch(m, i, FALSE);
            SV* const sv   = svp ? *svp : &PL_sv_undef;
            av_push(result, newSVsv(sv));
        }
    }
    else {
        av_push(result, newSVsv(value));
    }

    /* setting retval must be here because retval is actually st->targ */
    sv_setsv(retval, resultref);
    FREETMPS;
    LEAVE;
}

/* HASH */

TXBM(hash, size) {
    HV* const hv = (HV*)SvRV(*MARK);
    IV i = 0;
    hv_iterinit(hv);
    while(hv_iternext(hv)) {
        i++;
    }
    sv_setiv(retval, i);
}

TXBM(hash, keys) {
    sv_setsv(retval, tx_keys(aTHX_ *MARK));
}

TXBM(hash, values) {
    SV* const avref = tx_keys(aTHX_ *MARK);
    HV* const hv    = (HV*)SvRV(*MARK);
    AV* const av    = (AV*)SvRV(avref);
    I32 const len   = AvFILLp(av) + 1;
    I32 i;

    /* replace keys with values */
    /* map { $hv->{$_} } @{$keys} */
    for(i = 0; i < len; i++) {
        SV* const key = AvARRAY(av)[i];
        HE* const he  = hv_fetch_ent(hv, key, TRUE, 0U);
        SV* const val = hv_iterval(hv, he);
        SvREFCNT_dec(key);
        AvARRAY(av)[i] = newSVsv(val);
    }

    sv_setsv(retval, avref);
}

TXBM(hash, kv) {
    dMY_CXT;
    SV* const hvref = *MARK;
    HV* const hv    = (HV*)SvRV(hvref);
    AV* const av    = newAV();
    SV* const avref = newRV_noinc((SV*)av);
    HE* he;
    I32 i;

    ENTER;
    SAVETMPS;
    sv_2mortal(avref);

    if(HvKEYS(hv) > 0) {
        av_extend(av, HvKEYS(hv) - 1);
    }

    hv_iterinit(hv);
    i = 0;
    while((he = hv_iternext(hv))) {
        SV* const pair = tx_make_pair(aTHX_ MY_CXT.pair_stash,
            hv_iterkeysv(he),
            hv_iterval(hv, he));

        (void)av_store(av, i++, pair);
        SvREFCNT_inc_simple_void_NN(pair);
    }
    sortsv(AvARRAY(av), i, tx_pair_cmp);
    sv_setsv(retval, avref);

    FREETMPS;
    LEAVE;
}

TXBM(hash, merge) {
    sv_setsv(retval, tx_merge_hash(aTHX_ st, *MARK, *(MARK + 1)));
}

static const tx_builtin_method_t tx_builtin_method[] = {
    TXBM_SETUP(array,  size,    0, 0),
    TXBM_SETUP(array,  join,    1, 1),
    TXBM_SETUP(array,  reverse, 0, 0),
    TXBM_SETUP(array,  sort,    0, 1), /* can take a compare function */
    TXBM_SETUP(array,  map,     1, 1),
    TXBM_SETUP(array,  reduce,  1, 1),
    TXBM_SETUP(array,  merge,   1, 1),

    TXBM_SETUP(hash,   size,    0, 0),
    TXBM_SETUP(hash,   keys,    0, 0), /* TODO: can take a compare function */
    TXBM_SETUP(hash,   values,  0, 0), /* TODO: can take a compare function */
    TXBM_SETUP(hash,   kv,      0, 0), /* TODO: can take a compare function */
    TXBM_SETUP(hash,   merge,   1, 1),
};

static const size_t tx_num_builtin_method
    = sizeof(tx_builtin_method) / sizeof(tx_builtin_method[0]);

SV*
tx_methodcall(pTHX_ tx_state_t* const st, SV* const method) {
    /* PUSHMARK must be done */
    dSP;
    dMARK;
    dORIGMARK;
    SV* const invocant = *(++MARK);
    const char* type_name;
    SV* fq_name;
    HE* he;
    SV* retval;

    if(sv_isobject(invocant)) {
        PUSHMARK(ORIGMARK); /* re-pushmark */
        return tx_call_sv(aTHX_ st, method, G_METHOD, "method call");
    }

    retval = NULL;
    if(SvROK(invocant)) {
        SV* const referent = SvRV(invocant);
        if(SvTYPE(referent) == SVt_PVAV) {
            type_name = "array::";
        }
        else if(SvTYPE(referent) == SVt_PVHV) {
            type_name = "hash::";
        }
        else {
            type_name = "scalar::";
        }
    }
    else {
        if(SvOK(invocant)) {
            type_name = "scalar::";
        }
        else {
            type_name = "nil::";
        }
    }

    /* make type::method */
    fq_name = st->targ;
    sv_setpv(fq_name, type_name);
    sv_catsv(fq_name, method);

    he = hv_fetch_ent(st->symbol, fq_name, FALSE, 0U);
    if(he) {
        SV* const entity = HeVAL(he);

        if(SvIOK(entity)) {
            I32 const items = SP - MARK;
            const tx_builtin_method_t* bm;

            if(SvUVX(entity) >= tx_num_builtin_method) {
                croak("Oops: Builtin method index of %"SVf" is out of range",
                    fq_name);
            }

            bm = &tx_builtin_method[SvUVX(entity)];

            if(!(items >= bm->nargs_min && items <= bm->nargs_max)) {
                tx_error(aTHX_ st, "Wrong number of arguments for %"SVf,
                    method);
                goto finish;
            }

            retval = st->targ;
            bm->body(aTHX_ st, retval, method, MARK);
            goto finish;
        }
        else { /* user defined methods */
            PUSHMARK(ORIGMARK); /* re-pushmark */
            return tx_proccall(aTHX_ st, entity, "method call");
        }
    }
    if(!SvOK(invocant)) {
        tx_warn(aTHX_ st, "Use of nil to invoke method %"SVf, method);
        goto finish;
    }
    tx_error(aTHX_ st, "Undefined method %"SVf" called for %s", method,
        tx_neat(aTHX_ invocant));

    finish:
    SP = ORIGMARK;
    PUTBACK;
    return retval ? retval : &PL_sv_undef;
}

void
tx_register_builtin_methods(pTHX_ HV* const hv) {
    U32 i;
    assert(hv);
    for(i = 0; i < tx_num_builtin_method; i++) {
        const tx_builtin_method_t* const bm = &tx_builtin_method[i];
        SV* const sv = *hv_fetch(hv, bm->name, strlen(bm->name), TRUE);

        if(!SvOK(sv)) { /* users can override it */
            TAINT_NOT;
            sv_setiv(sv, i);
        }
    }
}

MODULE = Text::Xslate::Methods    PACKAGE = Text::Xslate::Type::Pair

PROTOTYPES:   DISABLE
VERSIONCHECK: DISABLE

BOOT:
{
    MY_CXT_INIT;
    MY_CXT.pair_stash = gv_stashpvs(TX_PAIR_CLASS, GV_ADDMULTI);
}

#ifdef USE_ITHREADS

void
CLONE(...)
CODE:
{
    MY_CXT_CLONE;
    MY_CXT.pair_stash = gv_stashpvs(TX_PAIR_CLASS, GV_ADDMULTI);
    PERL_UNUSED_VAR(items);
}

#endif

void
key(AV* pair)
ALIAS:
    key   = 0
    value = 1
CODE:
{
    ST(0) = *av_fetch(pair, ix, TRUE);
}