Fixed the example showing parameter type constraints
[p5sagit/Function-Parameters.git] / Parameters.xs
index b6fe39a..4a44068 100644 (file)
@@ -85,11 +85,10 @@ 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,
@@ -103,6 +102,7 @@ enum {
 
 DEFSTRUCT(KWSpec) {
        unsigned flags;
+       I32 reify_type;
        SV *shift;
        SV *attrs;
 };
@@ -157,67 +157,6 @@ static SV *sentinel_mortalize(Sentinel sen, SV *sv) {
        return sv;
 }
 
-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 (!(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
-               ) {
-
-#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
-
-                       FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv);
-                       spec->flags = 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;
-}
-
 
 #if HAVE_PERL_VERSION(5, 17, 2)
  #define MY_OP_SLABBED(O) ((O)->op_slabbed)
@@ -296,17 +235,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;
@@ -320,7 +251,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;
@@ -328,7 +259,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;
                        }
@@ -342,7 +273,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;
                        }
@@ -566,20 +497,33 @@ 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_create_isa_type_constraint", G_SCALAR);
+       n = call_sv(sv, G_SCALAR);
        SPAGAIN;
 
        assert(n == 1);
@@ -781,13 +725,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;
@@ -865,16 +802,17 @@ static PADOFFSET parse_param(
                                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);
                }
@@ -1043,10 +981,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)) {
@@ -1183,6 +1122,9 @@ static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRL
        I32 c;
 
        declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len));
+       if (lex_bufutf8()) {
+               SvUTF8_on(declarator);
+       }
 
        lex_read_space(0);
 
@@ -2009,25 +1951,99 @@ 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;
 }
 
@@ -2065,6 +2081,7 @@ WARNINGS_ENABLE {
        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;