XS-Parse-Sublike

 view release on metacpan or  search on metacpan

include/parse_subsignature_ex.h  view on Meta::CPAN

#define signature_query(ctx, q)  XPS_signature_query(aTHX_ ctx, q)
IV XPS_signature_query(pTHX_ struct XSParseSublikeContext *ctx, int q);

#define parse_subsignature_ex(flags, ctx, hd, nhooks)  XPS_parse_subsignature_ex(aTHX_ flags, ctx, hd, nhooks)
OP *XPS_parse_subsignature_ex(pTHX_ int flags,
  struct XPSContextWithPointer *ctx,
  struct HooksAndData hooksanddata[],
  size_t nhooks);

#define register_subsignature_attribute(name, funcs, funcdata)  XPS_register_subsignature_attribute(aTHX_ name, funcs, funcdata)
void XPS_register_subsignature_attribute(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata);

lib/XS/Parse/Sublike.xs  view on Meta::CPAN

  };

  if(reg) {
    hd[1].hooks = reg->hooks;
    hd[1].data  = reg->hookdata;
  }

  return parse(aTHX_ hd, 1 + !!reg, op_ptr);
}

static void IMPL_register_xps_signature_attribute(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata)
{
  if(funcs->ver < 5)
    croak("Mismatch in signature param attribute ABI version field: module wants %u; we require >= 5\n",
      funcs->ver);
  if(funcs->ver > XSPARSESUBLIKE_ABI_VERSION)
    croak("Mismatch in signature param attribute ABI version field: module wants %u; we support <= %d\n",
      funcs->ver, XSPARSESUBLIKE_ABI_VERSION);

  if(!name || !(name[0] >= 'A' && name[0] <= 'Z'))
    croak("Signature param attribute names must begin with a capital letter");

  if(!funcs->permit_hintkey)
    croak("Signature param attributes require a permit hinthash key");

  register_subsignature_attribute(name, funcs, funcdata);
}

#ifdef HAVE_FEATURE_CLASS
static bool permit_core_method(pTHX_ void *hookdata)
{
  return FEATURE_CLASS_IS_ENABLED;
}

static void pre_subparse_core_method(pTHX_ struct XSParseSublikeContext *ctx, void *hookdata)
{

share/include/XSParseSublike.h  view on Meta::CPAN

  char sigil;
  const char *namepv;
  STRLEN namelen;
};

struct XPSSignatureAttributeFuncs {
  U32 ver;  /* caller must initialise to XSPARSESUBLIKE_ABI_VERSION */
  U32 flags;
  const char *permit_hintkey;

  void (*apply)(pTHX_ struct XPSSignatureParamContext *ctx, SV *attrvalue, void **attrdata_ptr, void *funcdata);
  void (*post_defop)(pTHX_ struct XPSSignatureParamContext *ctx, void *attrdata, void *funcdata);

  void (*free)(pTHX_ void *attrdata, void *funcdata);
};

static void (*register_xps_signature_attribute_func)(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata);
#define register_xps_signature_attribute(name, funcs, funcdata) S_register_xps_signature_attribute(aTHX_ name, funcs, funcdata)
static void S_register_xps_signature_attribute(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata)
{
  if(!register_xps_signature_attribute_func)
    croak("Must call boot_xs_parse_sublike() first");

  (*register_xps_signature_attribute_func)(aTHX_ name, funcs, funcdata);
}


#define boot_xs_parse_sublike(ver) S_boot_xs_parse_sublike(aTHX_ ver)
static void S_boot_xs_parse_sublike(pTHX_ double ver) {
  SV **svp;
  SV *versv = ver ? newSVnv(ver) : NULL;

  load_module(PERL_LOADMOD_NOIMPORT, newSVpvs("XS::Parse::Sublike"), versv, NULL);

src/parse_subsignature_ex.c  view on Meta::CPAN

/* Parameter attribute extensions */
typedef struct SignatureAttributeRegistration SignatureAttributeRegistration;

struct SignatureAttributeRegistration {
  SignatureAttributeRegistration *next;

  const char *name;
  STRLEN permit_hintkeylen;

  const struct XPSSignatureAttributeFuncs *funcs;
  void *funcdata;
};

static SignatureAttributeRegistration *sigattrs = NULL;

#define find_registered_attribute(name)  S_find_registered_attribute(aTHX_ name)
static SignatureAttributeRegistration *S_find_registered_attribute(pTHX_ const char *name)
{
  HV *hints = GvHV(PL_hintgv);

  SignatureAttributeRegistration *reg;

src/parse_subsignature_ex.c  view on Meta::CPAN

      continue;

    return reg;
  }

  croak("Unrecognised signature parameter attribute :%s", name);
}

struct PendingSignatureFunc {
  const struct XPSSignatureAttributeFuncs *funcs;
  void *funcdata;
  void *attrdata;
};

#define PENDING_FROM_SV(sv)  ((struct PendingSignatureFunc *)SvPVX(sv))

static void pending_free(pTHX_ SV *sv)
{
  struct PendingSignatureFunc *p = PENDING_FROM_SV(sv);

  if(p->funcs->free)
    (*p->funcs->free)(aTHX_ p->attrdata, p->funcdata);
}

#define NEW_SV_PENDING()  newSV_with_free(sizeof(struct PendingSignatureFunc), &pending_free)

struct NamedParamDetails {
  PADOFFSET padix;
  bool is_required;
};
struct SignatureParsingContext {
  OP *positional_elems;  /* OP_LINESEQ of every positional element, in order */

src/parse_subsignature_ex.c  view on Meta::CPAN

    SV *attrname = sv_newmortal(), *attrval = sv_newmortal();

    while(lex_scan_attrval_into(attrname, attrval)) {
      lex_read_space(0);

      SignatureAttributeRegistration *reg = find_registered_attribute(SvPV_nolen(attrname));

      void *attrdata = NULL;
      if(reg->funcs->apply)
        (*reg->funcs->apply)(aTHX_ &paramctx, attrval, &attrdata, reg->funcdata);

      if(attrdata || reg->funcs->post_defop) {
        if(!pending) {
          pending = newAV();
          SAVEFREESV(pending);
        }

        SV *psv;
        av_push(pending, psv = NEW_SV_PENDING());

        PENDING_FROM_SV(psv)->funcs    = reg->funcs;
        PENDING_FROM_SV(psv)->funcdata = reg->funcdata;
        PENDING_FROM_SV(psv)->attrdata = attrdata;
      }

      if(lex_peek_unichar(0) == ':') {
        lex_read_unichar(0);
        lex_read_space(0);
      }
    }
  }

src/parse_subsignature_ex.c  view on Meta::CPAN

    if(lex_peek_unichar(0) == '=')
      yyerror("A slurpy parameter may not have a default value");
  }

  if(pending) {
    for(int i = 0; i <= AvFILL(pending); i++) {
      struct PendingSignatureFunc *p = PENDING_FROM_SV(AvARRAY(pending)[i]);

      if(p->funcs->post_defop)
        (*p->funcs->post_defop)(aTHX_ &paramctx, p->attrdata, p->funcdata);
    }
  }

  /* Only after we've run the post_defop hooks can we actually consume the
   * result in paramctx.op
   */
  sigctx_add_param(sigctx, &paramctx);
}

OP *XPS_parse_subsignature_ex(pTHX_ int flags,

src/parse_subsignature_ex.c  view on Meta::CPAN

  /* a nextstate at the end handles context correctly for an empty
   * sub body */
  ops = op_append_elem(OP_LINESEQ, ops, newSTATEOP(0, NULL, NULL));

  LEAVE;

  return ops;
}

void XPS_register_subsignature_attribute(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata)
{
  SignatureAttributeRegistration *reg;
  Newx(reg, 1, struct SignatureAttributeRegistration);

  *reg = (struct SignatureAttributeRegistration){
    .name     = name,
    .funcs    = funcs,
    .funcdata = funcdata,
  };

  if(funcs->permit_hintkey)
    reg->permit_hintkeylen = strlen(funcs->permit_hintkey);

  reg->next = sigattrs;
  sigattrs = reg;
}

void XPS_boot_parse_subsignature_ex(pTHX)

src/parse_subsignature_ex.c  view on Meta::CPAN

void XPS_signature_add_param(pTHX_ struct XSParseSublikeContext *ctx, struct XPSSignatureParamDetails *details)
{
}

IV XPS_signature_query(pTHX_ struct XSParseSublikeContext *ctx, int q)
{
  return 0;
}

void XPS_register_subsignature_attribute(pTHX_ const char *name, const struct XPSSignatureAttributeFuncs *funcs, void *funcdata)
{
  croak("Custom subroutine signature attributes are not supported on this verison of Perl");
}

void XPS_boot_parse_subsignature_ex(pTHX)
{
}
#endif

t/func.xs  view on Meta::CPAN

  .permit_hintkey = "t::func/nafunc",
  .flags = XS_PARSE_SUBLIKE_FLAG_SIGNATURE_NAMED_PARAMS|XS_PARSE_SUBLIKE_FLAG_SIGNATURE_PARAM_ATTRIBUTES,
};

static const struct XSParseSublikeHooks parse_nopkgfunc_hooks = {
  .ver            = XSPARSESUBLIKE_ABI_VERSION,
  .permit_hintkey = "t::func/func",
};

#ifdef HAVE_SUB_PARAM_ATTRIBUTES
static void apply_Attribute(pTHX_ struct XPSSignatureParamContext *ctx, SV *attrvalue, void **attrdata_ptr, void *funcdata)
{
  /* TODO: maybe the context should store a lexname string? */
  PADNAME *pn = PadnamelistARRAY(PL_comppad_name)[ctx->padix];

  AV *av = get_av("main::ATTRIBUTE_APPLIED", GV_ADD);

  av_push(av, newSVpvf("%s%" SVf,
    ctx->is_named ? ":" : "", PadnameSV(pn)));
  av_push(av, newSVsv(attrvalue));
}


static void post_defop_Attribute(pTHX_ struct XPSSignatureParamContext *ctx, void *attrdata, void *funcdata)
{
  /* OP* pointer values won't mean much to pureperl code, but we can at least
   * store UVs and assert them not zero
   */

  HV *n = newHV();
  hv_stores(n, "op",    newSVuv(PTR2UV(ctx->op)));
  hv_stores(n, "varop", newSVuv(PTR2UV(ctx->varop)));
  hv_stores(n, "defop", newSVuv(PTR2UV(ctx->defop)));