X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Parameters.xs;h=d1aa2aa30a406bc1f6c0e6a4178df6fd577f82d7;hb=0d87c016a41b5c79531b89496bd20f408a44c840;hp=8082d2b249f8d68d7ea0a712b4ad3b13ec17145f;hpb=e158cf8f49978f42fb2380d3f84c5df963a39a3f;p=p5sagit%2FFunction-Parameters.git diff --git a/Parameters.xs b/Parameters.xs index 8082d2b..d1aa2aa 100644 --- a/Parameters.xs +++ b/Parameters.xs @@ -88,6 +88,8 @@ WARNINGS_ENABLE #define DEFSTRUCT(T) typedef struct T T; struct T +#define UV_BITS (sizeof (UV) * CHAR_BIT) + enum { FLAG_NAME_OK = 0x01, FLAG_ANON_OK = 0x02, @@ -105,15 +107,88 @@ DEFSTRUCT(KWSpec) { static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); -static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) { +DEFSTRUCT(Resource) { + Resource *next; + void *data; + void (*destroy)(pTHX_ void *); +}; + +typedef Resource *Sentinel[1]; + +static void sentinel_clear_void(pTHX_ void *p) { + Resource **pp = p; + while (*pp) { + Resource *cur = *pp; + cur->destroy(aTHX_ cur->data); + cur->data = (void *)"no"; + cur->destroy = NULL; + *pp = cur->next; + Safefree(cur); + } +} + +static void sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) { + Resource *cur; + + Newx(cur, 1, Resource); + cur->data = data; + cur->destroy = destroy; + cur->next = *sen; + *sen = cur; +} + +static void my_sv_refcnt_dec_void(pTHX_ void *p) { + SV *sv = p; + SvREFCNT_dec(sv); +} + +static SV *sentinel_mortalize(Sentinel sen, SV *sv) { + sentinel_register(sen, sv, my_sv_refcnt_dec_void); + return sv; +} + +static void my_safefree(void *p) { + Safefree(p); +} + +#define SENTINEL_ALLOC(SEN, P, N, T) STMT_START { \ + Newx(P, N, T); \ + sentinel_register(SEN, P, my_safefree); \ +} STMT_END + +#define SENTINEL_MDUP(SEN, P, O, N, T) STMT_START { \ + void *const _sentinel_mdup_tmp_ = (P); \ + SENTINEL_ALLOC(SEN, P, N, T); \ + memcpy(P, _sentinel_mdup_tmp_, O * sizeof (T)); \ +} STMT_END + +#define SENTINEL_REALLOC(SEN, P, N, T) STMT_START { \ + assert((N) > 0); \ + if (!(P)) { \ + SENTINEL_ALLOC(SEN, P, N, T); \ + } else { \ + Resource **_sentinel_realloc_tmp_ = (SEN); \ + for (;;) { \ + assert(*_sentinel_realloc_tmp_ != NULL); \ + if ((*_sentinel_realloc_tmp_)->data == (P)) { \ + Renew((*_sentinel_realloc_tmp_)->data, N, T); \ + (P) = (*_sentinel_realloc_tmp_)->data; \ + break; \ + } \ + _sentinel_realloc_tmp_ = &(*_sentinel_realloc_tmp_)->next; \ + } \ + } \ +} STMT_END + +static int kw_flags(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len, KWSpec *spec) { HV *hints; SV *sv, **psv; const char *p, *kw_active; STRLEN kw_active_len; spec->flags = 0; - spec->shift = sv_2mortal(newSVpvs("")); - spec->attrs = sv_2mortal(newSVpvs("")); + spec->shift = sentinel_mortalize(sen, newSVpvs("")); + spec->attrs = sentinel_mortalize(sen, newSVpvs("")); if (!(hints = GvHV(PL_hintgv))) { return FALSE; @@ -142,7 +217,7 @@ static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) { const char *fk_ptr_; \ STRLEN fk_len_; \ SV *fk_sv_; \ - fk_sv_ = sv_2mortal(newSVpvs(HINTK_ ## NAME)); \ + fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \ sv_catpvn(fk_sv_, PTR, LEN); \ fk_ptr_ = SvPV(fk_sv_, fk_len_); \ if (!((X) = hv_fetch(hints, fk_ptr_, fk_len_, 0))) { \ @@ -212,10 +287,10 @@ static bool my_is_uni_xidcont(pTHX_ UV c) { return is_utf8_xidcont(tmpbuf); } -static SV *my_scan_word(pTHX_ bool allow_package) { +static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) { bool at_start, at_substart; I32 c; - SV *sv = sv_2mortal(newSVpvs("")); + SV *sv = sentinel_mortalize(sen, newSVpvs("")); if (lex_bufutf8()) { SvUTF8_on(sv); } @@ -261,14 +336,14 @@ static SV *my_scan_word(pTHX_ bool allow_package) { return SvCUR(sv) ? sv : NULL; } -static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) { +static SV *my_scan_parens_tail(pTHX_ Sentinel sen, bool keep_backslash) { I32 c, nesting; SV *sv; line_t start; start = CopLINE(PL_curcop); - sv = sv_2mortal(newSVpvs("")); + sv = sentinel_mortalize(sen, newSVpvs("")); if (lex_bufutf8()) { SvUTF8_on(sv); } @@ -305,7 +380,7 @@ static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) { return sv; } -static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) { +static void my_check_prototype(pTHX_ Sentinel sen, const SV *declarator, SV *proto) { char *start, *r, *w, *end; STRLEN len; @@ -329,7 +404,7 @@ static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) { /* check for bad characters */ if (strspn(start, "$@%*;[]&\\_+") != len) { - SV *dsv = newSVpvs_flags("", SVs_TEMP); + SV *dsv = sentinel_mortalize(sen, newSVpvs("")); warner( packWARN(WARN_ILLEGALPROTO), "Illegal character in prototype for %"SVf" : %s", @@ -448,6 +523,7 @@ DEFSTRUCT(ParamSpec) { VEC(Param) named_required; VEC(ParamInit) named_optional; Param slurpy; + PADOFFSET rest_hash; }; DEFVECTOR_INIT(pv_init, Param); @@ -465,6 +541,7 @@ static void ps_init(ParamSpec *ps) { pv_init(&ps->named_required); piv_init(&ps->named_optional); p_init(&ps->slurpy); + ps->rest_hash = NOT_IN_PAD; } #define DEFVECTOR_EXTEND(N, B) static B (*N(VEC(B) *p)) { \ @@ -604,6 +681,7 @@ enum { */ static PADOFFSET parse_param( pTHX_ + Sentinel sen, const SV *declarator, const KWSpec *spec, ParamSpec *param_spec, int *pflags, SV **pname, OP **pinit ) { @@ -637,7 +715,7 @@ static PADOFFSET parse_param( lex_read_unichar(0); lex_read_space(0); - if (!(name = my_scan_word(aTHX_ FALSE))) { + if (!(name = my_scan_word(aTHX_ sen, FALSE))) { croak("In %"SVf": missing identifier after '%c'", SVfARG(declarator), sigil); } sv_insert(name, 0, 0, &sigil, 1); @@ -689,57 +767,143 @@ static OP *my_var(pTHX_ I32 flags, PADOFFSET padoff) { return my_var_g(aTHX_ OP_PADSV, flags, padoff); } -static SV *mkbits1(pTHX_ size_t n) { - size_t bytes = n / 8, bits = n % 8; - SV *sv = newSV(bytes + !!bits); - char *p = SvPVX(sv), *q = p; - while (bytes--) { - *p++ = '\xff'; +static OP *mkhvelem(pTHX_ PADOFFSET h, OP *k) { + OP *hv = my_var_g(aTHX_ OP_PADHV, OPf_REF, h); + return newBINOP(OP_HELEM, 0, hv, k); +} + +static OP *mkconstsv(pTHX_ SV *sv) { + return newSVOP(OP_CONST, 0, sv); +} + +static OP *mkconstiv(pTHX_ IV i) { + return mkconstsv(aTHX_ newSViv(i)); +} + +static OP *mkconstpv(pTHX_ const char *p, size_t n) { + return mkconstsv(aTHX_ newSVpv(p, n)); +} + +#define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1) + +static void register_info(pTHX_ UV key, SV *declarator, const KWSpec *kws, const ParamSpec *ps) { + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + EXTEND(SP, 8); + + /* 0 */ { + mPUSHu(key); } - if (bits) { - *p++ = (1u << bits) - 1; + /* 1 */ { + size_t n; + char *p = SvPV(declarator, n); + char *q = memchr(p, ' ', n); + mPUSHp(p, q ? q - p : n); } - *p = '\0'; - SvCUR_set(sv, p - q); - SvPOK_on(sv); - return sv; -} + if (!ps) { + if (SvTRUE(kws->shift)) { + PUSHs(kws->shift); + } else { + PUSHmortal; + } + mPUSHs(newRV_noinc((SV *)newAV())); + mPUSHs(newRV_noinc((SV *)newAV())); + mPUSHs(newRV_noinc((SV *)newAV())); + mPUSHs(newRV_noinc((SV *)newAV())); + mPUSHp("@_", 2); + } else { + /* 2 */ { + if (ps->invocant.name) { + PUSHs(ps->invocant.name); + } else { + PUSHmortal; + } + } + /* 3 */ { + size_t i, lim; + AV *av; -static OP *mkvecbits(pTHX_ PADOFFSET padoff, size_t i) { - OP *first, *mid, *last, *vec; + lim = ps->positional_required.used; - last = newSVOP(OP_CONST, 0, newSViv(1)); - first = last; + av = newAV(); + if (lim) { + av_extend(av, lim - 1); + for (i = 0; i < lim; i++) { + av_push(av, SvREFCNT_inc_simple_NN(ps->positional_required.data[i].name)); + } + } - mid = newSVOP(OP_CONST, 0, newSViv(i)); - mid->op_sibling = first; - first = mid; + mPUSHs(newRV_noinc((SV *)av)); + } + /* 4 */ { + size_t i, lim; + AV *av; + + lim = ps->positional_optional.used; + + av = newAV(); + if (lim) { + av_extend(av, lim - 1); + for (i = 0; i < lim; i++) { + av_push(av, SvREFCNT_inc_simple_NN(ps->positional_optional.data[i].param.name)); + } + } - mid = my_var(aTHX_ 0, padoff); - mid->op_sibling = first; + mPUSHs(newRV_noinc((SV *)av)); + } + /* 5 */ { + size_t i, lim; + AV *av; - first = newOP(OP_PUSHMARK, 0); + lim = ps->named_required.used; - vec = newLISTOP(OP_VEC, 0, first, mid); - vec->op_targ = pad_alloc(OP_VEC, SVs_PADTMP); - ((LISTOP *)vec)->op_last = last; - op_null(((LISTOP *)vec)->op_first); + av = newAV(); + if (lim) { + av_extend(av, lim - 1); + for (i = 0; i < lim; i++) { + av_push(av, SvREFCNT_inc_simple_NN(ps->named_required.data[i].name)); + } + } - return vec; -} + mPUSHs(newRV_noinc((SV *)av)); + } + /* 6 */ { + size_t i, lim; + AV *av; -static OP *mkargselem(pTHX_ OP *index) { - OP *args = newAVREF(newGVOP(OP_GV, 0, PL_defgv)); - args->op_flags |= OPf_REF; + lim = ps->named_optional.used; - return newBINOP(OP_AELEM, 0, args, index); -} + av = newAV(); + if (lim) { + av_extend(av, lim - 1); + for (i = 0; i < lim; i++) { + av_push(av, SvREFCNT_inc_simple_NN(ps->named_optional.data[i].param.name)); + } + } -static OP *mkargselemv(pTHX_ PADOFFSET v) { - return mkargselem(aTHX_ my_var(aTHX_ 0, v)); + mPUSHs(newRV_noinc((SV *)av)); + } + /* 7 */ { + if (ps->slurpy.name) { + PUSHs(ps->slurpy.name); + } else { + PUSHmortal; + } + } + } + PUTBACK; + + call_pv(MY_PKG "::_register_info", G_VOID); + + FREETMPS; + LEAVE; } -static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) { +static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) { ParamSpec *param_spec; SV *declarator; I32 floor_ix; @@ -751,7 +915,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len unsigned builtin_attrs; I32 c; - declarator = sv_2mortal(newSVpvn(keyword_ptr, keyword_len)); + declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len)); lex_read_space(0); @@ -759,7 +923,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* function name */ saw_name = NULL; - if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ TRUE))) { + if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ sen, TRUE))) { if (PL_parser->expect != XSTATE) { /* bail out early so we don't predeclare $saw_name */ @@ -796,7 +960,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* initialize synthetic optree */ Newx(prelude_sentinel, 1, OP *); *prelude_sentinel = NULL; - SAVEDESTRUCTOR_X(free_ptr_op, prelude_sentinel); + sentinel_register(sen, prelude_sentinel, free_ptr_op); /* parameters */ param_spec = NULL; @@ -807,11 +971,11 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len Newx(init_sentinel, 1, OP *); *init_sentinel = NULL; - SAVEDESTRUCTOR_X(free_ptr_op, init_sentinel); + sentinel_register(sen, init_sentinel, free_ptr_op); Newx(param_spec, 1, ParamSpec); ps_init(param_spec); - SAVEDESTRUCTOR_X(ps_free_void, param_spec); + sentinel_register(sen, param_spec, ps_free_void); lex_read_unichar(0); lex_read_space(0); @@ -822,7 +986,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len char sigil; PADOFFSET padoff; - padoff = parse_param(aTHX_ declarator, spec, param_spec, &flags, &name, init_sentinel); + padoff = parse_param(aTHX_ sen, declarator, spec, param_spec, &flags, &name, init_sentinel); S_intro_my(aTHX); @@ -951,19 +1115,23 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len c = ':'; } else { lex_read_unichar(0); - if (!(proto = my_scan_parens_tail(aTHX_ FALSE))) { + if (!(proto = my_scan_parens_tail(aTHX_ sen, FALSE))) { croak("In %"SVf": prototype not terminated", SVfARG(declarator)); } - my_check_prototype(aTHX_ declarator, proto); + my_check_prototype(aTHX_ sen, declarator, proto); lex_read_space(0); c = lex_peek_unichar(0); + if (!(c == ':' || c == '{')) { + lex_stuff_pvs(":", 0); + c = ':'; + } } } /* attributes */ Newx(attrs_sentinel, 1, OP *); *attrs_sentinel = NULL; - SAVEDESTRUCTOR_X(free_ptr_op, attrs_sentinel); + sentinel_register(sen, attrs_sentinel, free_ptr_op); if (c == ':' || c == '{') /* '}' - hi, vim */ { @@ -981,7 +1149,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len for (;;) { SV *attr; - if (!(attr = my_scan_word(aTHX_ FALSE))) { + if (!(attr = my_scan_word(aTHX_ sen, FALSE))) { break; } @@ -999,7 +1167,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len } else { SV *sv; lex_read_unichar(0); - if (!(sv = my_scan_parens_tail(aTHX_ TRUE))) { + if (!(sv = my_scan_parens_tail(aTHX_ sen, TRUE))) { croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator)); } sv_catpvs(attr, "("); @@ -1011,7 +1179,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len } if (attr) { - *attrs_sentinel = op_append_elem(OP_LIST, *attrs_sentinel, newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(attr))); + *attrs_sentinel = op_append_elem(OP_LIST, *attrs_sentinel, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr))); } if (c == ':') { @@ -1039,8 +1207,8 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len newATTRSUB( sub_ix, - newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)), - proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL, + mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)), + proto ? mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(proto)) : NULL, NULL, NULL ); @@ -1065,23 +1233,26 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len if (amin > 0) { OP *chk, *cond, *err, *croak; - err = newSVOP(OP_CONST, 0, - newSVpvf("Not enough arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amin)); - err = newBINOP(OP_CONCAT, 0, - err, - newAVREF(newGVOP(OP_GV, 0, PL_defgv))); - err = newBINOP(OP_CONCAT, 0, - err, - newSVOP(OP_CONST, 0, newSVpvs(")"))); + err = mkconstsv(aTHX_ newSVpvf("Not enough arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amin)); + err = newBINOP( + OP_CONCAT, 0, + err, + newAVREF(newGVOP(OP_GV, 0, PL_defgv)) + ); + err = newBINOP( + OP_CONCAT, 0, + err, + mkconstpvs(")") + ); croak = newCVREF(OPf_WANT_SCALAR, - newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))); + newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))); err = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, err, croak)); + op_append_elem(OP_LIST, err, croak)); cond = newBINOP(OP_LT, 0, - newAVREF(newGVOP(OP_GV, 0, PL_defgv)), - newSVOP(OP_CONST, 0, newSViv(amin))); + newAVREF(newGVOP(OP_GV, 0, PL_defgv)), + mkconstiv(aTHX_ amin)); chk = newLOGOP(OP_AND, 0, cond, err); *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk)); @@ -1091,23 +1262,30 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len if (amax >= 0) { OP *chk, *cond, *err, *croak; - err = newSVOP(OP_CONST, 0, - newSVpvf("Too many arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amax)); - err = newBINOP(OP_CONCAT, 0, - err, - newAVREF(newGVOP(OP_GV, 0, PL_defgv))); - err = newBINOP(OP_CONCAT, 0, - err, - newSVOP(OP_CONST, 0, newSVpvs(")"))); + err = mkconstsv(aTHX_ newSVpvf("Too many arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amax)); + err = newBINOP( + OP_CONCAT, 0, + err, + newAVREF(newGVOP(OP_GV, 0, PL_defgv)) + ); + err = newBINOP( + OP_CONCAT, 0, + err, + mkconstpvs(")") + ); - croak = newCVREF(OPf_WANT_SCALAR, - newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))); + croak = newCVREF( + OPf_WANT_SCALAR, + newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)) + ); err = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, err, croak)); + op_append_elem(OP_LIST, err, croak)); - cond = newBINOP(OP_GT, 0, - newAVREF(newGVOP(OP_GV, 0, PL_defgv)), - newSVOP(OP_CONST, 0, newSViv(amax))); + cond = newBINOP( + OP_GT, 0, + newAVREF(newGVOP(OP_GV, 0, PL_defgv)), + mkconstiv(aTHX_ amax) + ); chk = newLOGOP(OP_AND, 0, cond, err); *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk)); @@ -1117,30 +1295,27 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len OP *chk, *cond, *err, *croak; const UV fixed = count_positional_params(param_spec) + !!param_spec->invocant.name; - err = newSVOP(OP_CONST, 0, - newSVpvf("Odd number of paired arguments for %"SVf"", SVfARG(declarator))); + err = mkconstsv(aTHX_ newSVpvf("Odd number of paired arguments for %"SVf"", SVfARG(declarator))); - croak = newCVREF(OPf_WANT_SCALAR, - newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))); + croak = newCVREF( + OPf_WANT_SCALAR, + newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)) + ); err = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, err, croak)); + op_append_elem(OP_LIST, err, croak)); cond = newBINOP(OP_GT, 0, - fixed - ? newBINOP(OP_SUBTRACT, 0, - newAVREF(newGVOP(OP_GV, 0, PL_defgv)), - newSVOP(OP_CONST, 0, newSVuv(fixed))) - : newAVREF(newGVOP(OP_GV, 0, PL_defgv)), - newSVOP(OP_CONST, 0, newSViv(0))); + newAVREF(newGVOP(OP_GV, 0, PL_defgv)), + mkconstiv(aTHX_ fixed)); cond = newLOGOP(OP_AND, 0, - cond, - newBINOP(OP_MODULO, 0, - fixed - ? newBINOP(OP_SUBTRACT, 0, - newAVREF(newGVOP(OP_GV, 0, PL_defgv)), - newSVOP(OP_CONST, 0, newSVuv(fixed))) - : newAVREF(newGVOP(OP_GV, 0, PL_defgv)), - newSVOP(OP_CONST, 0, newSViv(2)))); + cond, + newBINOP(OP_MODULO, 0, + fixed + ? newBINOP(OP_SUBTRACT, 0, + newAVREF(newGVOP(OP_GV, 0, PL_defgv)), + mkconstiv(aTHX_ fixed)) + : newAVREF(newGVOP(OP_GV, 0, PL_defgv)), + mkconstiv(aTHX_ 2))); chk = newLOGOP(OP_AND, 0, cond, err); *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk)); @@ -1201,23 +1376,58 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len lhs = op_append_elem(OP_LIST, lhs, var); } - if (param_spec->slurpy.name) { - if (count_named_params(param_spec)) { - OP *const var = my_var_g( - aTHX_ - SvPV_nolen(param_spec->slurpy.name)[0] == '@' ? OP_PADAV : OP_PADHV, - OPf_MOD | (OPpLVAL_INTRO << 8), - param_spec->slurpy.padoff - ); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + { + PADOFFSET padoff; + I32 type; + bool slurpy_hash; + + /* + * cases: + * 1) no named params + * 1.1) slurpy + * => put it in + * 1.2) no slurpy + * => nop + * 2) named params + * 2.1) no slurpy + * => synthetic %{rest} + * 2.2) slurpy is a hash + * => put it in + * 2.3) slurpy is an array + * => synthetic %{rest} + * remember to declare array later + */ + + slurpy_hash = param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%'; + if (!count_named_params(param_spec)) { + if (param_spec->slurpy.name) { + padoff = param_spec->slurpy.padoff; + type = slurpy_hash ? OP_PADHV : OP_PADAV; + } else { + padoff = NOT_IN_PAD; + type = OP_PADSV; + } + } else if (slurpy_hash) { + padoff = param_spec->slurpy.padoff; + type = OP_PADHV; } else { + padoff = param_spec->rest_hash = pad_add_name_pvs("%{rest}", 0, NULL, NULL); + type = OP_PADHV; + } + + if (padoff != NOT_IN_PAD) { OP *const var = my_var_g( aTHX_ - SvPV_nolen(param_spec->slurpy.name)[0] == '@' ? OP_PADAV : OP_PADHV, + type, OPf_WANT_LIST | (OPpLVAL_INTRO << 8), - param_spec->slurpy.padoff + padoff ); + lhs = op_append_elem(OP_LIST, lhs, var); + + if (type == OP_PADHV) { + param_spec->rest_hash = padoff; + } } } @@ -1236,7 +1446,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len } } - /* default arguments */ + /* default positional arguments */ { size_t i, lim, req; OP *nest; @@ -1251,7 +1461,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len cond = newBINOP( OP_LT, 0, newAVREF(newGVOP(OP_GV, 0, PL_defgv)), - newSVOP(OP_CONST, 0, newSViv(req + i + 1)) + mkconstiv(aTHX_ req + i + 1) ); var = my_var(aTHX_ 0, cur->param.padoff); @@ -1277,343 +1487,143 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* named parameters */ if (count_named_params(param_spec)) { - int nameblock_ix; - OP *nameblock; - PADOFFSET vb, vc, vi, vk; - const size_t pos = count_positional_params(param_spec); - - nameblock = NULL; - nameblock_ix = S_block_start(aTHX_ TRUE); - - { - OP *decl, *var; + size_t i, lim; - decl = NULL; + assert(param_spec->rest_hash != NOT_IN_PAD); - if (!param_spec->named_required.used || !(spec->flags & FLAG_CHECK_NARGS)) { - vb = 0; - } else { - var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8)); - var->op_targ = vb = pad_add_name_pvs("$__B", 0, NULL, NULL); - var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, newSVpvs(""))); - decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var)); - } + for (i = 0, lim = param_spec->named_required.used; i < lim; i++) { + Param *cur = ¶m_spec->named_required.data[i]; + size_t n; + char *p = SvPV(cur->name, n); + OP *var, *cond; - if (!param_spec->named_optional.used) { - vc = 0; - } else { - var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8)); - var->op_targ = vc = pad_add_name_pvs("$__C", 0, NULL, NULL); - var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, newSVpvs(""))); - decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var)); - } + cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1)); - var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8)); - var->op_targ = vk = pad_add_name_pvs("$__K", 0, NULL, NULL); - decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var)); + if (spec->flags & FLAG_CHECK_NARGS) { + OP *croak, *msg; - var = newOP(OP_PADSV, OPf_MOD | (OPpLVAL_INTRO << 8)); - var->op_targ = vi = pad_add_name_pvs("$__I", 0, NULL, NULL); - var = newASSIGNOP(OPf_STACKED, var, 0, newSVOP(OP_CONST, 0, newSViv(pos))); - decl = op_append_list(OP_LINESEQ, decl, newSTATEOP(0, NULL, var)); + var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1)); + var = newUNOP(OP_DELETE, 0, var); - //S_intro_my(aTHX); - nameblock = op_append_list(OP_LINESEQ, nameblock, decl); - } + msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": missing named parameter: %.*s", SVfARG(declarator), (int)(n - 1), p + 1)); + croak = newCVREF( + OPf_WANT_SCALAR, + newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)) + ); + croak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, croak)); - { - OP *loop; + cond = newUNOP(OP_EXISTS, 0, cond); - loop = NULL; + cond = newCONDOP(0, cond, var, croak); + } - loop = op_append_list( - OP_LINESEQ, - loop, - newSTATEOP( - 0, NULL, - newASSIGNOP( - OPf_STACKED, - my_var(aTHX_ 0, vk), - 0, - mkargselemv(aTHX_ vi) - ) - ) + var = my_var( + aTHX_ + OPf_MOD | (OPpLVAL_INTRO << 8), + cur->padoff ); + var = newASSIGNOP(OPf_STACKED, var, 0, cond); - { - OP *nest; - size_t i; - - if (param_spec->slurpy.name) { - if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') { - OP *first, *mid, *last; - - last = mkargselem( - aTHX_ - newBINOP( - OP_ADD, 0, - my_var(aTHX_ 0, vi), - newSVOP(OP_CONST, 0, newSViv(1)) - ) - ); - mid = last; - - first = my_var(aTHX_ 0, vk); - first->op_sibling = mid; - mid = first; - - first = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff); - first->op_sibling = mid; - mid = first; - - first = newOP(OP_PUSHMARK, 0); - nest = newLISTOP(OP_PUSH, 0, first, mid); - nest->op_targ = pad_alloc(OP_PUSH, SVs_PADTMP); - ((LISTOP *)nest)->op_last = last; - } else { - nest = newASSIGNOP( - OPf_STACKED, - newBINOP( - OP_HELEM, 0, - my_var_g(aTHX_ OP_PADHV, 0, param_spec->slurpy.padoff), - my_var(aTHX_ 0, vk) - ), - 0, - mkargselem( - aTHX_ - newBINOP( - OP_ADD, 0, - my_var(aTHX_ 0, vi), - newSVOP(OP_CONST, 0, newSViv(1)) - ) - ) - ); - } - } else if (spec->flags & FLAG_CHECK_NARGS) { - OP *err, *croak; - - err = newSVOP(OP_CONST, 0, - newSVpvf("In %"SVf": No such named parameter: ", SVfARG(declarator))); - err = newBINOP( - OP_CONCAT, 0, - err, - my_var(aTHX_ 0, vk) - ); - - croak = newCVREF(OPf_WANT_SCALAR, - newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))); - nest = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, err, croak)); - } else { - nest = NULL; - } - - for (i = param_spec->named_optional.used; i--; ) { - Param *cur = ¶m_spec->named_optional.data[i].param; - size_t dn; - char *dp = SvPV(cur->name, dn); - OP *vec; - - if (!(spec->flags & FLAG_CHECK_NARGS)) { - vec = NULL; - } else { - vec = newASSIGNOP( - OPf_STACKED, - mkvecbits(aTHX_ vc, i), - 0, - newSVOP(OP_CONST, 0, newSViv(1)) - ); - } + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + } - nest = newCONDOP( - 0, - newBINOP( - OP_SEQ, 0, - my_var(aTHX_ 0, vk), - newSVOP(OP_CONST, 0, newSVpvn_utf8(dp + 1, dn - 1, SvUTF8(cur->name))) - ), - op_append_list( - OP_LINESEQ, - newASSIGNOP( - OPf_STACKED, - my_var(aTHX_ 0, cur->padoff), - 0, - mkargselem( - aTHX_ - newBINOP( - OP_ADD, 0, - my_var(aTHX_ 0, vi), - newSVOP(OP_CONST, 0, newSViv(1)) - ) - ) - ), - vec - ), - nest - ); - } + for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) { + ParamInit *cur = ¶m_spec->named_optional.data[i]; + size_t n; + char *p = SvPV(cur->param.name, n); + OP *var, *cond; - for (i = param_spec->named_required.used; i--; ) { - Param *cur = ¶m_spec->named_required.data[i]; - size_t dn; - char *dp = SvPV(cur->name, dn); - OP *vec; - - if (!(spec->flags & FLAG_CHECK_NARGS)) { - vec = NULL; - } else { - vec = newASSIGNOP( - OPf_STACKED, - mkvecbits(aTHX_ vb, i), - 0, - newSVOP(OP_CONST, 0, newSViv(1)) - ); - } + var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1)); + var = newUNOP(OP_DELETE, 0, var); - nest = newCONDOP( - 0, - newBINOP( - OP_SEQ, 0, - my_var(aTHX_ 0, vk), - newSVOP(OP_CONST, 0, newSVpvn_utf8(dp + 1, dn - 1, SvUTF8(cur->name))) - ), - op_append_list( - OP_LINESEQ, - newASSIGNOP( - OPf_STACKED, - my_var(aTHX_ 0, cur->padoff), - 0, - mkargselem( - aTHX_ - newBINOP( - OP_ADD, 0, - my_var(aTHX_ 0, vi), - newSVOP(OP_CONST, 0, newSViv(1)) - ) - ) - ), - vec - ), - nest - ); - } + cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1)); + cond = newUNOP(OP_EXISTS, 0, cond); - loop = op_append_elem(OP_LINESEQ, loop, newSTATEOP(0, NULL, nest)); - } + cond = newCONDOP(0, cond, var, cur->init); + cur->init = NULL; - loop = newWHILEOP( - 0, 1, - NULL, - newBINOP( - OP_LT, 0, - my_var(aTHX_ 0, vi), - newAVREF(newGVOP(OP_GV, 0, PL_defgv)) - ), - loop, - newASSIGNOP( - OPf_STACKED, - my_var(aTHX_ 0, vi), - OP_ADD, - newSVOP(OP_CONST, 0, newSViv(2)) - ), - 0 + var = my_var( + aTHX_ + OPf_MOD | (OPpLVAL_INTRO << 8), + cur->param.padoff ); + var = newASSIGNOP(OPf_STACKED, var, 0, cond); - nameblock = op_append_list(OP_LINESEQ, nameblock, newSTATEOP(0, NULL, loop)); + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); } - if (param_spec->named_required.used && (spec->flags & FLAG_CHECK_NARGS)) { - OP *cond, *err, *croak, *join; - - { - size_t i, lim; - OP *first, *mid, *last; - - last = newNULLLIST(); - mid = last; - - for (i = param_spec->named_required.used; i--; ) { - OP *cur; - SV *sv = param_spec->named_required.data[i].name; - size_t n; - char *p = SvPV(sv, n); - cur = newCONDOP( - 0, - mkvecbits(aTHX_ vb, i), - newNULLLIST(), - newSVOP(OP_CONST, 0, newSVpvn_utf8(p + 1, n - 1, SvUTF8(sv))) - ); - cur->op_sibling = mid; - mid = cur; - } + if (!param_spec->slurpy.name) { + if (spec->flags & FLAG_CHECK_NARGS) { + /* croak if %{rest} */ + OP *croak, *cond, *keys, *msg; - first = newSVOP(OP_CONST, 0, newSVpvs(", ")); - first->op_sibling = mid; - mid = first; + keys = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash)); + keys = newLISTOP(OP_SORT, 0, newOP(OP_PUSHMARK, 0), keys); + { + OP *first, *mid, *last; - first = newOP(OP_PUSHMARK, 0); + last = keys; - join = newLISTOP(OP_JOIN, 0, first, mid); - join->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP); - ((LISTOP *)join)->op_last = last; - } + mid = mkconstpvs(", "); + mid->op_sibling = last; - err = newSVOP( - OP_CONST, 0, - newSVpvf("In %"SVf": Missing named parameter(s): ", SVfARG(declarator)) - ); - err = newBINOP(OP_CONCAT, 0, err, join); - croak = newCVREF( - OPf_WANT_SCALAR, - newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)) - ); - err = newUNOP( - OP_ENTERSUB, - OPf_STACKED, - op_append_elem(OP_LIST, err, croak) - ); - cond = newBINOP( - OP_SNE, 0, - my_var(aTHX_ 0, vb), - newSVOP(OP_CONST, 0, mkbits1(aTHX_ param_spec->named_required.used)) - ); - err = newCONDOP( - 0, - cond, - err, - NULL - ); + first = newOP(OP_PUSHMARK, 0); - nameblock = op_append_list(OP_LINESEQ, nameblock, err); - } + keys = newLISTOP(OP_JOIN, 0, first, mid); + keys->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP); + ((LISTOP *)keys)->op_last = last; + } - if (param_spec->named_optional.used) { - size_t i, lim; + msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator))); + msg = newBINOP(OP_CONCAT, 0, msg, keys); - for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) { - ParamInit *const cur = ¶m_spec->named_optional.data[i]; - OP *init, *cond; + croak = newCVREF( + OPf_WANT_SCALAR, + newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)) + ); + croak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, croak)); - init = newASSIGNOP( + cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash)); + croak = newCONDOP(0, cond, croak, NULL); + + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, croak)); + } else { + OP *clear; + + clear = newASSIGNOP( OPf_STACKED, - my_var(aTHX_ 0, cur->param.padoff), + my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash), 0, - cur->init + newNULLLIST() ); - cur->init = NULL; - cond = newUNOP(OP_NOT, OPf_SPECIAL, mkvecbits(aTHX_ vc, i)); + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear)); + } + } else if (param_spec->slurpy.padoff != param_spec->rest_hash) { + OP *var, *clear; - init = newCONDOP(0, cond, init, NULL); + assert(SvPV_nolen(param_spec->slurpy.name)[0] == '@'); - nameblock = op_append_list(OP_LINESEQ, nameblock, newSTATEOP(0, NULL, init)); - } - } + var = my_var_g( + aTHX_ + OP_PADAV, + OPf_MOD | (OPpLVAL_INTRO << 8), + param_spec->slurpy.padoff + ); - nameblock = S_block_end(aTHX_ nameblock_ix, nameblock); - nameblock = op_scope(nameblock); + var = newASSIGNOP(OPf_STACKED, var, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash)); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, nameblock); + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + + clear = newASSIGNOP( + OPf_STACKED, + my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash), + 0, + newNULLLIST() + ); + + *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear)); + } } } @@ -1632,57 +1642,81 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len /* it's go time. */ { + CV *cv; OP *const attrs = *attrs_sentinel; *attrs_sentinel = NULL; + SvREFCNT_inc_simple_void(PL_compcv); /* close outer block: '}' */ S_block_end(aTHX_ save_ix, body); - if (!saw_name) { - *pop = newANONATTRSUB( - floor_ix, - proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL, - attrs, - body - ); - return KEYWORD_PLUGIN_EXPR; - } - - newATTRSUB( + cv = newATTRSUB( floor_ix, - newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)), + saw_name ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL, proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL, attrs, body ); - *pop = newOP(OP_NULL, 0); - return KEYWORD_PLUGIN_STMT; + + register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec); + + if (saw_name) { + *pop = newOP(OP_NULL, 0); + return KEYWORD_PLUGIN_STMT; + } + + *pop = newUNOP( + OP_REFGEN, 0, + newSVOP( + OP_ANONCODE, 0, + (SV *)cv + ) + ); + return KEYWORD_PLUGIN_EXPR; } } static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) { KWSpec spec; int ret; + Sentinel sen = { NULL }; + ENTER; SAVETMPS; - if (kw_flags(aTHX_ keyword_ptr, keyword_len, &spec)) { - ret = parse_fun(aTHX_ op_ptr, keyword_ptr, keyword_len, &spec); + SAVEDESTRUCTOR_X(sentinel_clear_void, sen); + + if (kw_flags(aTHX_ sen, keyword_ptr, keyword_len, &spec)) { + ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec); } else { ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr); } FREETMPS; + LEAVE; return ret; } WARNINGS_RESET -MODULE = Function::Parameters PACKAGE = Function::Parameters +MODULE = Function::Parameters PACKAGE = Function::Parameters PREFIX = fp_ PROTOTYPES: ENABLE +UV +fp__cv_root(sv) + SV * sv + PREINIT: + CV *cv; + HV *hv; + GV *gv; + CODE: + cv = sv_2cv(sv, &hv, &gv, 0); + RETVAL = PTR2UV(cv ? CvROOT(cv) : NULL); + OUTPUT: + RETVAL + BOOT: WARNINGS_ENABLE { HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);