view release on metacpan or  search on metacpan

Custom.xs  view on Meta::CPAN

    }

    modes = (call_sv ? 1 : 0) + (binop_sv ? 1 : 0) + (build_sv ? 1 : 0);
    if (modes == 0)
        croak("Infix::Custom: give one of 'call', 'binop' or 'build_op'");
    if (modes > 1)
        croak("Infix::Custom: give only one of 'call', 'binop' or 'build_op'");

    prec = ic_prec_value(prec_sv ? SvPV_nolen(prec_sv) : "low");
    if (prec < 0)
        croak("Infix::Custom: unknown prec '%s' (low logical_or_low "
              "logical_and_low assign logical_or logical_and rel add mul pow "
              "high)", prec_sv ? SvPV_nolen(prec_sv) : "low");

    if (method && !call_sv)
        croak("Infix::Custom: 'method' requires 'call'");

    if (call_sv) {
        CV *cv;
        if (SvROK(call_sv) && SvTYPE(SvRV(call_sv)) == SVt_PVCV)
            cv = (CV *)SvRV(call_sv);
        else                                    /* a sub name */
            cv = get_cv(SvPV_nolen(call_sv), 0);
        if (!cv)
            croak("Infix::Custom: 'call' is not a sub or CODE reference");
        if (method)
            /* RHS is a bareword method name, captured by the parse stage. */
            id = ic_register(aTHX_ op_sv, prec, cv, OP_NULL,
                             ic_build_method, ic_parse_ident);
        else
            id = ic_register(aTHX_ op_sv, prec, cv, OP_NULL,
                             ic_build_call, NULL);
    }
    else if (binop_sv) {
        OPCODE ot = ic_opcode(SvPV_nolen(binop_sv));
        if (ot == OP_NULL)
            croak("Infix::Custom: unknown binop '%s'", SvPV_nolen(binop_sv));
        id = ic_register(aTHX_ op_sv, prec, NULL, ot, ic_build_binop, NULL);
    }
    else {
        ic_build_fn fn = INT2PTR(ic_build_fn, SvIV(build_sv));
        if (!fn)
            croak("Infix::Custom: 'build_op' must be a non-null function pointer");
        id = ic_register(aTHX_ op_sv, prec, NULL, OP_NULL, fn, NULL);
    }

    ic_set_hint(aTHX_ op_sv, id);
}

#endif /* IC_HAVE_INFIX */

MODULE = Infix::Custom        PACKAGE = Infix::Custom

BOOT:
#ifdef IC_HAVE_INFIX
    wrap_infix_plugin(ic_infix_plugin, &ic_next_infix_plugin);
#endif

void
import(...)
PPCODE:
#ifdef IC_HAVE_INFIX
    ic_do_import(aTHX_ ax, items);
    XSRETURN_EMPTY;
#else
{
    static int warned = 0;
    PERL_UNUSED_VAR(ax);
    if (items > 1 && !warned) {
        warned = 1;
        warn("Infix::Custom: custom infix operators require perl 5.38+; "
             "declarations are inert on this perl (%s)\n", "<5.38");
    }
    XSRETURN_EMPTY;
}
#endif

void
unimport(...)
PPCODE:
#ifdef IC_HAVE_INFIX
{
    I32 i;
    if (items <= 1)
        ic_del_all_hints(aTHX);
    else
        for (i = 1; i < items; i++)
            ic_del_hint(aTHX_ ST(i));
    XSRETURN_EMPTY;
}
#else
    PERL_UNUSED_VAR(ax);
    XSRETURN_EMPTY;
#endif

IV
_sample_build_op()
CODE:
#ifdef IC_HAVE_INFIX
    RETVAL = PTR2IV(ic_sample_build);
#else
    RETVAL = 0;
#endif
OUTPUT:
    RETVAL