un-C< > level 2 headings
[p5sagit/Function-Parameters.git] / Parameters.xs
index d27c82c..d1aa2aa 100644 (file)
@@ -107,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;
@@ -144,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))) { \
@@ -214,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);
        }
@@ -263,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);
        }
@@ -307,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;
 
@@ -331,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",
@@ -608,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
 ) {
@@ -641,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);
@@ -712,7 +786,124 @@ static OP *mkconstpv(pTHX_ const char *p, size_t n) {
 
 #define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1)
 
-static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
+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);
+       }
+       /* 1 */ {
+               size_t n;
+               char *p = SvPV(declarator, n);
+               char *q = memchr(p, ' ', n);
+               mPUSHp(p, q ? q - p : n);
+       }
+       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;
+
+                       lim = ps->positional_required.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_required.data[i].name));
+                               }
+                       }
+
+                       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));
+                               }
+                       }
+
+                       mPUSHs(newRV_noinc((SV *)av));
+               }
+               /* 5 */ {
+                       size_t i, lim;
+                       AV *av;
+
+                       lim = ps->named_required.used;
+
+                       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));
+                               }
+                       }
+
+                       mPUSHs(newRV_noinc((SV *)av));
+               }
+               /* 6 */ {
+                       size_t i, lim;
+                       AV *av;
+
+                       lim = ps->named_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->named_optional.data[i].param.name));
+                               }
+                       }
+
+                       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_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
        ParamSpec *param_spec;
        SV *declarator;
        I32 floor_ix;
@@ -724,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);
 
@@ -732,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 */
@@ -769,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;
@@ -780,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);
@@ -795,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);
 
@@ -924,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 */ {
 
@@ -954,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;
                                }
 
@@ -972,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, "(");
@@ -1447,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);