File Coverage

lib/List/Keywords.xs

Criterion	Covered	Total	%
statement	361	374	96.5
branch	174	256	67.9
condition			n/a
subroutine			n/a
pod			n/a
total	535	630	84.9

/*  You may distribute under the terms of either the GNU General Public License
 *  or the Artistic License (the same terms as Perl itself)
 *
 *  (C) Paul Evans, 2021-2023 -- [e-mail]
 */
#define PERL_NO_GET_CONTEXT
/* needed on latest perl to get optimize_optree/finalize_optree */
#define PERL_USE_VOLATILE_API

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "XSParseKeyword.h"

#include "perl-backcompat.c.inc"
#include "op_sibling_splice.c.inc"

#ifndef optimize_optree
#  if HAVE_PERL_VERSION(5,28,0)
#    define optimize_optree(op)  Perl_optimize_optree(aTHX_ op)
#  else
#    define optimize_optree(op)
#  endif
#endif

#ifndef finalize_optree
#  if HAVE_PERL_VERSION(5,16,0)
#    define finalize_optree(op)  Perl_finalize_optree(aTHX_ op)
#  else
#    define finalize_optree(op)
#  endif
#endif

#if HAVE_PERL_VERSION(5,28,0)
#  define XPUSHzero  XPUSHs(&PL_sv_zero)
#else
   /* perls before 5.28 do not have PL_sv_zero */
#  define XPUSHzero  mXPUSHi(0)
#endif

/* We can't newLOGOP because that will force scalar context */
#define allocLOGOP_CUSTOM(func, flags, first, other)  MY_allocLOGOP_CUSTOM(aTHX_ func, flags, first, other)
static LOGOP *MY_allocLOGOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP *other)
{
  LOGOP *logop;
  NewOp(1101, logop, 1, LOGOP);

  logop->op_type = OP_CUSTOM;
  logop->op_ppaddr = func;
  logop->op_flags = OPf_KIDS | (U8)(flags);
  logop->op_first = first;
  logop->op_other = other;

  return logop;
}

static OP *build_blocklist(pTHX_ PADOFFSET varix, OP *block, OP *list,
  OP *(*pp_start)(pTHX), OP *(*pp_while)(pTHX), U8 op_private)
{
  /* Follow the same optree shape as grep:
   *   LOGOP whileop
   *     LISTOP startop
   *       NULOP pushmark
   *       UNOP null
   *         {block scope goes here}
   *       ... {list values go here}
   *
   * the null op protects the block body from being executed initially,
   * allowing it to be deferred
   * whileop's ->op_other points at the start of the block
   */

  /* Link block in execution order and remember its start */
  OP *blockstart = LINKLIST(block);

  /* Hide the block inside an OP_NULL with no execution */
  block = newUNOP(OP_NULL, 0, block);
  block->op_next = block;

  /* Make startop op as the list with (shielded) block prepended */
  OP *startop = list;
  if(startop->op_type != OP_LIST)
    startop = newLISTOP(OP_LIST, 0, startop, NULL);
  op_sibling_splice(startop, cLISTOPx(startop)->op_first, 0, block);
  startop->op_type = OP_CUSTOM;
  startop->op_ppaddr = pp_start;
  startop->op_targ = varix;

  LOGOP *whileop = allocLOGOP_CUSTOM(pp_while, 0, startop, blockstart);
  whileop->op_private = startop->op_private = op_private;
  whileop->op_targ = varix;

  OpLASTSIB_set(startop, (OP *)whileop);

  /* Temporarily set the whileop's op_next to NULL so as not to confuse
   * a custom RPEEP that might be set. We'll store the real start value in
   * there afterwards. See also
   *   https://rt.cpan.org/Ticket/Display.html?id=142471
   */
  OP *whilestart = LINKLIST(startop);
  whileop->op_next = NULL;
  startop->op_next = (OP *)whileop;
  cUNOPx(block)->op_first->op_next = (OP *)whileop;

  /* Since the body of the block is now hidden from the peephole optimizer
   * we'll have to run that manually now */
  optimize_optree(block);
  PL_rpeepp(aTHX_ blockstart);
  finalize_optree(block);

  whileop->op_next = whilestart;
  return (OP *)whileop;
}

/* The same ppfuncs that implement `first` can also do `any` and `all` with
 * minor changes of behaviour
 */
enum {
  FIRST_EMPTY_NO      = (1<<0), /* \  */
  FIRST_EMPTY_YES     = (1<<1), /* - if neither, returns undef */
  FIRST_RET_NO        = (1<<2), /* \  */
  FIRST_RET_YES       = (1<<3), /* - if neither, returns $_ itself */
  FIRST_STOP_ON_FALSE = (1<<4),
};

static XOP xop_firststart;
static XOP xop_firstwhile;

static OP *pp_firststart(pTHX)
{
  /* Insired by perl core's pp_grepstart() */
  dSP;
  PADOFFSET targ = PL_op->op_targ;

  if(PL_stack_base + TOPMARK == SP) {
    /* Empty */
    U8 mode = PL_op->op_private;
    (void)POPMARK;
    XPUSHs((mode & FIRST_EMPTY_NO ) ? &PL_sv_no :
           (mode & FIRST_EMPTY_YES) ? &PL_sv_yes :
                                      &PL_sv_undef);
    RETURNOP(PL_op->op_next->op_next);
  }

  PL_stack_sp = PL_stack_base + TOPMARK + 1;
  PUSHMARK(PL_stack_sp); /* current src item */

  ENTER_with_name("first");

  SV *src = PL_stack_base[TOPMARK];

  if(SvPADTMP(src)) {
    src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
    PL_tmps_floor++;
  }
  SvTEMP_off(src);

  if(targ) {
    SV **padentry = &PAD_SVl(targ);
    save_sptr(padentry);
    *padentry = SvREFCNT_inc(src);
  }
  else {
    SAVE_DEFSV;
    DEFSV_set(src);
  }

  PUTBACK;

  /* Jump to body of block */
  return (cLOGOPx(PL_op->op_next))->op_other;
}

static OP *pp_firstwhile(pTHX)
{
  /* Inspired by perl core's pp_grepwhile() */
  dSP;
  dPOPss;
  U8 mode = PL_op->op_private;
  PADOFFSET targ = PL_op->op_targ;
  SV *targsv = targ ? PAD_SVl(targ) : DEFSV;

  bool ret = SvTRUE_NN(sv);

  (*PL_markstack_ptr)++;

  if((mode & FIRST_STOP_ON_FALSE) ? !ret : ret) {
    /* Stop */

    /* Technically this means that `first` will not necessarily return the
     * value from the list, but instead returns whatever the var was set to
     * after the block has run; differing if the block modified it.
     * I'm unsure how I feel about this, but both `CORE::grep` and
     * `List::Util::first` do the same thing, so we are in good company
     */
    SV *ret = (mode & FIRST_RET_NO ) ? &PL_sv_no :
              (mode & FIRST_RET_YES) ? &PL_sv_yes :
                                       SvREFCNT_inc(targsv);
    if(targ)
      SvREFCNT_dec(targsv);

    LEAVE_with_name("first");
    (void)POPMARK;
    SP = PL_stack_base + POPMARK;
    PUSHs(ret);
    RETURN;
  }

  if(UNLIKELY(PL_stack_base + *PL_markstack_ptr > SP)) {
    /* Empty */
    LEAVE_with_name("first");
    (void)POPMARK;
    SP = PL_stack_base + POPMARK;
    PUSHs((mode & FIRST_EMPTY_NO ) ? &PL_sv_no :
          (mode & FIRST_EMPTY_YES) ? &PL_sv_yes :
                                     &PL_sv_undef);
    RETURN;
  }

  SV *src = PL_stack_base[TOPMARK];

  if(SvPADTMP(src)) {
    src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
    PL_tmps_floor++;
  }
  SvTEMP_off(src);

  if(targ) {
    SV **padentry = &PAD_SVl(targ);
    SvREFCNT_dec(*padentry);
    *padentry = SvREFCNT_inc(src);
  }
  else
    DEFSV_set(src);

  PUTBACK;

  return cLOGOP->op_other;
}

static int build_first(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata)
{
  size_t argi = 0;
  PADOFFSET varix = 0;

  bool has_optvar = args[argi++]->i;
  if(has_optvar) {
    varix = args[argi++]->padix;
  }

  OP *block = op_contextualize(op_scope(args[argi++]->op), G_SCALAR);
  OP *list  = args[argi++]->op;

  *out = build_blocklist(aTHX_ varix, block, list,
    &pp_firststart, &pp_firstwhile, SvIV((SV *)hookdata));
  return KEYWORD_PLUGIN_EXPR;
}

static const struct XSParseKeywordPieceType pieces_optvar_blocklist[] = {
  XPK_PREFIXED_BLOCK(
    XPK_OPTIONAL(XPK_KEYWORD("my"), XPK_LEXVAR_MY(XPK_LEXVAR_SCALAR))
  ),
  XPK_LISTEXPR_LISTCTX,
  {0},
};

static const struct XSParseKeywordHooks hooks_first = {
  .permit_hintkey = "List::Keywords/first",

  .pieces = pieces_optvar_blocklist,
  .build = &build_first,
};

static const struct XSParseKeywordHooks hooks_any = {
  .permit_hintkey = "List::Keywords/any",
  .pieces = pieces_optvar_blocklist,
  .build = &build_first,
};

static const struct XSParseKeywordHooks hooks_all = {
  .permit_hintkey = "List::Keywords/all",
  .pieces = pieces_optvar_blocklist,
  .build = &build_first,
};

static const struct XSParseKeywordHooks hooks_none = {
  .permit_hintkey = "List::Keywords/none",
  .pieces = pieces_optvar_blocklist,
  .build = &build_first,
};

static const struct XSParseKeywordHooks hooks_notall = {
  .permit_hintkey = "List::Keywords/notall",
  .pieces = pieces_optvar_blocklist,
  .build = &build_first,
};

static XOP xop_reducestart;
static XOP xop_reducewhile;

enum {
  REDUCE_REDUCE,
  REDUCE_REDUCTIONS,
};

static OP *pp_reducestart(pTHX)
{
  dSP;
  U8 mode = PL_op->op_private;

  if(PL_stack_base + TOPMARK == SP) {
    /* Empty */
    (void)POPMARK;
    if(GIMME_V == G_SCALAR)
      XPUSHs(&PL_sv_undef);
    RETURNOP(PL_op->op_next->op_next);
  }

  if(PL_stack_base + TOPMARK + 1 == SP) {
    /* Single item */
    (void)POPMARK;
    /* Leave the singleton there it will be fine */
    RETURNOP(PL_op->op_next->op_next);
  }

  PL_stack_sp = PL_stack_base + TOPMARK + 1;
  if(mode == REDUCE_REDUCTIONS)
    PUSHMARK(PL_stack_sp);
  PUSHMARK(PL_stack_sp);

  ENTER_with_name("reduce");

  GV *firstgv  = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
  GV *secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);

  save_gp(firstgv, 0); save_gp(secondgv, 0);
  GvINTRO_off(firstgv); GvINTRO_off(secondgv);
  SAVEGENERICSV(GvSV(firstgv)); SAVEGENERICSV(GvSV(secondgv));
  SvREFCNT_inc(GvSV(firstgv)); SvREFCNT_inc(GvSV(secondgv));

  /* Initial accumulator */
  SV *sv = PL_stack_base[TOPMARK];

  if(mode == REDUCE_REDUCTIONS)
    PL_stack_base[PL_markstack_ptr[-1]++] = sv_mortalcopy(sv);

  if(SvPADTMP(sv)) {
    sv = PL_stack_base[TOPMARK] = sv_mortalcopy(sv);
    PL_tmps_floor++;
  }
  SvTEMP_off(sv);
  GvSV(firstgv) = SvREFCNT_inc(sv);

  (*PL_markstack_ptr)++;

  /* value */
  sv = PL_stack_base[TOPMARK];

  if(SvPADTMP(sv)) {
    sv = PL_stack_base[TOPMARK] = sv_mortalcopy(sv);
    PL_tmps_floor++;
  }
  SvTEMP_off(sv);
  GvSV(secondgv) = SvREFCNT_inc(sv);

  PUTBACK;

  /* Jump to body of block */
  return (cLOGOPx(PL_op->op_next))->op_other;
}

static OP *pp_reducewhile(pTHX)
{
  dSP;
  U8 mode = PL_op->op_private;
  dPOPss;

  if(mode == REDUCE_REDUCTIONS)
    PL_stack_base[PL_markstack_ptr[-1]++] = SvPADTMP(sv) ? sv_mortalcopy(sv) : sv;

  (*PL_markstack_ptr)++;

  if(UNLIKELY(PL_stack_base + *PL_markstack_ptr > SP)) {
    U8 gimme = GIMME_V;
    LEAVE_with_name("reduce");

    if(mode == REDUCE_REDUCTIONS) {
      (void)POPMARK;
      I32 retcount = --*PL_markstack_ptr - PL_markstack_ptr[-1];
      (void)POPMARK;
      SP = PL_stack_base + POPMARK;
      if(gimme == G_SCALAR) {
        SP[1] = SP[retcount];
        SP += 1;
      }
      else if(gimme == G_ARRAY)
        SP += retcount;
    }
    else {
      (void)POPMARK;
      SP = PL_stack_base + POPMARK;
      PUSHs(SvREFCNT_inc(sv));
    }
    RETURN;
  }

  GV *firstgv  = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
  GV *secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);

  SvREFCNT_dec(GvSV(firstgv));
  GvSV(firstgv) = SvREFCNT_inc(sv);

  /* next value */
  sv = PL_stack_base[TOPMARK];

  if(SvPADTMP(sv)) {
    sv = PL_stack_base[TOPMARK] = sv_mortalcopy(sv);
    PL_tmps_floor++;
  }
  SvTEMP_off(sv);
  GvSV(secondgv) = SvREFCNT_inc(sv);

  PUTBACK;

  return cLOGOP->op_other;
}

static int build_reduce(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata)
{
#if !HAVE_PERL_VERSION(5,20,0)
  GV *firstgv  = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
  GV *secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);

  GvMULTI_on(firstgv);
  GvMULTI_on(secondgv);
#endif

  *out = build_blocklist(aTHX_ 0, args[0]->op, args[1]->op,
    &pp_reducestart, &pp_reducewhile, SvIV((SV *)hookdata));
  return KEYWORD_PLUGIN_EXPR;
}

static const struct XSParseKeywordPieceType pieces_blocklist[] = {
  XPK_BLOCK_SCALARCTX,
  XPK_LISTEXPR_LISTCTX,
  {0},
};

static const struct XSParseKeywordHooks hooks_reduce = {
  .permit_hintkey = "List::Keywords/reduce",

  .pieces = pieces_blocklist,
  .build = &build_reduce,
};

static const struct XSParseKeywordHooks hooks_reductions = {
  .permit_hintkey = "List::Keywords/reductions",

  .pieces = pieces_blocklist,
  .build = &build_reduce,
};

static XOP xop_ngrepstart;
static XOP xop_ngrepwhile;

/* During the operation of ngrep, the top two marks on the markstack keep
 * track of the input values and return values, respectively */
#define VALMARK  (PL_markstack_ptr[0])
#define RETMARK  (PL_markstack_ptr[-1])

static OP *pp_ngrepstart(pTHX)
{
  /* Inspired by perl core's pp_grepstart() */
  dSP;
  PADOFFSET targ = PL_op->op_targ;
  U8 targcount = PL_op->op_private;

  if(PL_stack_base + TOPMARK == SP) {
    /* Empty */
    (void)POPMARK;
    if(GIMME_V == G_SCALAR)
      XPUSHzero;
    RETURNOP(PL_op->op_next->op_next);
  }

  PL_stack_sp = PL_stack_base + TOPMARK + 1;
  PUSHMARK(PL_stack_sp);
  PUSHMARK(PL_stack_sp);

  ENTER_with_name("ngrep");

  for(U8 targi = 0; targi < targcount; targi++) {
    SV **svp = PL_stack_base + TOPMARK;
    SV *sv = svp <= SP ? *svp : &PL_sv_undef;
    if(SvPADTMP(sv)) {
      sv = PL_stack_base[TOPMARK] = sv_mortalcopy(sv);
      PL_tmps_floor++;
    }
    SvTEMP_off(sv);

    SV **padentry = &PAD_SVl(targ + targi);
    save_sptr(padentry);
    *padentry = SvREFCNT_inc(sv);

    VALMARK++;
  }

  PUTBACK;

  /* Jump to body of block */
  return (cLOGOPx(PL_op->op_next))->op_other;
}

static OP *pp_ngrepwhile(pTHX)
{
  dSP;
  PADOFFSET targ = PL_op->op_targ;
  U8 targcount = PL_op->op_private;
  dPOPss;

  if(SvTRUE_NN(sv)) {
    /* VALMARK has already been updated to point at next chunk;
     * we'll have to look backwards */
    SV **chunksvs = PL_stack_base + VALMARK - targcount;

    for(U8 targi = 0; targi < targcount; targi++) {
      if(chunksvs + targi > SP)
        break;

      PL_stack_base[RETMARK++] = chunksvs[targi];
    }
  }

  if(UNLIKELY(PL_stack_base + VALMARK > SP)) {
    U8 gimme = GIMME_V;
    I32 retcount = --RETMARK - PL_markstack_ptr[-2]; /* origmark */

    LEAVE_with_name("ngrep");

    (void)POPMARK;
    (void)POPMARK;
    SP = PL_stack_base + POPMARK;

    if(gimme == G_SCALAR) {
      /* No need to X this because we know we consumed at least one stack item */
      mPUSHi(retcount);
    }
    else if(gimme == G_LIST)
      SP += retcount;

    RETURN;
  }

  /* next round */

  for(U8 targi = 0; targi < targcount; targi++) {
    SV **svp = PL_stack_base + VALMARK;
    SV *sv = svp <= SP ? *svp : &PL_sv_undef;
    if(SvPADTMP(sv)) {
      sv = PL_stack_base[VALMARK] = sv_mortalcopy(sv);
      PL_tmps_floor++;
    }
    SvTEMP_off(sv);

    SV **padentry = &PAD_SVl(targ + targi);
    SvREFCNT_dec(*padentry);
    *padentry = SvREFCNT_inc(sv);

    VALMARK++;
  }

  PUTBACK;

  return cLOGOP->op_other;
}

#undef VALMARK
#undef RETMARK

static XOP xop_nmapstart;
static XOP xop_nmapwhile;

static OP *pp_nmapstart(pTHX)
{
  /* Inspired by perl core's pp_grepstart() */
  dSP;
  PADOFFSET targ = PL_op->op_targ;
  U8 targcount = PL_op->op_private;

  if(PL_stack_base + TOPMARK == SP) {
    /* Empty */
    (void)POPMARK;
    if(GIMME_V == G_SCALAR)
      XPUSHzero;
    RETURNOP(PL_op->op_next->op_next);
  }

  PL_stack_sp = PL_stack_base + TOPMARK + 1;
  PUSHMARK(PL_stack_sp);
  PUSHMARK(PL_stack_sp);

  ENTER_with_name("nmap");

  SAVETMPS;

  ENTER_with_name("nmap_item");

  for(U8 targi = 0; targi < targcount; targi++) {
    SV **svp = PL_stack_base + TOPMARK;
    SV *sv = svp <= SP ? *svp : &PL_sv_undef;
    if(SvPADTMP(sv)) {
      sv = PL_stack_base[TOPMARK] = sv_mortalcopy(sv);
      PL_tmps_floor++;
    }
    SvTEMP_off(sv);

    SV **padentry = &PAD_SVl(targ + targi);
    save_sptr(padentry);
    *padentry = SvREFCNT_inc(sv);

    (*PL_markstack_ptr)++;
  }

  PUTBACK;

  PUSHMARK(PL_stack_sp);

  /* Jump to body of block */
  return (cLOGOPx(PL_op->op_next))->op_other;
}

/* During the operation of ngrep_while, the top three marks on the markstack
 * keep track of the block result list, the input values, and the output
 * values, respectively */
#define BLOCKMARK  (PL_markstack_ptr[0])
#define VALMARK    (PL_markstack_ptr[-1])
#define RETMARK    (PL_markstack_ptr[-2])

static OP *pp_nmapwhile(pTHX)
{
  /* Inspired by perl core's pp_mapwhile() */
  dSP;
  U8 gimme = GIMME_V;
  PADOFFSET targ = PL_op->op_targ;
  U8 targcount = PL_op->op_private;

  I32 items = (SP - PL_stack_base) - BLOCKMARK;

  if(items && gimme != G_VOID) {
    if(items > (VALMARK - RETMARK)) {
      I32 shift = items - (VALMARK - RETMARK);
      I32 count = (SP - PL_stack_base) - (VALMARK - targcount);
      /* avoid needing to reshuffle the stack too often, even at the cost of
       * making holes in it */
      if(shift < count)
        shift = count;

      /* make a hole 'shift' SV*s wide */
      EXTEND(SP, shift);
      SV **src = SP;
      SV **dst = (SP += shift);
      VALMARK += shift;
      BLOCKMARK += shift;

      /* move the values up into it */
      while(count--)
        *(dst--) = *(src--);
    }

    SV **dst = PL_stack_base + (RETMARK += items) - 1;

    if(gimme == G_LIST) {
      EXTEND_MORTAL(items);
      I32 tmpsbase = PL_tmps_floor + 1;
      Move(PL_tmps_stack + tmpsbase, PL_tmps_stack + tmpsbase + items, PL_tmps_ix - PL_tmps_floor, SV *);
      PL_tmps_ix += items;

      I32 i = items;
      while(i-- > 0) {
        SV *sv = POPs;
        if(!SvTEMP(sv))
          sv = sv_mortalcopy(sv);
        *dst-- = sv;
        PL_tmps_stack[tmpsbase++] = SvREFCNT_inc_simple(sv);
      }
      PL_tmps_floor += items;
      FREETMPS;
      i = items;
      while(i-- > 0)
        SvTEMP_on(PL_tmps_stack[--tmpsbase]);
    }
    else {
      /* No point mortalcopying temporary values in scalar context */
      I32 i = items;
      while(i-- > 0) {
        (void)POPs;
        *dst-- = &PL_sv_undef;
      }
      FREETMPS;
    }
  }
  else {
    FREETMPS;
  }

  LEAVE_with_name("nmap_item");

  if(UNLIKELY(PL_stack_base + VALMARK > SP)) {
    I32 retcount = --RETMARK - PL_markstack_ptr[-3]; /* origmark */
    (void)POPMARK;
    LEAVE_with_name("nmap");

    (void)POPMARK;
    (void)POPMARK;
    SP = PL_stack_base + POPMARK;

    if(gimme == G_SCALAR) {
      /* No need to X this because we know we consumed at least one stack item */
      mPUSHi(retcount);
    }
    else if(gimme == G_LIST)
      SP += retcount;

    RETURN;
  }

  /* next round */

  ENTER_with_name("nmap_item");

  for(U8 targi = 0; targi < targcount; targi++) {
    SV **svp = PL_stack_base + VALMARK;
    SV *sv = svp <= SP ? *svp : &PL_sv_undef;
    if(SvPADTMP(sv)) {
      sv = PL_stack_base[VALMARK] = sv_mortalcopy(sv);
      PL_tmps_floor++;
    }
    SvTEMP_off(sv);

    SV **padentry = &PAD_SVl(targ + targi);
    SvREFCNT_dec(*padentry);
    *padentry = SvREFCNT_inc(sv);

    VALMARK++;
  }

  PUTBACK;

  return cLOGOP->op_other;
}

#undef BLOCKMARK
#undef VALMARK
#undef RETMARK

enum {
  NITER_NGREP,
  NITER_NMAP,
};

static int build_niter(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata)
{
  size_t argi = 0;
  int varcount = args[argi++]->i;

  /* It's very unlikely but lets just check */
  if(varcount > 255)
    croak("Using more than 255 lexical variables to an iterated block function is not currently supported");

  PADOFFSET varix = args[argi++]->padix;
  /* Because of how these vars were constructed, it really ought to be the
   * case that they have consequitive padix values. Lets just check to be sure
   */
  for(int vari = 1; vari < varcount; vari++)
    if(args[argi++]->padix != varix + vari)
      croak("ARGH: Expected consequitive padix for lexical variables");

  OP *block = op_scope(args[argi++]->op);
  OP *list  = args[argi++]->op;

  switch(SvIV((SV *)hookdata)) {
    case NITER_NGREP:
      block = op_contextualize(block, G_SCALAR);
      *out = build_blocklist(aTHX_ varix, block, list,
        &pp_ngrepstart, &pp_ngrepwhile, (U8)varcount);
      break;

    case NITER_NMAP:
      block = op_contextualize(block, G_LIST);
      *out = build_blocklist(aTHX_ varix, block, list,
        &pp_nmapstart, &pp_nmapwhile, (U8)varcount);
      break;
  }
  return KEYWORD_PLUGIN_EXPR;
}

static const struct XSParseKeywordHooks hooks_ngrep = {
  .permit_hintkey = "List::Keywords/ngrep",

  .pieces = (const struct XSParseKeywordPieceType []){
    XPK_PREFIXED_BLOCK(
      XPK_KEYWORD("my"),
      XPK_PARENS(XPK_COMMALIST(XPK_LEXVAR_MY(XPK_LEXVAR_SCALAR)))
    ),
    XPK_LISTEXPR_LISTCTX,
    {0},
  },
  .build = &build_niter,
};

static const struct XSParseKeywordHooks hooks_nmap = {
  .permit_hintkey = "List::Keywords/nmap",

  .pieces = (const struct XSParseKeywordPieceType []){
    XPK_PREFIXED_BLOCK(
      XPK_KEYWORD("my"),
      XPK_PARENS(XPK_COMMALIST(XPK_LEXVAR_MY(XPK_LEXVAR_SCALAR)))
    ),
    XPK_LISTEXPR_LISTCTX,
    {0},
  },
  .build = &build_niter,
};

MODULE = List::Keywords    PACKAGE = List::Keywords

BOOT:
  boot_xs_parse_keyword(0.35);

  register_xs_parse_keyword("first", &hooks_first, newSViv(0));

  /* Variations on first */
  register_xs_parse_keyword("any", &hooks_any,
    newSViv(FIRST_EMPTY_NO |FIRST_RET_YES));
  register_xs_parse_keyword("all", &hooks_all,
    newSViv(FIRST_EMPTY_YES|FIRST_RET_NO|FIRST_STOP_ON_FALSE));
  register_xs_parse_keyword("none", &hooks_none,
    newSViv(FIRST_EMPTY_YES|FIRST_RET_NO));
  register_xs_parse_keyword("notall", &hooks_notall,
    newSViv(FIRST_EMPTY_NO |FIRST_RET_YES|FIRST_STOP_ON_FALSE));

  XopENTRY_set(&xop_firststart, xop_name, "firststart");
  XopENTRY_set(&xop_firststart, xop_desc, "first");
  XopENTRY_set(&xop_firststart, xop_class, OA_LISTOP);
  Perl_custom_op_register(aTHX_ &pp_firststart, &xop_firststart);

  XopENTRY_set(&xop_firstwhile, xop_name, "firstwhile");
  XopENTRY_set(&xop_firstwhile, xop_desc, "first iter");
  XopENTRY_set(&xop_firstwhile, xop_class, OA_LOGOP);
  Perl_custom_op_register(aTHX_ &pp_firstwhile, &xop_firstwhile);

  register_xs_parse_keyword("reduce",     &hooks_reduce,     newSViv(REDUCE_REDUCE));
  register_xs_parse_keyword("reductions", &hooks_reductions, newSViv(REDUCE_REDUCTIONS));

  XopENTRY_set(&xop_reducestart, xop_name, "reducestart");
  XopENTRY_set(&xop_reducestart, xop_desc, "reduce");
  XopENTRY_set(&xop_reducestart, xop_class, OA_LISTOP);
  Perl_custom_op_register(aTHX_ &pp_reducestart, &xop_reducestart);

  XopENTRY_set(&xop_reducewhile, xop_name, "reducewhile");
  XopENTRY_set(&xop_reducewhile, xop_desc, "reduce iter");
  XopENTRY_set(&xop_reducewhile, xop_class, OA_LOGOP);
  Perl_custom_op_register(aTHX_ &pp_reducewhile, &xop_reducewhile);

  register_xs_parse_keyword("ngrep", &hooks_ngrep, newSViv(NITER_NGREP));

  XopENTRY_set(&xop_ngrepstart, xop_name, "ngrepstart");
  XopENTRY_set(&xop_ngrepstart, xop_desc, "ngrep");
  XopENTRY_set(&xop_ngrepstart, xop_class, OA_LISTOP);
  Perl_custom_op_register(aTHX_ &pp_ngrepstart, &xop_ngrepstart);

  XopENTRY_set(&xop_ngrepwhile, xop_name, "ngrepwhile");
  XopENTRY_set(&xop_ngrepwhile, xop_desc, "ngrep iter");
  XopENTRY_set(&xop_ngrepwhile, xop_class, OA_LOGOP);
  Perl_custom_op_register(aTHX_ &pp_ngrepwhile, &xop_ngrepwhile);

  register_xs_parse_keyword("nmap", &hooks_nmap, newSViv(NITER_NMAP));

  XopENTRY_set(&xop_nmapstart, xop_name, "nmapstart");
  XopENTRY_set(&xop_nmapstart, xop_desc, "nmap");
  XopENTRY_set(&xop_nmapstart, xop_class, OA_LISTOP);
  Perl_custom_op_register(aTHX_ &pp_nmapstart, &xop_nmapstart);

  XopENTRY_set(&xop_nmapwhile, xop_name, "nmapwhile");
  XopENTRY_set(&xop_nmapwhile, xop_desc, "nmap iter");
  XopENTRY_set(&xop_nmapwhile, xop_class, OA_LOGOP);
  Perl_custom_op_register(aTHX_ &pp_nmapwhile, &xop_nmapwhile);