X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Parameters.xs;h=3cf607b293eec23b6440fe12987441b1b4adb989;hb=5424bb4a885554829b311cceb8a44822d7bab1c0;hp=9343ffe47292203770e7fa64825a2925e3e05a53;hpb=75d7dde2a12774ed3b1fac4b017dd336e444043e;p=p5sagit%2FFunction-Parameters.git diff --git a/Parameters.xs b/Parameters.xs index 9343ffe..3cf607b 100644 --- a/Parameters.xs +++ b/Parameters.xs @@ -85,24 +85,25 @@ WARNINGS_ENABLE #define HINTK_FLAGS_ MY_PKG "/flags:" #define HINTK_SHIFT_ MY_PKG "/shift:" #define HINTK_ATTRS_ MY_PKG "/attrs:" +#define HINTK_REIFY_ MY_PKG "/reify:" #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, - FLAG_DEFAULT_ARGS = 0x04, - FLAG_CHECK_NARGS = 0x08, - FLAG_INVOCANT = 0x10, - FLAG_NAMED_PARAMS = 0x20, - FLAG_TYPES_OK = 0x40, - FLAG_CHECK_TARGS = 0x80 + FLAG_NAME_OK = 0x001, + FLAG_ANON_OK = 0x002, + FLAG_DEFAULT_ARGS = 0x004, + FLAG_CHECK_NARGS = 0x008, + FLAG_INVOCANT = 0x010, + FLAG_NAMED_PARAMS = 0x020, + FLAG_TYPES_OK = 0x040, + FLAG_CHECK_TARGS = 0x080, + FLAG_RUNTIME = 0x100 }; DEFSTRUCT(KWSpec) { unsigned flags; + I32 reify_type; SV *shift; SV *attrs; }; @@ -157,105 +158,50 @@ static SV *sentinel_mortalize(Sentinel sen, SV *sv) { 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 = sentinel_mortalize(sen, newSVpvs("")); - spec->attrs = sentinel_mortalize(sen, newSVpvs("")); +#if HAVE_PERL_VERSION(5, 17, 2) + #define MY_OP_SLABBED(O) ((O)->op_slabbed) +#else + #define MY_OP_SLABBED(O) 0 +#endif - if (!(hints = GvHV(PL_hintgv))) { - return FALSE; - } - if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) { - return FALSE; - } - sv = *psv; - kw_active = SvPV(sv, kw_active_len); - if (kw_active_len <= kw_len) { - return FALSE; - } - for ( - p = kw_active; - (p = strchr(p, *kw_ptr)) && - p < kw_active + kw_active_len - kw_len; - p++ - ) { - if ( - (p == kw_active || p[-1] == ' ') && - p[kw_len] == ' ' && - memcmp(kw_ptr, p, kw_len) == 0 - ) { +DEFSTRUCT(OpGuard) { + OP *op; + bool needs_freed; +}; -#define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \ - const char *fk_ptr_; \ - STRLEN fk_len_; \ - SV *fk_sv_; \ - 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))) { \ - croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \ - } \ -} STMT_END +static void op_guard_init(OpGuard *p) { + p->op = NULL; + p->needs_freed = FALSE; +} - FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv); - spec->flags = SvIV(*psv); +static OpGuard op_guard_transfer(OpGuard *p) { + OpGuard r = *p; + op_guard_init(p); + return r; +} - FETCH_HINTK_INTO(SHIFT_, kw_ptr, kw_len, psv); - SvSetSV(spec->shift, *psv); +static OP *op_guard_relinquish(OpGuard *p) { + OP *o = p->op; + op_guard_init(p); + return o; +} - FETCH_HINTK_INTO(ATTRS_, kw_ptr, kw_len, psv); - SvSetSV(spec->attrs, *psv); +static void op_guard_update(OpGuard *p, OP *o) { + p->op = o; + p->needs_freed = o && !MY_OP_SLABBED(o); +} -#undef FETCH_HINTK_INTO - return TRUE; - } +static void op_guard_clear(pTHX_ OpGuard *p) { + if (p->needs_freed) { + op_free(p->op); } - return FALSE; } - -static void free_ptr_op_void(pTHX_ void *vp) { - OP **pp = vp; - op_free(*pp); - Safefree(pp); +static void free_op_guard_void(pTHX_ void *vp) { + OpGuard *p = vp; + op_guard_clear(aTHX_ p); + Safefree(p); } static void free_op_void(pTHX_ void *vp) { @@ -290,17 +236,9 @@ static void my_sv_cat_c(pTHX_ SV *sv, U32 c) { sv_catpvn(sv, ds, d - ds); } -static bool my_is_uni_xidfirst(pTHX_ UV c) { - U8 tmpbuf[UTF8_MAXBYTES + 1]; - uvchr_to_utf8(tmpbuf, c); - return is_utf8_xidfirst(tmpbuf); -} -static bool my_is_uni_xidcont(pTHX_ UV c) { - U8 tmpbuf[UTF8_MAXBYTES + 1]; - uvchr_to_utf8(tmpbuf, c); - return is_utf8_xidcont(tmpbuf); -} +#define MY_UNI_IDFIRST(C) isIDFIRST_uni(C) +#define MY_UNI_IDCONT(C) isALNUM_uni(C) static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) { bool at_start, at_substart; @@ -314,7 +252,7 @@ static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) { c = lex_peek_unichar(0); while (c != -1) { - if (at_substart ? my_is_uni_xidfirst(aTHX_ c) : my_is_uni_xidcont(aTHX_ c)) { + if (at_substart ? MY_UNI_IDFIRST(c) : MY_UNI_IDCONT(c)) { lex_read_unichar(0); my_sv_cat_c(aTHX_ sv, c); at_substart = FALSE; @@ -322,7 +260,7 @@ static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) { } else if (allow_package && !at_substart && c == '\'') { lex_read_unichar(0); c = lex_peek_unichar(0); - if (!my_is_uni_xidfirst(aTHX_ c)) { + if (!MY_UNI_IDFIRST(c)) { lex_stuff_pvs("'", 0); break; } @@ -336,7 +274,7 @@ static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) { } lex_read_unichar(0); c = lex_peek_unichar(0); - if (!my_is_uni_xidfirst(aTHX_ c)) { + if (!MY_UNI_IDFIRST(c)) { lex_stuff_pvs("::", 0); break; } @@ -560,23 +498,39 @@ static SV *parse_type(pTHX_ Sentinel sen, const SV *declarator) { return t; } -static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, SV *name) { - SV *t; +static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, const KWSpec *spec, SV *name) { + AV *type_reifiers; + SV *t, *sv, **psv; int n; dSP; + type_reifiers = get_av(MY_PKG "::type_reifiers", 0); + assert(type_reifiers != NULL); + + if (spec->reify_type < 0 || spec->reify_type > av_len(type_reifiers)) { + croak("In %"SVf": internal error: reify_type [%ld] out of range [%ld]", SVfARG(declarator), (long)spec->reify_type, (long)(av_len(type_reifiers) + 1)); + } + + psv = av_fetch(type_reifiers, spec->reify_type, 0); + assert(psv != NULL); + sv = *psv; + ENTER; SAVETMPS; PUSHMARK(SP); - EXTEND(SP, 1); + EXTEND(SP, 2); PUSHs(name); + PUSHs(PL_curstname); PUTBACK; - n = call_pv("Moose::Util::TypeConstraints::find_or_parse_type_constraint", G_SCALAR); + n = call_sv(sv, G_SCALAR); SPAGAIN; assert(n == 1); + /* don't warn about n being unused if assert() is compiled out */ + n = n; + t = sentinel_mortalize(sen, SvREFCNT_inc(POPs)); PUTBACK; @@ -599,7 +553,7 @@ DEFSTRUCT(Param) { DEFSTRUCT(ParamInit) { Param param; - OP *init; + OpGuard init; }; #define VEC(B) B ## _Vec @@ -678,10 +632,7 @@ static void p_clear(pTHX_ Param *p) { static void pi_clear(pTHX_ ParamInit *pi) { p_clear(aTHX_ &pi->param); - if (pi->init) { - op_free(pi->init); - pi->init = NULL; - } + op_guard_clear(aTHX_ &pi->init); } DEFVECTOR_CLEAR(pv_clear, Param, p_clear); @@ -775,13 +726,6 @@ static size_t count_named_params(const ParamSpec *ps) { return ps->named_required.used + ps->named_optional.used; } -static void my_require(pTHX_ const char *file) { - require_pv(file); - if (SvTRUE(ERRSV)) { - croak_sv(ERRSV); - } -} - static SV *my_eval(pTHX_ Sentinel sen, I32 floor, OP *op) { SV *sv; CV *cv; @@ -809,20 +753,17 @@ enum { PARAM_NAMED = 0x02 }; -/* *pinit must be NULL on entry. - * caller must free *pinit on error. - */ static PADOFFSET parse_param( pTHX_ Sentinel sen, const SV *declarator, const KWSpec *spec, ParamSpec *param_spec, - int *pflags, SV **pname, OP **pinit, SV **ptype + int *pflags, SV **pname, OpGuard *ginit, SV **ptype ) { I32 c; char sigil; SV *name; - assert(!*pinit); + assert(!ginit->op); *pflags = 0; *ptype = NULL; @@ -843,7 +784,11 @@ static PADOFFSET parse_param( if (!(expr = parse_fullexpr(PARSE_OPTIONAL))) { croak("In %"SVf": invalid type expression", SVfARG(declarator)); } - expr_sentinel = sentinel_register(sen, expr, free_op_void); + if (MY_OP_SLABBED(expr)) { + expr_sentinel = NULL; + } else { + expr_sentinel = sentinel_register(sen, expr, free_op_void); + } lex_read_space(0); c = lex_peek_unichar(0); @@ -854,18 +799,21 @@ static PADOFFSET parse_param( lex_read_space(0); SvREFCNT_inc_simple_void(PL_compcv); - sentinel_disarm(expr_sentinel); + if (expr_sentinel) { + sentinel_disarm(expr_sentinel); + } *ptype = my_eval(aTHX_ sen, floor, expr); - *ptype = reify_type(aTHX_ sen, declarator, *ptype); + if (!SvROK(*ptype)) { + *ptype = reify_type(aTHX_ sen, declarator, spec, *ptype); + } if (!sv_isobject(*ptype)) { croak("In %"SVf": (%"SVf") doesn't look like a type object", SVfARG(declarator), SVfARG(*ptype)); } c = lex_peek_unichar(0); - } else if (my_is_uni_xidfirst(aTHX_ c)) { + } else if (MY_UNI_IDFIRST(c)) { *ptype = parse_type(aTHX_ sen, declarator); - my_require(aTHX_ "Moose/Util/TypeConstraints.pm"); - *ptype = reify_type(aTHX_ sen, declarator, *ptype); + *ptype = reify_type(aTHX_ sen, declarator, spec, *ptype); c = lex_peek_unichar(0); } @@ -912,7 +860,7 @@ static PADOFFSET parse_param( param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL); } - *pinit = parse_termexpr(0); + op_guard_update(ginit, parse_termexpr(0)); lex_read_space(0); c = lex_peek_unichar(0); @@ -966,7 +914,7 @@ static OP *mkconstpv(pTHX_ const char *p, size_t n) { static OP *mktypecheck(pTHX_ const SV *declarator, int nr, SV *name, PADOFFSET padoff, SV *type) { /* $type->check($value) or Carp::croak "...: " . $type->get_message($value) */ - OP *chk, *cond, *err, *msg, *xcroak; + OP *chk, *err, *msg, *xcroak; err = mkconstsv(aTHX_ newSVpvf("In %"SVf": parameter %d (%"SVf"): ", SVfARG(declarator), nr, SVfARG(name))); { @@ -1034,10 +982,11 @@ static void register_info(pTHX_ UV key, SV *declarator, const KWSpec *kws, const mPUSHu(key); } /* 1 */ { - size_t n; + STRLEN n; char *p = SvPV(declarator, n); char *q = memchr(p, ' ', n); - mPUSHp(p, q ? (size_t)(q - p) : n); + SV *tmp = newSVpvn_utf8(p, q ? (size_t)(q - p) : n, SvUTF8(declarator)); + mPUSHs(tmp); } if (!ps) { if (SvTRUE(kws->shift)) { @@ -1166,13 +1115,17 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL I32 floor_ix; int save_ix; SV *saw_name; - OP **prelude_sentinel; + OpGuard *prelude_sentinel; SV *proto; - OP **attrs_sentinel, *body; + OpGuard *attrs_sentinel; + OP *body; unsigned builtin_attrs; I32 c; declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len)); + if (lex_bufutf8()) { + SvUTF8_on(declarator); + } lex_read_space(0); @@ -1215,20 +1168,20 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL save_ix = S_block_start(aTHX_ TRUE); /* initialize synthetic optree */ - Newx(prelude_sentinel, 1, OP *); - *prelude_sentinel = NULL; - sentinel_register(sen, prelude_sentinel, free_ptr_op_void); + Newx(prelude_sentinel, 1, OpGuard); + op_guard_init(prelude_sentinel); + sentinel_register(sen, prelude_sentinel, free_op_guard_void); /* parameters */ param_spec = NULL; c = lex_peek_unichar(0); if (c == '(') { - OP **init_sentinel; + OpGuard *init_sentinel; - Newx(init_sentinel, 1, OP *); - *init_sentinel = NULL; - sentinel_register(sen, init_sentinel, free_ptr_op_void); + Newx(init_sentinel, 1, OpGuard); + op_guard_init(init_sentinel); + sentinel_register(sen, init_sentinel, free_op_guard_void); Newx(param_spec, 1, ParamSpec); ps_init(param_spec); @@ -1258,13 +1211,13 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL croak("In %"SVf": named parameter %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash"); } } else if (flags & PARAM_INVOCANT) { - if (*init_sentinel) { + if (init_sentinel->op) { croak("In %"SVf": invocant %"SVf" can't have a default value", SVfARG(declarator), SVfARG(name)); } if (sigil != '$') { croak("In %"SVf": invocant %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash"); } - } else if (sigil != '$' && *init_sentinel) { + } else if (sigil != '$' && init_sentinel->op) { croak("In %"SVf": %s %"SVf" can't have a default value", SVfARG(declarator), sigil == '@' ? "array" : "hash", SVfARG(name)); } @@ -1273,7 +1226,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL croak("In %"SVf": I was expecting \")\" after \"%"SVf"\", not \"%"SVf"\"", SVfARG(declarator), SVfARG(param_spec->slurpy.name), SVfARG(name)); } if (sigil != '$') { - assert(!*init_sentinel); + assert(!init_sentinel->op); param_spec->slurpy.name = name; param_spec->slurpy.padoff = padoff; param_spec->slurpy.type = type; @@ -1300,7 +1253,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL continue; } - if (*init_sentinel && !(spec->flags & FLAG_DEFAULT_ARGS)) { + if (init_sentinel->op && !(spec->flags & FLAG_DEFAULT_ARGS)) { croak("In %"SVf": default argument for %"SVf" not allowed here", SVfARG(declarator), SVfARG(name)); } @@ -1313,13 +1266,12 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL croak("In %"SVf": named parameter :%"SVf" not allowed here", SVfARG(declarator), SVfARG(name)); } - if (*init_sentinel) { + if (init_sentinel->op) { ParamInit *pi = piv_extend(¶m_spec->named_optional); pi->param.name = name; pi->param.padoff = padoff; pi->param.type = type; - pi->init = *init_sentinel; - *init_sentinel = NULL; + pi->init = op_guard_transfer(init_sentinel); param_spec->named_optional.used++; } else { Param *p; @@ -1335,13 +1287,12 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL param_spec->named_required.used++; } } else { - if (*init_sentinel || param_spec->positional_optional.used) { + if (init_sentinel->op || param_spec->positional_optional.used) { ParamInit *pi = piv_extend(¶m_spec->positional_optional); pi->param.name = name; pi->param.padoff = padoff; pi->param.type = type; - pi->init = *init_sentinel; - *init_sentinel = NULL; + pi->init = op_guard_transfer(init_sentinel); param_spec->positional_optional.used++; } else { Param *p = pv_extend(¶m_spec->positional_required); @@ -1355,7 +1306,6 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL } lex_read_unichar(0); lex_read_space(0); - *init_sentinel = NULL; if (!param_spec->invocant.name && SvTRUE(spec->shift)) { if (ps_contains(aTHX_ param_spec, spec->shift)) { @@ -1394,9 +1344,9 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL } /* attributes */ - Newx(attrs_sentinel, 1, OP *); - *attrs_sentinel = NULL; - sentinel_register(sen, attrs_sentinel, free_ptr_op_void); + Newx(attrs_sentinel, 1, OpGuard); + op_guard_init(attrs_sentinel); + sentinel_register(sen, attrs_sentinel, free_op_guard_void); if (c == ':' || c == '{') /* '}' - hi, vim */ { @@ -1444,7 +1394,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL } if (attr) { - *attrs_sentinel = op_append_elem(OP_LIST, *attrs_sentinel, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr))); + op_guard_update(attrs_sentinel, op_append_elem(OP_LIST, attrs_sentinel->op, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr)))); } if (c == ':') { @@ -1462,7 +1412,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL } /* surprise predeclaration! */ - if (saw_name) { + if (saw_name && !(spec->flags & FLAG_RUNTIME)) { /* 'sub NAME (PROTO);' to make name/proto known to perl before it starts parsing the body */ const I32 sub_ix = start_subparse(FALSE, 0); @@ -1519,7 +1469,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL mkconstiv(aTHX_ amin)); chk = newLOGOP(OP_AND, 0, cond, err); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk))); } amax = args_max(param_spec); @@ -1552,7 +1502,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL ); chk = newLOGOP(OP_AND, 0, cond, err); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk))); } if (param_spec && (count_named_params(param_spec) || (param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%'))) { @@ -1582,7 +1532,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL mkconstiv(aTHX_ 2))); chk = newLOGOP(OP_AND, 0, cond, err); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, chk)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk))); } } @@ -1598,7 +1548,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL ); var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0)); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var))); } } else { /* my $invocant = shift; */ @@ -1612,10 +1562,10 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL ); var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0)); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var))); if (param_spec->invocant.type && (spec->flags & FLAG_CHECK_TARGS)) { - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, 0, ¶m_spec->invocant))); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, 0, ¶m_spec->invocant)))); } } @@ -1704,13 +1654,13 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL lhs->op_flags |= OPf_PARENS; rhs = newAVREF(newGVOP(OP_GV, 0, PL_defgv)); - *prelude_sentinel = op_append_list( - OP_LINESEQ, *prelude_sentinel, + op_guard_update(prelude_sentinel, op_append_list( + OP_LINESEQ, prelude_sentinel->op, newSTATEOP( 0, NULL, newASSIGNOP(OPf_STACKED, lhs, 0, rhs) ) - ); + )); } } @@ -1736,9 +1686,8 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL nest = op_append_list( OP_LINESEQ, nest, - newASSIGNOP(OPf_STACKED, var, 0, cur->init) + newASSIGNOP(OPf_STACKED, var, 0, op_guard_relinquish(&cur->init)) ); - cur->init = NULL; nest = newCONDOP( 0, cond, @@ -1747,10 +1696,10 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL ); } - *prelude_sentinel = op_append_list( - OP_LINESEQ, *prelude_sentinel, + op_guard_update(prelude_sentinel, op_append_list( + OP_LINESEQ, prelude_sentinel->op, nest - ); + )); } /* named parameters */ @@ -1792,7 +1741,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL ); var = newASSIGNOP(OPf_STACKED, var, 0, cond); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var))); } for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) { @@ -1807,8 +1756,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1)); cond = newUNOP(OP_EXISTS, 0, cond); - cond = newCONDOP(0, cond, var, cur->init); - cur->init = NULL; + cond = newCONDOP(0, cond, var, op_guard_relinquish(&cur->init)); var = my_var( aTHX_ @@ -1817,7 +1765,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL ); var = newASSIGNOP(OPf_STACKED, var, 0, cond); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var))); } if (!param_spec->slurpy.name) { @@ -1854,7 +1802,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash)); xcroak = newCONDOP(0, cond, xcroak, NULL); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, xcroak)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, xcroak))); } else { OP *clear; @@ -1865,7 +1813,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL newNULLLIST() ); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, clear))); } } else if (param_spec->slurpy.padoff != param_spec->rest_hash) { OP *var, *clear; @@ -1881,7 +1829,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL 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, newSTATEOP(0, NULL, var)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var))); clear = newASSIGNOP( OPf_STACKED, @@ -1890,7 +1838,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL newNULLLIST() ); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, clear))); } } @@ -1902,7 +1850,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL Param *cur = ¶m_spec->positional_required.data[i]; if (cur->type) { - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)))); } } base += i; @@ -1911,7 +1859,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL Param *cur = ¶m_spec->positional_optional.data[i].param; if (cur->type) { - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)))); } } base += i; @@ -1920,7 +1868,7 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL Param *cur = ¶m_spec->named_required.data[i]; if (cur->type) { - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)))); } } base += i; @@ -1929,16 +1877,16 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL Param *cur = ¶m_spec->named_optional.data[i].param; if (cur->type) { - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)))); } } base += i; if (param_spec->slurpy.type) { /* $type->valid($_) or croak $type->get_message($_) for @rest / values %rest */ - OP *body, *list, *loop; + OP *check, *list, *loop; - body = mktypecheck(aTHX_ declarator, base, param_spec->slurpy.name, NOT_IN_PAD, param_spec->slurpy.type); + check = mktypecheck(aTHX_ declarator, base, param_spec->slurpy.name, NOT_IN_PAD, param_spec->slurpy.type); if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') { list = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff); @@ -1947,9 +1895,9 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL list = newUNOP(OP_VALUES, 0, list); } - loop = newFOROP(0, NULL, list, body, NULL); + loop = newFOROP(0, NULL, list, check, NULL); - *prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, loop)); + op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, loop))); } } } @@ -1960,18 +1908,17 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL /* add '();' to make function return nothing by default */ /* (otherwise the invisible parameter initialization can "leak" into the return value: fun ($x) {}->("asdf", 0) == 2) */ - if (*prelude_sentinel) { + if (prelude_sentinel->op) { body = newSTATEOP(0, NULL, body); } - body = op_append_list(OP_LINESEQ, *prelude_sentinel, body); - *prelude_sentinel = NULL; + body = op_append_list(OP_LINESEQ, op_guard_relinquish(prelude_sentinel), body); /* it's go time. */ { + int runtime = spec->flags & FLAG_RUNTIME; CV *cv; - OP *const attrs = *attrs_sentinel; - *attrs_sentinel = NULL; + OP *const attrs = op_guard_relinquish(attrs_sentinel); SvREFCNT_inc_simple_void(PL_compcv); @@ -1980,16 +1927,36 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL cv = newATTRSUB( floor_ix, - saw_name ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL, - proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL, + saw_name && !runtime ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL, + proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL, attrs, body ); - register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec); + if (cv) { + register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec); + } if (saw_name) { - *pop = newOP(OP_NULL, 0); + if (!runtime) { + *pop = newOP(OP_NULL, 0); + } else { + *pop = newUNOP( + OP_ENTERSUB, OPf_STACKED, + op_append_elem( + OP_LIST, + op_append_elem( + OP_LIST, + mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)), + newUNOP( + OP_REFGEN, 0, + newSVOP(OP_ANONCODE, 0, (SV *)cv) + ) + ), + newCVREF(0, newGVOP(OP_GV, 0, gv_fetchpvs(MY_PKG "::_defun", 0, SVt_PVCV))) + ) + ); + } return KEYWORD_PLUGIN_STMT; } @@ -2004,28 +1971,123 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL } } +static int kw_flags_enter(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; + bool kw_is_utf8; + + if (!(hints = GvHV(PL_hintgv))) { + return FALSE; + } + if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) { + return FALSE; + } + sv = *psv; + kw_active = SvPV(sv, kw_active_len); + if (kw_active_len <= kw_len) { + return FALSE; + } + + kw_is_utf8 = lex_bufutf8(); + + for ( + p = kw_active; + (p = strchr(p, *kw_ptr)) && + p < kw_active + kw_active_len - kw_len; + p++ + ) { + if ( + (p == kw_active || p[-1] == ' ') && + p[kw_len] == ' ' && + memcmp(kw_ptr, p, kw_len) == 0 + ) { + ENTER; + SAVETMPS; + + SAVEDESTRUCTOR_X(sentinel_clear_void, sen); + + spec->flags = 0; + spec->reify_type = 0; + spec->shift = sentinel_mortalize(sen, newSVpvs("")); + spec->attrs = sentinel_mortalize(sen, newSVpvs("")); + +#define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \ + const char *fk_ptr_; \ + STRLEN fk_len_; \ + I32 fk_xlen_; \ + SV *fk_sv_; \ + fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \ + sv_catpvn(fk_sv_, PTR, LEN); \ + fk_ptr_ = SvPV(fk_sv_, fk_len_); \ + fk_xlen_ = fk_len_; \ + if (kw_is_utf8) { \ + fk_xlen_ = -fk_xlen_; \ + } \ + if (!((X) = hv_fetch(hints, fk_ptr_, fk_xlen_, 0))) { \ + croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \ + } \ +} STMT_END + + FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv); + spec->flags = SvIV(*psv); + + FETCH_HINTK_INTO(REIFY_, kw_ptr, kw_len, psv); + spec->reify_type = SvIV(*psv); + + FETCH_HINTK_INTO(SHIFT_, kw_ptr, kw_len, psv); + SvSetSV(spec->shift, *psv); + + FETCH_HINTK_INTO(ATTRS_, kw_ptr, kw_len, psv); + SvSetSV(spec->attrs, *psv); + +#undef FETCH_HINTK_INTO + return TRUE; + } + } + return FALSE; +} + static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) { + Sentinel sen = { NULL }; KWSpec spec; int ret; - Sentinel sen = { NULL }; - - ENTER; - SAVETMPS; - - SAVEDESTRUCTOR_X(sentinel_clear_void, sen); - if (kw_flags(aTHX_ sen, keyword_ptr, keyword_len, &spec)) { + if (kw_flags_enter(aTHX_ sen, keyword_ptr, keyword_len, &spec)) { + /* scope was entered, 'sen' and 'spec' are initialized */ ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec); + FREETMPS; + LEAVE; } else { + /* not one of our keywords, no allocation done */ ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr); } - FREETMPS; - LEAVE; - return ret; } +#ifndef SvREFCNT_dec_NN +#define SvREFCNT_dec_NN(SV) SvREFCNT_dec(SV) +#endif + +#ifndef assert_ +#ifdef DEBUGGING +#define assert_(X) assert(X), +#else +#define assert_(X) +#endif +#endif + +#ifndef gv_method_changed +#define gv_method_changed(GV) ( \ + assert_(isGV_with_GP(GV)) \ + GvREFCNT(GV) > 1 \ + ? (void)PL_sub_generation++ \ + : mro_method_changed_in(GvSTASH(GV)) \ +) +#endif + WARNINGS_RESET MODULE = Function::Parameters PACKAGE = Function::Parameters PREFIX = fp_ @@ -2033,7 +2095,7 @@ PROTOTYPES: ENABLE UV fp__cv_root(sv) - SV * sv + SV *sv PREINIT: CV *xcv; HV *hv; @@ -2044,6 +2106,32 @@ fp__cv_root(sv) OUTPUT: RETVAL +void +fp__defun(name, body) + SV *name + CV *body + PREINIT: + GV *gv; + CV *xcv; + CODE: + assert(SvTYPE(body) == SVt_PVCV); + gv = gv_fetchsv(name, GV_ADDMULTI, SVt_PVCV); + xcv = GvCV(gv); + if (xcv) { + if (!GvCVGEN(gv) && (CvROOT(xcv) || CvXSUB(xcv)) && ckWARN(WARN_REDEFINE)) { + warner(packWARN(WARN_REDEFINE), "Subroutine %"SVf" redefined", SVfARG(name)); + } + SvREFCNT_dec_NN(xcv); + } + GvCVGEN(gv) = 0; + GvASSUMECV_on(gv); + if (GvSTASH(gv)) { + gv_method_changed(gv); + } + GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(body)); + CvGV_set(body, gv); + CvANON_off(body); + BOOT: WARNINGS_ENABLE { HV *const stash = gv_stashpvs(MY_PKG, GV_ADD); @@ -2056,10 +2144,12 @@ WARNINGS_ENABLE { newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS)); newCONSTSUB(stash, "FLAG_TYPES_OK", newSViv(FLAG_TYPES_OK)); newCONSTSUB(stash, "FLAG_CHECK_TARGS", newSViv(FLAG_CHECK_TARGS)); + newCONSTSUB(stash, "FLAG_RUNTIME", newSViv(FLAG_RUNTIME)); newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS)); newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_)); newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_)); newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_)); + newCONSTSUB(stash, "HINTK_REIFY_", newSVpvs(HINTK_REIFY_)); /**/ next_keyword_plugin = PL_keyword_plugin; PL_keyword_plugin = my_keyword_plugin;