OP * clone_op(pTHX_
const OP * const o,
const unsigned int paramcount)
{
OP * clone = NULL;
if (o->op_type == OP_LEAVESUB)
return clone_op(cUNOPo->op_first, paramcount);
else if (o->op_flags & OPf_KIDS) {
OP *kid = cUNOPo->op_first;
OP *first = NULL;
OP *last = NULL;
do {
OP * child = clone_op(kid, paramcount);
if (!child) continue;
clone = op_append_elem(o->op_type, clone, child);
} while (kid = kid->op_sibling);
return clone;
} else switch (o->op_type) {
case OP_CONST:
return newSVOP(o->op_type, 0, cSVOPo_sv);
case OP_PUSHMARK:
return newOP(o->op_type, 0);
case OP_NEXTSTATE:
return newSTATEOP((U8)o->op_flags, NULL, NULL);
case OP_NULL:
return NULL;
default:
croak("Unsupported op type: %s", PL_op_name[o->op_type]);
}
}
static OP *parser_callback(pTHX_ GV *namegv, SV *psobj, U32 *flagsp) {
dSP;
SV *args_generator;
SV *statement = NULL;
I32 count;
/* call the parser callback
* it should take no arguments and return a coderef which, when called,
* produces the arguments to the keyword function
* the optree we want to generate is for something like
* mykeyword($code->())
* where $code is the thing returned by the parser function
*/
PUSHMARK(SP);
mXPUSHp(GvNAME(namegv), GvNAMELEN(namegv));
PUTBACK;
count = call_sv(psobj, G_ARRAY);
SPAGAIN;
if (count > 1) {
statement = POPs;
}
args_generator = SvREFCNT_inc(POPs);
PUTBACK;
if (!SvROK(args_generator) || SvTYPE(SvRV(args_generator)) != SVt_PVCV) {
croak("The parser function for %s must return a coderef, not %"SVf,
GvNAME(namegv), args_generator);
}
if (SvTRUE(statement)) {
*flagsp |= CALLPARSER_STATEMENT;
}
return newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, newSVOP(OP_CONST, 0, args_generator)));
}
