projects / p5sagit/Function-Parameters.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
implement custom per-keyword type reification
[p5sagit/Function-Parameters.git] / Parameters.xs
CommitLineData
db81d362 1/*
2Copyright 2012 Lukas Mai.
3
4This program is free software; you can redistribute it and/or modify it
5under the terms of either: the GNU General Public License as published
6by the Free Software Foundation; or the Artistic License.
7
8See http://dev.perl.org/licenses/ for more information.
9 */
10
11#ifdef __GNUC__
12 #if (__GNUC__ == 4 && __GNUC_MINOR__ >= 6) || __GNUC__ >= 5
13 #define PRAGMA_GCC_(X) _Pragma(#X)
14 #define PRAGMA_GCC(X) PRAGMA_GCC_(GCC X)
15 #endif
16#endif
17
18#ifndef PRAGMA_GCC
19 #define PRAGMA_GCC(X)
20#endif
21
22#ifdef DEVEL
23 #define WARNINGS_RESET PRAGMA_GCC(diagnostic pop)
24 #define WARNINGS_ENABLEW(X) PRAGMA_GCC(diagnostic warning #X)
25 #define WARNINGS_ENABLE \
26 WARNINGS_ENABLEW(-Wall) \
27 WARNINGS_ENABLEW(-Wextra) \
28 WARNINGS_ENABLEW(-Wundef) \
c3e72f35 29 /* WARNINGS_ENABLEW(-Wshadow) :-( */ \
db81d362 30 WARNINGS_ENABLEW(-Wbad-function-cast) \
31 WARNINGS_ENABLEW(-Wcast-align) \
32 WARNINGS_ENABLEW(-Wwrite-strings) \
33 /* WARNINGS_ENABLEW(-Wnested-externs) wtf? */ \
34 WARNINGS_ENABLEW(-Wstrict-prototypes) \
35 WARNINGS_ENABLEW(-Wmissing-prototypes) \
36 WARNINGS_ENABLEW(-Winline) \
37 WARNINGS_ENABLEW(-Wdisabled-optimization)
38
39#else
40 #define WARNINGS_RESET
1bc47886 41 #define WARNINGS_ENABLE
db81d362 42#endif
43
44
7dd35535 45#define PERL_NO_GET_CONTEXT
db81d362 46#include "EXTERN.h"
47#include "perl.h"
48#include "XSUB.h"
49
50#include <string.h>
51
63915d26 52
db81d362 53WARNINGS_ENABLE
54
db81d362 55
7dd35535 56#define HAVE_PERL_VERSION(R, V, S) \
57 (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
58
de013990 59#if HAVE_PERL_VERSION(5, 16, 0)
60 #define IF_HAVE_PERL_5_16(YES, NO) YES
61#else
62 #define IF_HAVE_PERL_5_16(YES, NO) NO
63#endif
64
e158cf8f 65#if 0
66 #if HAVE_PERL_VERSION(5, 17, 6)
67 #error "internal error: missing definition of KEY_my (your perl is too new)"
68 #elif HAVE_PERL_VERSION(5, 15, 8)
69 #define S_KEY_my 134
70 #elif HAVE_PERL_VERSION(5, 15, 6)
71 #define S_KEY_my 133
72 #elif HAVE_PERL_VERSION(5, 15, 5)
73 #define S_KEY_my 132
74 #elif HAVE_PERL_VERSION(5, 13, 0)
75 #define S_KEY_my 131
76 #else
77 #error "internal error: missing definition of KEY_my (your perl is too old)"
78 #endif
79#endif
80
63915d26 81
82#define MY_PKG "Function::Parameters"
83
84#define HINTK_KEYWORDS MY_PKG "/keywords"
85#define HINTK_FLAGS_ MY_PKG "/flags:"
86#define HINTK_SHIFT_ MY_PKG "/shift:"
87#define HINTK_ATTRS_ MY_PKG "/attrs:"
7193dffb 88#define HINTK_REIFY_ MY_PKG "/reify:"
63915d26 89
90#define DEFSTRUCT(T) typedef struct T T; struct T
91
0f875412 92#define UV_BITS (sizeof (UV) * CHAR_BIT)
63915d26 93
94enum {
95 FLAG_NAME_OK = 0x01,
96 FLAG_ANON_OK = 0x02,
97 FLAG_DEFAULT_ARGS = 0x04,
d8e5d540 98 FLAG_CHECK_NARGS = 0x08,
e158cf8f 99 FLAG_INVOCANT = 0x10,
51a483f8 100 FLAG_NAMED_PARAMS = 0x20,
101 FLAG_TYPES_OK = 0x40,
102 FLAG_CHECK_TARGS = 0x80
63915d26 103};
104
105DEFSTRUCT(KWSpec) {
106 unsigned flags;
7193dffb 107 I32 reify_type;
b72eb6ee 108 SV *shift;
109 SV *attrs;
63915d26 110};
db81d362 111
112static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
113
e4648f19 114DEFSTRUCT(Resource) {
115 Resource *next;
116 void *data;
117 void (*destroy)(pTHX_ void *);
118};
119
120typedef Resource *Sentinel[1];
121
122static void sentinel_clear_void(pTHX_ void *p) {
123 Resource **pp = p;
124 while (*pp) {
125 Resource *cur = *pp;
a4c13d40 126 if (cur->destroy) {
127 cur->destroy(aTHX_ cur->data);
128 }
e4648f19 129 cur->data = (void *)"no";
130 cur->destroy = NULL;
131 *pp = cur->next;
132 Safefree(cur);
133 }
134}
135
a4c13d40 136static Resource *sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) {
e4648f19 137 Resource *cur;
138
139 Newx(cur, 1, Resource);
140 cur->data = data;
141 cur->destroy = destroy;
142 cur->next = *sen;
143 *sen = cur;
a4c13d40 144
145 return cur;
146}
147
148static void sentinel_disarm(Resource *p) {
149 p->destroy = NULL;
e4648f19 150}
151
152static void my_sv_refcnt_dec_void(pTHX_ void *p) {
153 SV *sv = p;
154 SvREFCNT_dec(sv);
155}
156
157static SV *sentinel_mortalize(Sentinel sen, SV *sv) {
158 sentinel_register(sen, sv, my_sv_refcnt_dec_void);
159 return sv;
160}
161
db81d362 162
ed95eeff 163#if HAVE_PERL_VERSION(5, 17, 2)
164 #define MY_OP_SLABBED(O) ((O)->op_slabbed)
165#else
166 #define MY_OP_SLABBED(O) 0
167#endif
168
169DEFSTRUCT(OpGuard) {
170 OP *op;
171 bool needs_freed;
172};
173
174static void op_guard_init(OpGuard *p) {
175 p->op = NULL;
176 p->needs_freed = FALSE;
177}
178
179static OpGuard op_guard_transfer(OpGuard *p) {
180 OpGuard r = *p;
181 op_guard_init(p);
182 return r;
183}
184
185static OP *op_guard_relinquish(OpGuard *p) {
186 OP *o = p->op;
187 op_guard_init(p);
188 return o;
189}
190
191static void op_guard_update(OpGuard *p, OP *o) {
192 p->op = o;
193 p->needs_freed = o && !MY_OP_SLABBED(o);
194}
195
196static void op_guard_clear(pTHX_ OpGuard *p) {
197 if (p->needs_freed) {
198 op_free(p->op);
199 }
200}
201
202static void free_op_guard_void(pTHX_ void *vp) {
203 OpGuard *p = vp;
204 op_guard_clear(aTHX_ p);
205 Safefree(p);
c311cef3 206}
207
51a483f8 208static void free_op_void(pTHX_ void *vp) {
209 OP *p = vp;
210 op_free(p);
211}
212
59016bfb 213#define sv_eq_pvs(SV, S) my_sv_eq_pvn(aTHX_ SV, "" S "", sizeof (S) - 1)
c311cef3 214
59016bfb 215static int my_sv_eq_pvn(pTHX_ SV *sv, const char *p, STRLEN n) {
c311cef3 216 STRLEN sv_len;
217 const char *sv_p = SvPV(sv, sv_len);
59016bfb 218 return memcmp(sv_p, p, n) == 0;
c311cef3 219}
220
221
222#include "padop_on_crack.c.inc"
223
224
c311cef3 225enum {
226 MY_ATTR_LVALUE = 0x01,
227 MY_ATTR_METHOD = 0x02,
228 MY_ATTR_SPECIAL = 0x04
229};
230
31534187 231static void my_sv_cat_c(pTHX_ SV *sv, U32 c) {
232 char ds[UTF8_MAXBYTES + 1], *d;
67fc1ddb 233 d = (char *)uvchr_to_utf8((U8 *)ds, c);
31534187 234 if (d - ds > 1) {
235 sv_utf8_upgrade(sv);
236 }
237 sv_catpvn(sv, ds, d - ds);
238}
239
31534187 240
e6d62383 241#define MY_UNI_IDFIRST(C) isIDFIRST_uni(C)
242#define MY_UNI_IDCONT(C) isALNUM_uni(C)
31534187 243
e4648f19 244static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) {
31534187 245 bool at_start, at_substart;
246 I32 c;
e4648f19 247 SV *sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 248 if (lex_bufutf8()) {
249 SvUTF8_on(sv);
250 }
251
252 at_start = at_substart = TRUE;
253 c = lex_peek_unichar(0);
254
255 while (c != -1) {
e6d62383 256 if (at_substart ? MY_UNI_IDFIRST(c) : MY_UNI_IDCONT(c)) {
31534187 257 lex_read_unichar(0);
258 my_sv_cat_c(aTHX_ sv, c);
259 at_substart = FALSE;
260 c = lex_peek_unichar(0);
261 } else if (allow_package && !at_substart && c == '\'') {
262 lex_read_unichar(0);
263 c = lex_peek_unichar(0);
e6d62383 264 if (!MY_UNI_IDFIRST(c)) {
31534187 265 lex_stuff_pvs("'", 0);
266 break;
267 }
268 sv_catpvs(sv, "'");
269 at_substart = TRUE;
270 } else if (allow_package && (at_start || !at_substart) && c == ':') {
271 lex_read_unichar(0);
272 if (lex_peek_unichar(0) != ':') {
273 lex_stuff_pvs(":", 0);
274 break;
275 }
276 lex_read_unichar(0);
277 c = lex_peek_unichar(0);
e6d62383 278 if (!MY_UNI_IDFIRST(c)) {
31534187 279 lex_stuff_pvs("::", 0);
280 break;
281 }
282 sv_catpvs(sv, "::");
283 at_substart = TRUE;
284 } else {
285 break;
286 }
287 at_start = FALSE;
288 }
289
290 return SvCUR(sv) ? sv : NULL;
291}
292
e4648f19 293static SV *my_scan_parens_tail(pTHX_ Sentinel sen, bool keep_backslash) {
31534187 294 I32 c, nesting;
295 SV *sv;
296 line_t start;
297
298 start = CopLINE(PL_curcop);
299
e4648f19 300 sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 301 if (lex_bufutf8()) {
302 SvUTF8_on(sv);
303 }
304
305 nesting = 0;
306 for (;;) {
307 c = lex_read_unichar(0);
308 if (c == EOF) {
309 CopLINE_set(PL_curcop, start);
310 return NULL;
311 }
312
313 if (c == '\\') {
314 c = lex_read_unichar(0);
315 if (c == EOF) {
316 CopLINE_set(PL_curcop, start);
317 return NULL;
318 }
319 if (keep_backslash || (c != '(' && c != ')')) {
320 sv_catpvs(sv, "\\");
321 }
322 } else if (c == '(') {
323 nesting++;
324 } else if (c == ')') {
325 if (!nesting) {
326 break;
327 }
328 nesting--;
329 }
330
331 my_sv_cat_c(aTHX_ sv, c);
332 }
333
334 return sv;
335}
336
e4648f19 337static void my_check_prototype(pTHX_ Sentinel sen, const SV *declarator, SV *proto) {
31534187 338 char *start, *r, *w, *end;
339 STRLEN len;
340
341 /* strip spaces */
342 start = SvPV(proto, len);
343 end = start + len;
344
345 for (w = r = start; r < end; r++) {
346 if (!isSPACE(*r)) {
347 *w++ = *r;
348 }
349 }
350 *w = '\0';
351 SvCUR_set(proto, w - start);
352 end = w;
353 len = end - start;
354
355 if (!ckWARN(WARN_ILLEGALPROTO)) {
356 return;
357 }
358
359 /* check for bad characters */
360 if (strspn(start, "$@%*;[]&\\_+") != len) {
e4648f19 361 SV *dsv = sentinel_mortalize(sen, newSVpvs(""));
31534187 362 warner(
363 packWARN(WARN_ILLEGALPROTO),
364 "Illegal character in prototype for %"SVf" : %s",
365 SVfARG(declarator),
366 SvUTF8(proto)
367 ? sv_uni_display(
368 dsv,
369 proto,
370 len,
371 UNI_DISPLAY_ISPRINT
372 )
373 : pv_pretty(dsv, start, len, 60, NULL, NULL,
374 PERL_PV_ESCAPE_NONASCII
375 )
376 );
377 return;
378 }
379
380 for (r = start; r < end; r++) {
381 switch (*r) {
382 default:
383 warner(
384 packWARN(WARN_ILLEGALPROTO),
385 "Illegal character in prototype for %"SVf" : %s",
386 SVfARG(declarator), r
387 );
388 return;
389
390 case '_':
391 if (r[1] && !strchr(";@%", *r)) {
392 warner(
393 packWARN(WARN_ILLEGALPROTO),
394 "Illegal character after '_' in prototype for %"SVf" : %s",
395 SVfARG(declarator), r
396 );
397 return;
398 }
399 break;
400
401 case '@':
402 case '%':
403 if (r[1]) {
404 warner(
405 packWARN(WARN_ILLEGALPROTO),
406 "prototype after '%c' for %"SVf": %s",
407 *r, SVfARG(declarator), r + 1
408 );
409 return;
410 }
411 break;
412
413 case '\\':
414 r++;
415 if (strchr("$@%&*", *r)) {
416 break;
417 }
418 if (*r == '[') {
419 r++;
420 for (; r < end && *r != ']'; r++) {
421 if (!strchr("$@%&*", *r)) {
422 break;
423 }
424 }
425 if (*r == ']' && r[-1] != '[') {
426 break;
427 }
428 }
429 warner(
430 packWARN(WARN_ILLEGALPROTO),
431 "Illegal character after '\\' in prototype for %"SVf" : %s",
432 SVfARG(declarator), r
433 );
434 return;
435
436 case '$':
437 case '*':
438 case '&':
439 case ';':
440 case '+':
441 break;
442 }
443 }
444}
445
51a483f8 446static SV *parse_type(pTHX_ Sentinel, const SV *);
447
448static SV *parse_type_paramd(pTHX_ Sentinel sen, const SV *declarator) {
449 I32 c;
450 SV *t;
451
452 t = my_scan_word(aTHX_ sen, TRUE);
453 lex_read_space(0);
454
455 c = lex_peek_unichar(0);
456 if (c == '[') {
457 SV *u;
458
459 lex_read_unichar(0);
460 lex_read_space(0);
461 my_sv_cat_c(aTHX_ t, c);
462
463 u = parse_type(aTHX_ sen, declarator);
464 sv_catsv(t, u);
465
466 c = lex_peek_unichar(0);
467 if (c != ']') {
468 croak("In %"SVf": missing ']' after '%"SVf"'", SVfARG(declarator), SVfARG(t));
469 }
470 lex_read_unichar(0);
471 lex_read_space(0);
472
473 my_sv_cat_c(aTHX_ t, c);
474 }
475
476 return t;
477}
478
479static SV *parse_type(pTHX_ Sentinel sen, const SV *declarator) {
480 I32 c;
481 SV *t;
482
483 t = parse_type_paramd(aTHX_ sen, declarator);
484
485 c = lex_peek_unichar(0);
486 while (c == '|') {
487 SV *u;
488
489 lex_read_unichar(0);
490 lex_read_space(0);
491
492 my_sv_cat_c(aTHX_ t, c);
493 u = parse_type_paramd(aTHX_ sen, declarator);
494 sv_catsv(t, u);
495
496 c = lex_peek_unichar(0);
497 }
498
499 return t;
500}
501
7193dffb 502static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, const KWSpec *spec, SV *name) {
503 AV *type_reifiers;
504 SV *t, *sv, **psv;
51a483f8 505 int n;
506 dSP;
507
7193dffb 508 type_reifiers = get_av(MY_PKG "::type_reifiers", 0);
509 assert(type_reifiers != NULL);
510
511 if (spec->reify_type < 0 || spec->reify_type > av_len(type_reifiers)) {
512 croak("In %"SVf": internal error: reify_type [%ld] out of range [%ld]", SVfARG(declarator), (long)spec->reify_type, (long)(av_len(type_reifiers) + 1));
513 }
514
515 psv = av_fetch(type_reifiers, spec->reify_type, 0);
516 assert(psv != NULL);
517 sv = *psv;
52c18b0f 518
51a483f8 519 ENTER;
520 SAVETMPS;
521
522 PUSHMARK(SP);
523 EXTEND(SP, 1);
524 PUSHs(name);
525 PUTBACK;
526
7193dffb 527 n = call_sv(sv, G_SCALAR);
51a483f8 528 SPAGAIN;
529
530 assert(n == 1);
a8492ba4 531 /* don't warn about n being unused if assert() is compiled out */
532 n = n;
533
51a483f8 534 t = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
535
536 PUTBACK;
537 FREETMPS;
538 LEAVE;
539
540 if (!SvTRUE(t)) {
541 croak("In %"SVf": undefined type '%"SVf"'", SVfARG(declarator), SVfARG(name));
542 }
543
544 return t;
545}
546
e158cf8f 547
548DEFSTRUCT(Param) {
549 SV *name;
550 PADOFFSET padoff;
51a483f8 551 SV *type;
e158cf8f 552};
553
554DEFSTRUCT(ParamInit) {
555 Param param;
ed95eeff 556 OpGuard init;
e158cf8f 557};
558
559#define VEC(B) B ## _Vec
560
561#define DEFVECTOR(B) DEFSTRUCT(VEC(B)) { \
562 B (*data); \
563 size_t used, size; \
564}
565
566DEFVECTOR(Param);
567DEFVECTOR(ParamInit);
568
569#define DEFVECTOR_INIT(N, B) static void N(VEC(B) *p) { \
570 p->used = 0; \
571 p->size = 23; \
572 Newx(p->data, p->size, B); \
573} static void N(VEC(B) *)
574
575DEFSTRUCT(ParamSpec) {
576 Param invocant;
577 VEC(Param) positional_required;
578 VEC(ParamInit) positional_optional;
579 VEC(Param) named_required;
580 VEC(ParamInit) named_optional;
581 Param slurpy;
fc634bba 582 PADOFFSET rest_hash;
e158cf8f 583};
584
585DEFVECTOR_INIT(pv_init, Param);
586DEFVECTOR_INIT(piv_init, ParamInit);
587
588static void p_init(Param *p) {
589 p->name = NULL;
590 p->padoff = NOT_IN_PAD;
51a483f8 591 p->type = NULL;
e158cf8f 592}
593
594static void ps_init(ParamSpec *ps) {
595 p_init(&ps->invocant);
596 pv_init(&ps->positional_required);
597 piv_init(&ps->positional_optional);
598 pv_init(&ps->named_required);
599 piv_init(&ps->named_optional);
600 p_init(&ps->slurpy);
fc634bba 601 ps->rest_hash = NOT_IN_PAD;
e158cf8f 602}
603
604#define DEFVECTOR_EXTEND(N, B) static B (*N(VEC(B) *p)) { \
605 assert(p->used <= p->size); \
606 if (p->used == p->size) { \
607 const size_t n = p->size / 2 * 3 + 1; \
608 Renew(p->data, n, B); \
609 p->size = n; \
610 } \
611 return &p->data[p->used]; \
612} static B (*N(VEC(B) *))
613
614DEFVECTOR_EXTEND(pv_extend, Param);
615DEFVECTOR_EXTEND(piv_extend, ParamInit);
616
617#define DEFVECTOR_CLEAR(N, B, F) static void N(pTHX_ VEC(B) *p) { \
618 while (p->used) { \
619 p->used--; \
620 F(aTHX_ &p->data[p->used]); \
621 } \
622 Safefree(p->data); \
623 p->data = NULL; \
624 p->size = 0; \
625} static void N(pTHX_ VEC(B) *)
626
627static void p_clear(pTHX_ Param *p) {
628 p->name = NULL;
629 p->padoff = NOT_IN_PAD;
51a483f8 630 p->type = NULL;
e158cf8f 631}
632
633static void pi_clear(pTHX_ ParamInit *pi) {
634 p_clear(aTHX_ &pi->param);
ed95eeff 635 op_guard_clear(aTHX_ &pi->init);
e158cf8f 636}
637
638DEFVECTOR_CLEAR(pv_clear, Param, p_clear);
639DEFVECTOR_CLEAR(piv_clear, ParamInit, pi_clear);
640
641static void ps_clear(pTHX_ ParamSpec *ps) {
642 p_clear(aTHX_ &ps->invocant);
643
644 pv_clear(aTHX_ &ps->positional_required);
645 piv_clear(aTHX_ &ps->positional_optional);
646
647 pv_clear(aTHX_ &ps->named_required);
648 piv_clear(aTHX_ &ps->named_optional);
649
650 p_clear(aTHX_ &ps->slurpy);
651}
652
653static int ps_contains(pTHX_ const ParamSpec *ps, SV *sv) {
654 size_t i, lim;
655
656 if (ps->invocant.name && sv_eq(sv, ps->invocant.name)) {
657 return 1;
658 }
659
660 for (i = 0, lim = ps->positional_required.used; i < lim; i++) {
661 if (sv_eq(sv, ps->positional_required.data[i].name)) {
662 return 1;
663 }
664 }
665
666 for (i = 0, lim = ps->positional_optional.used; i < lim; i++) {
667 if (sv_eq(sv, ps->positional_optional.data[i].param.name)) {
668 return 1;
669 }
670 }
671
672 for (i = 0, lim = ps->named_required.used; i < lim; i++) {
673 if (sv_eq(sv, ps->named_required.data[i].name)) {
674 return 1;
675 }
676 }
677
678 for (i = 0, lim = ps->named_optional.used; i < lim; i++) {
679 if (sv_eq(sv, ps->named_optional.data[i].param.name)) {
680 return 1;
681 }
682 }
683
684 return 0;
685}
686
687static void ps_free_void(pTHX_ void *p) {
688 ps_clear(aTHX_ p);
689 Safefree(p);
690}
691
692static int args_min(pTHX_ const ParamSpec *ps, const KWSpec *ks) {
693 int n = 0;
694 if (!ps) {
695 return SvTRUE(ks->shift) ? 1 : 0;
696 }
697 if (ps->invocant.name) {
698 n++;
699 }
700 n += ps->positional_required.used;
701 n += ps->named_required.used * 2;
702 return n;
703}
704
705static int args_max(const ParamSpec *ps) {
706 int n = 0;
707 if (!ps) {
708 return -1;
709 }
710 if (ps->invocant.name) {
711 n++;
712 }
713 n += ps->positional_required.used;
714 n += ps->positional_optional.used;
715 if (ps->named_required.used || ps->named_optional.used || ps->slurpy.name) {
716 n = -1;
717 }
718 return n;
719}
720
721static size_t count_positional_params(const ParamSpec *ps) {
722 return ps->positional_required.used + ps->positional_optional.used;
723}
724
725static size_t count_named_params(const ParamSpec *ps) {
726 return ps->named_required.used + ps->named_optional.used;
727}
728
51a483f8 729static SV *my_eval(pTHX_ Sentinel sen, I32 floor, OP *op) {
730 SV *sv;
731 CV *cv;
732 dSP;
733
734 cv = newATTRSUB(floor, NULL, NULL, NULL, op);
735
736 ENTER;
737 SAVETMPS;
738
739 PUSHMARK(SP);
740 call_sv((SV *)cv, G_SCALAR | G_NOARGS);
741 SPAGAIN;
742 sv = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
743
744 PUTBACK;
745 FREETMPS;
746 LEAVE;
747
748 return sv;
749}
750
e158cf8f 751enum {
752 PARAM_INVOCANT = 0x01,
753 PARAM_NAMED = 0x02
754};
755
e158cf8f 756static PADOFFSET parse_param(
757 pTHX_
e4648f19 758 Sentinel sen,
e158cf8f 759 const SV *declarator, const KWSpec *spec, ParamSpec *param_spec,
ed95eeff 760 int *pflags, SV **pname, OpGuard *ginit, SV **ptype
e158cf8f 761) {
762 I32 c;
763 char sigil;
a4c13d40 764 SV *name;
e158cf8f 765
ed95eeff 766 assert(!ginit->op);
e158cf8f 767 *pflags = 0;
51a483f8 768 *ptype = NULL;
e158cf8f 769
770 c = lex_peek_unichar(0);
771
51a483f8 772 if (spec->flags & FLAG_TYPES_OK) {
773 if (c == '(') {
774 I32 floor;
775 OP *expr;
a4c13d40 776 Resource *expr_sentinel;
51a483f8 777
778 lex_read_unichar(0);
779
a4c13d40 780 floor = start_subparse(FALSE, 0);
781 SAVEFREESV(PL_compcv);
782 CvSPECIAL_on(PL_compcv);
51a483f8 783
784 if (!(expr = parse_fullexpr(PARSE_OPTIONAL))) {
785 croak("In %"SVf": invalid type expression", SVfARG(declarator));
786 }
ed95eeff 787 if (MY_OP_SLABBED(expr)) {
788 expr_sentinel = NULL;
789 } else {
790 expr_sentinel = sentinel_register(sen, expr, free_op_void);
791 }
51a483f8 792
793 lex_read_space(0);
794 c = lex_peek_unichar(0);
795 if (c != ')') {
796 croak("In %"SVf": missing ')' after type expression", SVfARG(declarator));
797 }
798 lex_read_unichar(0);
799 lex_read_space(0);
800
a4c13d40 801 SvREFCNT_inc_simple_void(PL_compcv);
ed95eeff 802 if (expr_sentinel) {
803 sentinel_disarm(expr_sentinel);
804 }
51a483f8 805 *ptype = my_eval(aTHX_ sen, floor, expr);
52c18b0f 806 if (!SvROK(*ptype)) {
7193dffb 807 *ptype = reify_type(aTHX_ sen, declarator, spec, *ptype);
52c18b0f 808 }
51a483f8 809 if (!sv_isobject(*ptype)) {
810 croak("In %"SVf": (%"SVf") doesn't look like a type object", SVfARG(declarator), SVfARG(*ptype));
811 }
812
813 c = lex_peek_unichar(0);
e6d62383 814 } else if (MY_UNI_IDFIRST(c)) {
a4c13d40 815 *ptype = parse_type(aTHX_ sen, declarator);
7193dffb 816 *ptype = reify_type(aTHX_ sen, declarator, spec, *ptype);
51a483f8 817
818 c = lex_peek_unichar(0);
819 }
820 }
821
e158cf8f 822 if (c == ':') {
823 lex_read_unichar(0);
824 lex_read_space(0);
825
826 *pflags |= PARAM_NAMED;
827
828 c = lex_peek_unichar(0);
829 }
830
831 if (c == -1) {
832 croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
833 }
51a483f8 834
e158cf8f 835 if (!(c == '$' || c == '@' || c == '%')) {
836 croak("In %"SVf": unexpected '%c' in parameter list (expecting a sigil)", SVfARG(declarator), (int)c);
837 }
838
839 sigil = c;
840
841 lex_read_unichar(0);
842 lex_read_space(0);
843
e4648f19 844 if (!(name = my_scan_word(aTHX_ sen, FALSE))) {
e158cf8f 845 croak("In %"SVf": missing identifier after '%c'", SVfARG(declarator), sigil);
846 }
847 sv_insert(name, 0, 0, &sigil, 1);
848 *pname = name;
849
850 lex_read_space(0);
851 c = lex_peek_unichar(0);
852
853 if (c == '=') {
854 lex_read_unichar(0);
855 lex_read_space(0);
856
857
858 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
859 param_spec->invocant.name = spec->shift;
860 param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
861 }
862
ed95eeff 863 op_guard_update(ginit, parse_termexpr(0));
e158cf8f 864
865 lex_read_space(0);
866 c = lex_peek_unichar(0);
867 }
868
869 if (c == ':') {
870 *pflags |= PARAM_INVOCANT;
871 lex_read_unichar(0);
872 lex_read_space(0);
873 } else if (c == ',') {
874 lex_read_unichar(0);
875 lex_read_space(0);
876 } else if (c != ')') {
877 if (c == -1) {
878 croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
879 }
880 croak("In %"SVf": unexpected '%c' in parameter list (expecting ',')", SVfARG(declarator), (int)c);
881 }
882
883 return pad_add_name_sv(*pname, IF_HAVE_PERL_5_16(padadd_NO_DUP_CHECK, 0), NULL, NULL);
884}
885
886static OP *my_var_g(pTHX_ I32 type, I32 flags, PADOFFSET padoff) {
887 OP *var = newOP(type, flags);
888 var->op_targ = padoff;
889 return var;
890}
891
892static OP *my_var(pTHX_ I32 flags, PADOFFSET padoff) {
893 return my_var_g(aTHX_ OP_PADSV, flags, padoff);
894}
895
fc634bba 896static OP *mkhvelem(pTHX_ PADOFFSET h, OP *k) {
897 OP *hv = my_var_g(aTHX_ OP_PADHV, OPf_REF, h);
898 return newBINOP(OP_HELEM, 0, hv, k);
899}
900
901static OP *mkconstsv(pTHX_ SV *sv) {
902 return newSVOP(OP_CONST, 0, sv);
903}
904
905static OP *mkconstiv(pTHX_ IV i) {
906 return mkconstsv(aTHX_ newSViv(i));
907}
908
909static OP *mkconstpv(pTHX_ const char *p, size_t n) {
910 return mkconstsv(aTHX_ newSVpv(p, n));
911}
912
913#define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1)
914
51a483f8 915static OP *mktypecheck(pTHX_ const SV *declarator, int nr, SV *name, PADOFFSET padoff, SV *type) {
916 /* $type->check($value) or Carp::croak "...: " . $type->get_message($value) */
a8492ba4 917 OP *chk, *err, *msg, *xcroak;
51a483f8 918
919 err = mkconstsv(aTHX_ newSVpvf("In %"SVf": parameter %d (%"SVf"): ", SVfARG(declarator), nr, SVfARG(name)));
920 {
921 OP *args = NULL;
922
923 args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
924 args = op_append_elem(
925 OP_LIST, args,
926 padoff == NOT_IN_PAD
927 ? S_newDEFSVOP(aTHX)
928 : my_var(aTHX_ 0, padoff)
929 );
930 args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("get_message")));
931
932 msg = args;
933 msg->op_type = OP_ENTERSUB;
934 msg->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
935 msg->op_flags |= OPf_STACKED;
936 }
937
938 msg = newBINOP(OP_CONCAT, 0, err, msg);
939
940 xcroak = newCVREF(
941 OPf_WANT_SCALAR,
942 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
943 );
944 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
945
946 {
947 OP *args = NULL;
948
949 args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
950 args = op_append_elem(
951 OP_LIST, args,
952 padoff == NOT_IN_PAD
953 ? S_newDEFSVOP(aTHX)
954 : my_var(aTHX_ 0, padoff)
955 );
956 args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("check")));
957
958 chk = args;
959 chk->op_type = OP_ENTERSUB;
960 chk->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
961 chk->op_flags |= OPf_STACKED;
962 }
963
964 chk = newLOGOP(OP_OR, 0, chk, xcroak);
965 return chk;
966}
967
968static OP *mktypecheckp(pTHX_ const SV *declarator, int nr, const Param *param) {
969 return mktypecheck(aTHX_ declarator, nr, param->name, param->padoff, param->type);
970}
971
53c979f0 972static void register_info(pTHX_ UV key, SV *declarator, const KWSpec *kws, const ParamSpec *ps) {
973 dSP;
974
975 ENTER;
976 SAVETMPS;
977
978 PUSHMARK(SP);
51a483f8 979 EXTEND(SP, 10);
53c979f0 980
981 /* 0 */ {
982 mPUSHu(key);
983 }
984 /* 1 */ {
fd727b3e 985 STRLEN n;
53c979f0 986 char *p = SvPV(declarator, n);
987 char *q = memchr(p, ' ', n);
fd727b3e 988 SV *tmp = newSVpvn_utf8(p, q ? (size_t)(q - p) : n, SvUTF8(declarator));
989 mPUSHs(tmp);
53c979f0 990 }
991 if (!ps) {
992 if (SvTRUE(kws->shift)) {
993 PUSHs(kws->shift);
994 } else {
995 PUSHmortal;
996 }
51a483f8 997 PUSHmortal;
53c979f0 998 mPUSHs(newRV_noinc((SV *)newAV()));
999 mPUSHs(newRV_noinc((SV *)newAV()));
1000 mPUSHs(newRV_noinc((SV *)newAV()));
1001 mPUSHs(newRV_noinc((SV *)newAV()));
1002 mPUSHp("@_", 2);
51a483f8 1003 PUSHmortal;
53c979f0 1004 } else {
51a483f8 1005 /* 2, 3 */ {
53c979f0 1006 if (ps->invocant.name) {
1007 PUSHs(ps->invocant.name);
51a483f8 1008 if (ps->invocant.type) {
1009 PUSHs(ps->invocant.type);
1010 } else {
1011 PUSHmortal;
1012 }
53c979f0 1013 } else {
1014 PUSHmortal;
51a483f8 1015 PUSHmortal;
53c979f0 1016 }
1017 }
51a483f8 1018 /* 4 */ {
53c979f0 1019 size_t i, lim;
1020 AV *av;
1021
1022 lim = ps->positional_required.used;
1023
1024 av = newAV();
1025 if (lim) {
51a483f8 1026 av_extend(av, (lim - 1) * 2);
53c979f0 1027 for (i = 0; i < lim; i++) {
51a483f8 1028 Param *cur = &ps->positional_required.data[i];
1029 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1030 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1031 }
1032 }
1033
1034 mPUSHs(newRV_noinc((SV *)av));
1035 }
51a483f8 1036 /* 5 */ {
53c979f0 1037 size_t i, lim;
1038 AV *av;
1039
1040 lim = ps->positional_optional.used;
1041
1042 av = newAV();
1043 if (lim) {
51a483f8 1044 av_extend(av, (lim - 1) * 2);
53c979f0 1045 for (i = 0; i < lim; i++) {
51a483f8 1046 Param *cur = &ps->positional_optional.data[i].param;
1047 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1048 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1049 }
1050 }
1051
1052 mPUSHs(newRV_noinc((SV *)av));
1053 }
51a483f8 1054 /* 6 */ {
53c979f0 1055 size_t i, lim;
1056 AV *av;
1057
1058 lim = ps->named_required.used;
1059
1060 av = newAV();
1061 if (lim) {
51a483f8 1062 av_extend(av, (lim - 1) * 2);
53c979f0 1063 for (i = 0; i < lim; i++) {
51a483f8 1064 Param *cur = &ps->named_required.data[i];
1065 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1066 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1067 }
1068 }
1069
1070 mPUSHs(newRV_noinc((SV *)av));
1071 }
51a483f8 1072 /* 7 */ {
53c979f0 1073 size_t i, lim;
1074 AV *av;
1075
1076 lim = ps->named_optional.used;
1077
1078 av = newAV();
1079 if (lim) {
51a483f8 1080 av_extend(av, (lim - 1) * 2);
53c979f0 1081 for (i = 0; i < lim; i++) {
51a483f8 1082 Param *cur = &ps->named_optional.data[i].param;
1083 av_push(av, SvREFCNT_inc_simple_NN(cur->name));
1084 av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
53c979f0 1085 }
1086 }
1087
1088 mPUSHs(newRV_noinc((SV *)av));
1089 }
51a483f8 1090 /* 8, 9 */ {
53c979f0 1091 if (ps->slurpy.name) {
1092 PUSHs(ps->slurpy.name);
51a483f8 1093 if (ps->slurpy.type) {
1094 PUSHs(ps->slurpy.type);
1095 } else {
1096 PUSHmortal;
1097 }
53c979f0 1098 } else {
1099 PUSHmortal;
51a483f8 1100 PUSHmortal;
53c979f0 1101 }
1102 }
1103 }
1104 PUTBACK;
1105
1106 call_pv(MY_PKG "::_register_info", G_VOID);
1107
1108 FREETMPS;
1109 LEAVE;
1110}
1111
e4648f19 1112static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
e158cf8f 1113 ParamSpec *param_spec;
c311cef3 1114 SV *declarator;
1115 I32 floor_ix;
63915d26 1116 int save_ix;
c311cef3 1117 SV *saw_name;
ed95eeff 1118 OpGuard *prelude_sentinel;
c311cef3 1119 SV *proto;
ed95eeff 1120 OpGuard *attrs_sentinel;
1121 OP *body;
c311cef3 1122 unsigned builtin_attrs;
db81d362 1123 I32 c;
1124
e4648f19 1125 declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len));
fd727b3e 1126 if (lex_bufutf8()) {
1127 SvUTF8_on(declarator);
1128 }
db81d362 1129
db81d362 1130 lex_read_space(0);
1131
c311cef3 1132 builtin_attrs = 0;
1133
db81d362 1134 /* function name */
c311cef3 1135 saw_name = NULL;
e4648f19 1136 if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ sen, TRUE))) {
c311cef3 1137
1138 if (PL_parser->expect != XSTATE) {
1139 /* bail out early so we don't predeclare $saw_name */
1140 croak("In %"SVf": I was expecting a function body, not \"%"SVf"\"", SVfARG(declarator), SVfARG(saw_name));
1141 }
1142
db81d362 1143 sv_catpvs(declarator, " ");
c311cef3 1144 sv_catsv(declarator, saw_name);
1145
1146 if (
1147 sv_eq_pvs(saw_name, "BEGIN") ||
1148 sv_eq_pvs(saw_name, "END") ||
1149 sv_eq_pvs(saw_name, "INIT") ||
1150 sv_eq_pvs(saw_name, "CHECK") ||
1151 sv_eq_pvs(saw_name, "UNITCHECK")
1152 ) {
1153 builtin_attrs |= MY_ATTR_SPECIAL;
1154 }
1155
db81d362 1156 lex_read_space(0);
63915d26 1157 } else if (!(spec->flags & FLAG_ANON_OK)) {
31534187 1158 croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - PL_parser->bufptr), PL_parser->bufptr);
db81d362 1159 } else {
1160 sv_catpvs(declarator, " (anon)");
1161 }
1162
63915d26 1163 /* we're a subroutine declaration */
c311cef3 1164 floor_ix = start_subparse(FALSE, saw_name ? 0 : CVf_ANON);
1165 SAVEFREESV(PL_compcv);
1166
63915d26 1167 /* create outer block: '{' */
1168 save_ix = S_block_start(aTHX_ TRUE);
1169
1e0f1595 1170 /* initialize synthetic optree */
ed95eeff 1171 Newx(prelude_sentinel, 1, OpGuard);
1172 op_guard_init(prelude_sentinel);
1173 sentinel_register(sen, prelude_sentinel, free_op_guard_void);
1e0f1595 1174
db81d362 1175 /* parameters */
e158cf8f 1176 param_spec = NULL;
63915d26 1177
db81d362 1178 c = lex_peek_unichar(0);
1179 if (c == '(') {
ed95eeff 1180 OpGuard *init_sentinel;
e158cf8f 1181
ed95eeff 1182 Newx(init_sentinel, 1, OpGuard);
1183 op_guard_init(init_sentinel);
1184 sentinel_register(sen, init_sentinel, free_op_guard_void);
e158cf8f 1185
1186 Newx(param_spec, 1, ParamSpec);
1187 ps_init(param_spec);
e4648f19 1188 sentinel_register(sen, param_spec, ps_free_void);
db81d362 1189
1190 lex_read_unichar(0);
1191 lex_read_space(0);
1192
e158cf8f 1193 while ((c = lex_peek_unichar(0)) != ')') {
1194 int flags;
51a483f8 1195 SV *name, *type;
e158cf8f 1196 char sigil;
1197 PADOFFSET padoff;
c311cef3 1198
51a483f8 1199 padoff = parse_param(aTHX_ sen, declarator, spec, param_spec, &flags, &name, init_sentinel, &type);
c311cef3 1200
e158cf8f 1201 S_intro_my(aTHX);
63915d26 1202
e158cf8f 1203 sigil = SvPV_nolen(name)[0];
db81d362 1204
e158cf8f 1205 /* internal consistency */
1206 if (flags & PARAM_NAMED) {
1207 if (flags & PARAM_INVOCANT) {
1208 croak("In %"SVf": invocant %"SVf" can't be a named parameter", SVfARG(declarator), SVfARG(name));
db81d362 1209 }
e158cf8f 1210 if (sigil != '$') {
1211 croak("In %"SVf": named parameter %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
db81d362 1212 }
e158cf8f 1213 } else if (flags & PARAM_INVOCANT) {
ed95eeff 1214 if (init_sentinel->op) {
e158cf8f 1215 croak("In %"SVf": invocant %"SVf" can't have a default value", SVfARG(declarator), SVfARG(name));
db81d362 1216 }
e158cf8f 1217 if (sigil != '$') {
1218 croak("In %"SVf": invocant %"SVf" can't be a%s", SVfARG(declarator), SVfARG(name), sigil == '@' ? "n array" : " hash");
1219 }
ed95eeff 1220 } else if (sigil != '$' && init_sentinel->op) {
e158cf8f 1221 croak("In %"SVf": %s %"SVf" can't have a default value", SVfARG(declarator), sigil == '@' ? "array" : "hash", SVfARG(name));
1222 }
db81d362 1223
e158cf8f 1224 /* external constraints */
1225 if (param_spec->slurpy.name) {
1226 croak("In %"SVf": I was expecting \")\" after \"%"SVf"\", not \"%"SVf"\"", SVfARG(declarator), SVfARG(param_spec->slurpy.name), SVfARG(name));
1227 }
1228 if (sigil != '$') {
ed95eeff 1229 assert(!init_sentinel->op);
e158cf8f 1230 param_spec->slurpy.name = name;
1231 param_spec->slurpy.padoff = padoff;
51a483f8 1232 param_spec->slurpy.type = type;
e158cf8f 1233 continue;
1234 }
d8e5d540 1235
e158cf8f 1236 if (!(flags & PARAM_NAMED) && count_named_params(param_spec)) {
1237 croak("In %"SVf": positional parameter %"SVf" can't appear after named parameter %"SVf"", SVfARG(declarator), SVfARG(name), SVfARG((param_spec->named_required.used ? param_spec->named_required.data[0] : param_spec->named_optional.data[0].param).name));
1238 }
d8e5d540 1239
e158cf8f 1240 if (flags & PARAM_INVOCANT) {
1241 if (param_spec->invocant.name) {
1242 croak("In %"SVf": invalid double invocants %"SVf", %"SVf"", SVfARG(declarator), SVfARG(param_spec->invocant.name), SVfARG(name));
1243 }
1244 if (count_positional_params(param_spec) || count_named_params(param_spec)) {
1245 croak("In %"SVf": invocant %"SVf" must be first in parameter list", SVfARG(declarator), SVfARG(name));
63915d26 1246 }
e158cf8f 1247 if (!(spec->flags & FLAG_INVOCANT)) {
1248 croak("In %"SVf": invocant %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1249 }
1250 param_spec->invocant.name = name;
1251 param_spec->invocant.padoff = padoff;
51a483f8 1252 param_spec->invocant.type = type;
e158cf8f 1253 continue;
1254 }
63915d26 1255
ed95eeff 1256 if (init_sentinel->op && !(spec->flags & FLAG_DEFAULT_ARGS)) {
e158cf8f 1257 croak("In %"SVf": default argument for %"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1258 }
1e0f1595 1259
e158cf8f 1260 if (ps_contains(aTHX_ param_spec, name)) {
1261 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(name));
1262 }
1e0f1595 1263
e158cf8f 1264 if (flags & PARAM_NAMED) {
1265 if (!(spec->flags & FLAG_NAMED_PARAMS)) {
1266 croak("In %"SVf": named parameter :%"SVf" not allowed here", SVfARG(declarator), SVfARG(name));
1e0f1595 1267 }
1268
ed95eeff 1269 if (init_sentinel->op) {
e158cf8f 1270 ParamInit *pi = piv_extend(&param_spec->named_optional);
1271 pi->param.name = name;
1272 pi->param.padoff = padoff;
51a483f8 1273 pi->param.type = type;
ed95eeff 1274 pi->init = op_guard_transfer(init_sentinel);
e158cf8f 1275 param_spec->named_optional.used++;
1276 } else {
67fc1ddb 1277 Param *p;
1278
e158cf8f 1279 if (param_spec->positional_optional.used) {
1280 croak("In %"SVf": can't combine optional positional (%"SVf") and required named (%"SVf") parameters", SVfARG(declarator), SVfARG(param_spec->positional_optional.data[0].param.name), SVfARG(name));
1281 }
d8e5d540 1282
67fc1ddb 1283 p = pv_extend(&param_spec->named_required);
e158cf8f 1284 p->name = name;
1285 p->padoff = padoff;
51a483f8 1286 p->type = type;
e158cf8f 1287 param_spec->named_required.used++;
1288 }
1289 } else {
ed95eeff 1290 if (init_sentinel->op || param_spec->positional_optional.used) {
e158cf8f 1291 ParamInit *pi = piv_extend(&param_spec->positional_optional);
1292 pi->param.name = name;
1293 pi->param.padoff = padoff;
51a483f8 1294 pi->param.type = type;
ed95eeff 1295 pi->init = op_guard_transfer(init_sentinel);
e158cf8f 1296 param_spec->positional_optional.used++;
1297 } else {
1298 Param *p = pv_extend(&param_spec->positional_required);
1299 p->name = name;
1300 p->padoff = padoff;
51a483f8 1301 p->type = type;
e158cf8f 1302 param_spec->positional_required.used++;
db81d362 1303 }
1304 }
1305
e158cf8f 1306 }
1307 lex_read_unichar(0);
1308 lex_read_space(0);
db81d362 1309
e158cf8f 1310 if (!param_spec->invocant.name && SvTRUE(spec->shift)) {
1311 if (ps_contains(aTHX_ param_spec, spec->shift)) {
1312 croak("In %"SVf": %"SVf" can't appear twice in the same parameter list", SVfARG(declarator), SVfARG(spec->shift));
db81d362 1313 }
e158cf8f 1314
1315 param_spec->invocant.name = spec->shift;
1316 param_spec->invocant.padoff = pad_add_name_sv(param_spec->invocant.name, 0, NULL, NULL);
db81d362 1317 }
1318 }
1319
1320 /* prototype */
c311cef3 1321 proto = NULL;
db81d362 1322 c = lex_peek_unichar(0);
1323 if (c == ':') {
1324 lex_read_unichar(0);
1325 lex_read_space(0);
1326
1327 c = lex_peek_unichar(0);
1328 if (c != '(') {
c311cef3 1329 lex_stuff_pvs(":", 0);
1330 c = ':';
db81d362 1331 } else {
31534187 1332 lex_read_unichar(0);
e4648f19 1333 if (!(proto = my_scan_parens_tail(aTHX_ sen, FALSE))) {
f34187b8 1334 croak("In %"SVf": prototype not terminated", SVfARG(declarator));
db81d362 1335 }
e4648f19 1336 my_check_prototype(aTHX_ sen, declarator, proto);
db81d362 1337 lex_read_space(0);
c311cef3 1338 c = lex_peek_unichar(0);
514bcaa6 1339 if (!(c == ':' || c == '{')) {
1340 lex_stuff_pvs(":", 0);
1341 c = ':';
1342 }
db81d362 1343 }
1344 }
1345
db81d362 1346 /* attributes */
ed95eeff 1347 Newx(attrs_sentinel, 1, OpGuard);
1348 op_guard_init(attrs_sentinel);
1349 sentinel_register(sen, attrs_sentinel, free_op_guard_void);
c311cef3 1350
63915d26 1351 if (c == ':' || c == '{') /* '}' - hi, vim */ {
c311cef3 1352
1353 /* kludge default attributes in */
1354 if (SvTRUE(spec->attrs) && SvPV_nolen(spec->attrs)[0] == ':') {
1355 lex_stuff_sv(spec->attrs, 0);
1356 c = ':';
1357 }
b72eb6ee 1358
db81d362 1359 if (c == ':') {
db81d362 1360 lex_read_unichar(0);
1361 lex_read_space(0);
db81d362 1362 c = lex_peek_unichar(0);
c311cef3 1363
1364 for (;;) {
1365 SV *attr;
1366
e4648f19 1367 if (!(attr = my_scan_word(aTHX_ sen, FALSE))) {
c311cef3 1368 break;
db81d362 1369 }
c311cef3 1370
db81d362 1371 lex_read_space(0);
1372 c = lex_peek_unichar(0);
c311cef3 1373
1374 if (c != '(') {
1375 if (sv_eq_pvs(attr, "lvalue")) {
1376 builtin_attrs |= MY_ATTR_LVALUE;
1377 attr = NULL;
1378 } else if (sv_eq_pvs(attr, "method")) {
1379 builtin_attrs |= MY_ATTR_METHOD;
1380 attr = NULL;
1381 }
1382 } else {
31534187 1383 SV *sv;
1384 lex_read_unichar(0);
e4648f19 1385 if (!(sv = my_scan_parens_tail(aTHX_ sen, TRUE))) {
c311cef3 1386 croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator));
1387 }
31534187 1388 sv_catpvs(attr, "(");
c311cef3 1389 sv_catsv(attr, sv);
31534187 1390 sv_catpvs(attr, ")");
c311cef3 1391
1392 lex_read_space(0);
1393 c = lex_peek_unichar(0);
1394 }
1395
1396 if (attr) {
ed95eeff 1397 op_guard_update(attrs_sentinel, op_append_elem(OP_LIST, attrs_sentinel->op, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(attr))));
c311cef3 1398 }
1399
1400 if (c == ':') {
1401 lex_read_unichar(0);
1402 lex_read_space(0);
1403 c = lex_peek_unichar(0);
1404 }
db81d362 1405 }
1406 }
1407 }
1408
1409 /* body */
63915d26 1410 if (c != '{') /* '}' - hi, vim */ {
85bc3fbd 1411 croak("In %"SVf": I was expecting a function body, not \"%c\"", SVfARG(declarator), (int)c);
db81d362 1412 }
c311cef3 1413
63915d26 1414 /* surprise predeclaration! */
1415 if (saw_name) {
1416 /* 'sub NAME (PROTO);' to make name/proto known to perl before it
1417 starts parsing the body */
1418 const I32 sub_ix = start_subparse(FALSE, 0);
1419 SAVEFREESV(PL_compcv);
1420
1421 SvREFCNT_inc_simple_void(PL_compcv);
1422
1423 newATTRSUB(
1424 sub_ix,
fc634bba 1425 mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)),
1426 proto ? mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(proto)) : NULL,
63915d26 1427 NULL,
1428 NULL
1429 );
1430 }
1431
c311cef3 1432 if (builtin_attrs & MY_ATTR_LVALUE) {
1433 CvLVALUE_on(PL_compcv);
db81d362 1434 }
c311cef3 1435 if (builtin_attrs & MY_ATTR_METHOD) {
1436 CvMETHOD_on(PL_compcv);
1437 }
1438 if (builtin_attrs & MY_ATTR_SPECIAL) {
1439 CvSPECIAL_on(PL_compcv);
db81d362 1440 }
1441
e158cf8f 1442 /* check number of arguments */
1e0f1595 1443 if (spec->flags & FLAG_CHECK_NARGS) {
e158cf8f 1444 int amin, amax;
abccbe86 1445
e158cf8f 1446 amin = args_min(aTHX_ param_spec, spec);
1447 if (amin > 0) {
51a483f8 1448 OP *chk, *cond, *err, *xcroak;
63915d26 1449
fc634bba 1450 err = mkconstsv(aTHX_ newSVpvf("Not enough arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amin));
1451 err = newBINOP(
1452 OP_CONCAT, 0,
1453 err,
1454 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1455 );
1456 err = newBINOP(
1457 OP_CONCAT, 0,
1458 err,
1459 mkconstpvs(")")
1460 );
63915d26 1461
51a483f8 1462 xcroak = newCVREF(OPf_WANT_SCALAR,
1463 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
1e0f1595 1464 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1465 op_append_elem(OP_LIST, err, xcroak));
63915d26 1466
1e0f1595 1467 cond = newBINOP(OP_LT, 0,
5f50e017 1468 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1469 mkconstiv(aTHX_ amin));
1e0f1595 1470 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1471
ed95eeff 1472 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk)));
1e0f1595 1473 }
abccbe86 1474
e158cf8f 1475 amax = args_max(param_spec);
1476 if (amax >= 0) {
51a483f8 1477 OP *chk, *cond, *err, *xcroak;
63915d26 1478
fc634bba 1479 err = mkconstsv(aTHX_ newSVpvf("Too many arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amax));
1480 err = newBINOP(
1481 OP_CONCAT, 0,
1482 err,
1483 newAVREF(newGVOP(OP_GV, 0, PL_defgv))
1484 );
1485 err = newBINOP(
1486 OP_CONCAT, 0,
1487 err,
1488 mkconstpvs(")")
1489 );
63915d26 1490
51a483f8 1491 xcroak = newCVREF(
fc634bba 1492 OPf_WANT_SCALAR,
1493 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1494 );
1e0f1595 1495 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1496 op_append_elem(OP_LIST, err, xcroak));
63915d26 1497
fc634bba 1498 cond = newBINOP(
1499 OP_GT, 0,
1500 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1501 mkconstiv(aTHX_ amax)
1502 );
1e0f1595 1503 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1504
ed95eeff 1505 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk)));
1e0f1595 1506 }
e158cf8f 1507
1508 if (param_spec && (count_named_params(param_spec) || (param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%'))) {
51a483f8 1509 OP *chk, *cond, *err, *xcroak;
e158cf8f 1510 const UV fixed = count_positional_params(param_spec) + !!param_spec->invocant.name;
63915d26 1511
fc634bba 1512 err = mkconstsv(aTHX_ newSVpvf("Odd number of paired arguments for %"SVf"", SVfARG(declarator)));
63915d26 1513
51a483f8 1514 xcroak = newCVREF(
fc634bba 1515 OPf_WANT_SCALAR,
1516 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1517 );
1e0f1595 1518 err = newUNOP(OP_ENTERSUB, OPf_STACKED,
51a483f8 1519 op_append_elem(OP_LIST, err, xcroak));
63915d26 1520
1e0f1595 1521 cond = newBINOP(OP_GT, 0,
5f50e017 1522 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1523 mkconstiv(aTHX_ fixed));
e158cf8f 1524 cond = newLOGOP(OP_AND, 0,
fc634bba 1525 cond,
1526 newBINOP(OP_MODULO, 0,
1527 fixed
1528 ? newBINOP(OP_SUBTRACT, 0,
1529 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1530 mkconstiv(aTHX_ fixed))
1531 : newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
1532 mkconstiv(aTHX_ 2)));
1e0f1595 1533 chk = newLOGOP(OP_AND, 0, cond, err);
63915d26 1534
ed95eeff 1535 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, chk)));
c311cef3 1536 }
1e0f1595 1537 }
c311cef3 1538
e158cf8f 1539 if (!param_spec) {
1540 /* my $invocant = shift; */
1541 if (SvTRUE(spec->shift)) {
1542 OP *var;
abccbe86 1543
e158cf8f 1544 var = my_var(
1545 aTHX_
1546 OPf_MOD | (OPpLVAL_INTRO << 8),
1547 pad_add_name_sv(spec->shift, 0, NULL, NULL)
1548 );
1549 var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
c311cef3 1550
ed95eeff 1551 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
e158cf8f 1552 }
1553 } else {
1554 /* my $invocant = shift; */
1555 if (param_spec->invocant.name) {
1556 OP *var;
c311cef3 1557
e158cf8f 1558 var = my_var(
1559 aTHX_
1560 OPf_MOD | (OPpLVAL_INTRO << 8),
1561 param_spec->invocant.padoff
1562 );
1563 var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
1e0f1595 1564
ed95eeff 1565 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
51a483f8 1566
1567 if (param_spec->invocant.type && (spec->flags & FLAG_CHECK_TARGS)) {
ed95eeff 1568 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, 0, &param_spec->invocant))));
51a483f8 1569 }
c311cef3 1570 }
1571
e158cf8f 1572 /* my (...) = @_; */
1573 {
1574 OP *lhs;
1575 size_t i, lim;
63915d26 1576
e158cf8f 1577 lhs = NULL;
63915d26 1578
e158cf8f 1579 for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1580 OP *const var = my_var(
1581 aTHX_
1582 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1583 param_spec->positional_required.data[i].padoff
1584 );
1585 lhs = op_append_elem(OP_LIST, lhs, var);
1586 }
63915d26 1587
e158cf8f 1588 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1589 OP *const var = my_var(
1590 aTHX_
1591 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
1592 param_spec->positional_optional.data[i].param.padoff
1593 );
1594 lhs = op_append_elem(OP_LIST, lhs, var);
1595 }
63915d26 1596
fc634bba 1597 {
1598 PADOFFSET padoff;
1599 I32 type;
1600 bool slurpy_hash;
1601
1602 /*
1603 * cases:
1604 * 1) no named params
1605 * 1.1) slurpy
1606 * => put it in
1607 * 1.2) no slurpy
1608 * => nop
1609 * 2) named params
1610 * 2.1) no slurpy
1611 * => synthetic %{rest}
1612 * 2.2) slurpy is a hash
1613 * => put it in
1614 * 2.3) slurpy is an array
1615 * => synthetic %{rest}
1616 * remember to declare array later
1617 */
1618
1619 slurpy_hash = param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%';
1620 if (!count_named_params(param_spec)) {
1621 if (param_spec->slurpy.name) {
1622 padoff = param_spec->slurpy.padoff;
1623 type = slurpy_hash ? OP_PADHV : OP_PADAV;
1624 } else {
1625 padoff = NOT_IN_PAD;
1626 type = OP_PADSV;
1627 }
1628 } else if (slurpy_hash) {
1629 padoff = param_spec->slurpy.padoff;
1630 type = OP_PADHV;
e158cf8f 1631 } else {
fc634bba 1632 padoff = param_spec->rest_hash = pad_add_name_pvs("%{rest}", 0, NULL, NULL);
1633 type = OP_PADHV;
1634 }
1635
1636 if (padoff != NOT_IN_PAD) {
e158cf8f 1637 OP *const var = my_var_g(
1638 aTHX_
fc634bba 1639 type,
e158cf8f 1640 OPf_WANT_LIST | (OPpLVAL_INTRO << 8),
fc634bba 1641 padoff
e158cf8f 1642 );
fc634bba 1643
e158cf8f 1644 lhs = op_append_elem(OP_LIST, lhs, var);
fc634bba 1645
1646 if (type == OP_PADHV) {
1647 param_spec->rest_hash = padoff;
1648 }
e158cf8f 1649 }
1650 }
63915d26 1651
e158cf8f 1652 if (lhs) {
1653 OP *rhs;
1654 lhs->op_flags |= OPf_PARENS;
1655 rhs = newAVREF(newGVOP(OP_GV, 0, PL_defgv));
1656
ed95eeff 1657 op_guard_update(prelude_sentinel, op_append_list(
1658 OP_LINESEQ, prelude_sentinel->op,
e158cf8f 1659 newSTATEOP(
1660 0, NULL,
1661 newASSIGNOP(OPf_STACKED, lhs, 0, rhs)
1662 )
ed95eeff 1663 ));
e158cf8f 1664 }
1665 }
63915d26 1666
fc634bba 1667 /* default positional arguments */
e158cf8f 1668 {
1669 size_t i, lim, req;
1670 OP *nest;
63915d26 1671
e158cf8f 1672 nest = NULL;
63915d26 1673
e158cf8f 1674 req = param_spec->positional_required.used;
1675 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1676 ParamInit *cur = &param_spec->positional_optional.data[i];
1677 OP *var, *cond;
63915d26 1678
e158cf8f 1679 cond = newBINOP(
1680 OP_LT, 0,
1681 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
fc634bba 1682 mkconstiv(aTHX_ req + i + 1)
e158cf8f 1683 );
63915d26 1684
e158cf8f 1685 var = my_var(aTHX_ 0, cur->param.padoff);
63915d26 1686
e158cf8f 1687 nest = op_append_list(
1688 OP_LINESEQ, nest,
ed95eeff 1689 newASSIGNOP(OPf_STACKED, var, 0, op_guard_relinquish(&cur->init))
e158cf8f 1690 );
e158cf8f 1691 nest = newCONDOP(
1692 0,
1693 cond,
1694 nest,
1695 NULL
1696 );
1697 }
1e0f1595 1698
ed95eeff 1699 op_guard_update(prelude_sentinel, op_append_list(
1700 OP_LINESEQ, prelude_sentinel->op,
e158cf8f 1701 nest
ed95eeff 1702 ));
c311cef3 1703 }
1704
e158cf8f 1705 /* named parameters */
1706 if (count_named_params(param_spec)) {
fc634bba 1707 size_t i, lim;
1708
1709 assert(param_spec->rest_hash != NOT_IN_PAD);
1710
1711 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1712 Param *cur = &param_spec->named_required.data[i];
1713 size_t n;
1714 char *p = SvPV(cur->name, n);
1715 OP *var, *cond;
1716
1717 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1718
1719 if (spec->flags & FLAG_CHECK_NARGS) {
51a483f8 1720 OP *xcroak, *msg;
fc634bba 1721
1722 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1723 var = newUNOP(OP_DELETE, 0, var);
1724
1725 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": missing named parameter: %.*s", SVfARG(declarator), (int)(n - 1), p + 1));
51a483f8 1726 xcroak = newCVREF(
fc634bba 1727 OPf_WANT_SCALAR,
1728 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1729 );
51a483f8 1730 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1731
1732 cond = newUNOP(OP_EXISTS, 0, cond);
1733
51a483f8 1734 cond = newCONDOP(0, cond, var, xcroak);
fc634bba 1735 }
1736
1737 var = my_var(
1738 aTHX_
1739 OPf_MOD | (OPpLVAL_INTRO << 8),
1740 cur->padoff
1741 );
1742 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1743
ed95eeff 1744 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
fc634bba 1745 }
1746
1747 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1748 ParamInit *cur = &param_spec->named_optional.data[i];
1749 size_t n;
1750 char *p = SvPV(cur->param.name, n);
1751 OP *var, *cond;
1752
1753 var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1754 var = newUNOP(OP_DELETE, 0, var);
1755
1756 cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
1757 cond = newUNOP(OP_EXISTS, 0, cond);
1758
ed95eeff 1759 cond = newCONDOP(0, cond, var, op_guard_relinquish(&cur->init));
fc634bba 1760
1761 var = my_var(
1762 aTHX_
1763 OPf_MOD | (OPpLVAL_INTRO << 8),
1764 cur->param.padoff
1765 );
1766 var = newASSIGNOP(OPf_STACKED, var, 0, cond);
1767
ed95eeff 1768 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
fc634bba 1769 }
1770
1771 if (!param_spec->slurpy.name) {
1772 if (spec->flags & FLAG_CHECK_NARGS) {
1773 /* croak if %{rest} */
51a483f8 1774 OP *xcroak, *cond, *keys, *msg;
fc634bba 1775
1776 keys = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1777 keys = newLISTOP(OP_SORT, 0, newOP(OP_PUSHMARK, 0), keys);
1778 {
1779 OP *first, *mid, *last;
1780
1781 last = keys;
1782
1783 mid = mkconstpvs(", ");
1784 mid->op_sibling = last;
1785
1786 first = newOP(OP_PUSHMARK, 0);
1787
1788 keys = newLISTOP(OP_JOIN, 0, first, mid);
1789 keys->op_targ = pad_alloc(OP_JOIN, SVs_PADTMP);
1790 ((LISTOP *)keys)->op_last = last;
1791 }
1792
1793 msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator)));
1794 msg = newBINOP(OP_CONCAT, 0, msg, keys);
1795
51a483f8 1796 xcroak = newCVREF(
fc634bba 1797 OPf_WANT_SCALAR,
1798 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
1799 );
51a483f8 1800 xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
fc634bba 1801
1802 cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
51a483f8 1803 xcroak = newCONDOP(0, cond, xcroak, NULL);
fc634bba 1804
ed95eeff 1805 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, xcroak)));
fc634bba 1806 } else {
1807 OP *clear;
1808
1809 clear = newASSIGNOP(
1810 OPf_STACKED,
1811 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1812 0,
1813 newNULLLIST()
1814 );
1815
ed95eeff 1816 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, clear)));
fc634bba 1817 }
1818 } else if (param_spec->slurpy.padoff != param_spec->rest_hash) {
1819 OP *var, *clear;
1820
1821 assert(SvPV_nolen(param_spec->slurpy.name)[0] == '@');
1822
1823 var = my_var_g(
1824 aTHX_
1825 OP_PADAV,
1826 OPf_MOD | (OPpLVAL_INTRO << 8),
1827 param_spec->slurpy.padoff
1828 );
1829
1830 var = newASSIGNOP(OPf_STACKED, var, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
1831
ed95eeff 1832 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, var)));
fc634bba 1833
1834 clear = newASSIGNOP(
1835 OPf_STACKED,
1836 my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash),
1837 0,
1838 newNULLLIST()
1839 );
1840
ed95eeff 1841 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, clear)));
fc634bba 1842 }
1843 }
51a483f8 1844
1845 if (spec->flags & FLAG_CHECK_TARGS) {
1846 size_t i, lim, base;
1847
1848 base = 1;
1849 for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
1850 Param *cur = &param_spec->positional_required.data[i];
1851
1852 if (cur->type) {
ed95eeff 1853 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1854 }
1855 }
1856 base += i;
1857
1858 for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
1859 Param *cur = &param_spec->positional_optional.data[i].param;
1860
1861 if (cur->type) {
ed95eeff 1862 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1863 }
1864 }
1865 base += i;
1866
1867 for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
1868 Param *cur = &param_spec->named_required.data[i];
1869
1870 if (cur->type) {
ed95eeff 1871 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1872 }
1873 }
1874 base += i;
1875
1876 for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
1877 Param *cur = &param_spec->named_optional.data[i].param;
1878
1879 if (cur->type) {
ed95eeff 1880 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur))));
51a483f8 1881 }
1882 }
1883 base += i;
1884
1885 if (param_spec->slurpy.type) {
1886 /* $type->valid($_) or croak $type->get_message($_) for @rest / values %rest */
a8492ba4 1887 OP *check, *list, *loop;
51a483f8 1888
a8492ba4 1889 check = mktypecheck(aTHX_ declarator, base, param_spec->slurpy.name, NOT_IN_PAD, param_spec->slurpy.type);
51a483f8 1890
1891 if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') {
1892 list = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff);
1893 } else {
1894 list = my_var_g(aTHX_ OP_PADHV, 0, param_spec->slurpy.padoff);
1895 list = newUNOP(OP_VALUES, 0, list);
1896 }
1897
a8492ba4 1898 loop = newFOROP(0, NULL, list, check, NULL);
51a483f8 1899
ed95eeff 1900 op_guard_update(prelude_sentinel, op_append_list(OP_LINESEQ, prelude_sentinel->op, newSTATEOP(0, NULL, loop)));
51a483f8 1901 }
1902 }
1e0f1595 1903 }
c311cef3 1904
1e0f1595 1905 /* finally let perl parse the actual subroutine body */
1906 body = parse_block(0);
c311cef3 1907
1e0f1595 1908 /* add '();' to make function return nothing by default */
1909 /* (otherwise the invisible parameter initialization can "leak" into
1910 the return value: fun ($x) {}->("asdf", 0) == 2) */
ed95eeff 1911 if (prelude_sentinel->op) {
1e0f1595 1912 body = newSTATEOP(0, NULL, body);
db81d362 1913 }
1914
ed95eeff 1915 body = op_append_list(OP_LINESEQ, op_guard_relinquish(prelude_sentinel), body);
1e0f1595 1916
c311cef3 1917 /* it's go time. */
1918 {
53c979f0 1919 CV *cv;
ed95eeff 1920 OP *const attrs = op_guard_relinquish(attrs_sentinel);
53c979f0 1921
c311cef3 1922 SvREFCNT_inc_simple_void(PL_compcv);
1923
63915d26 1924 /* close outer block: '}' */
1925 S_block_end(aTHX_ save_ix, body);
1926
53c979f0 1927 cv = newATTRSUB(
c311cef3 1928 floor_ix,
53c979f0 1929 saw_name ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL,
c311cef3 1930 proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
1931 attrs,
1932 body
1933 );
53c979f0 1934
2c1cb7bd 1935 if (cv) {
1936 register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec);
1937 }
53c979f0 1938
1939 if (saw_name) {
1940 *pop = newOP(OP_NULL, 0);
1941 return KEYWORD_PLUGIN_STMT;
1942 }
1943
1944 *pop = newUNOP(
1945 OP_REFGEN, 0,
1946 newSVOP(
1947 OP_ANONCODE, 0,
1948 (SV *)cv
1949 )
1950 );
1951 return KEYWORD_PLUGIN_EXPR;
db81d362 1952 }
db81d362 1953}
1954
8216fac4 1955static int kw_flags_enter(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
1956 HV *hints;
1957 SV *sv, **psv;
1958 const char *p, *kw_active;
1959 STRLEN kw_active_len;
fd727b3e 1960 bool kw_is_utf8;
8216fac4 1961
1962 if (!(hints = GvHV(PL_hintgv))) {
1963 return FALSE;
1964 }
1965 if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) {
1966 return FALSE;
1967 }
1968 sv = *psv;
1969 kw_active = SvPV(sv, kw_active_len);
1970 if (kw_active_len <= kw_len) {
1971 return FALSE;
1972 }
fd727b3e 1973
1974 kw_is_utf8 = lex_bufutf8();
1975
8216fac4 1976 for (
1977 p = kw_active;
1978 (p = strchr(p, *kw_ptr)) &&
1979 p < kw_active + kw_active_len - kw_len;
1980 p++
1981 ) {
1982 if (
1983 (p == kw_active || p[-1] == ' ') &&
1984 p[kw_len] == ' ' &&
1985 memcmp(kw_ptr, p, kw_len) == 0
1986 ) {
1987 ENTER;
1988 SAVETMPS;
1989
1990 SAVEDESTRUCTOR_X(sentinel_clear_void, sen);
1991
1992 spec->flags = 0;
7193dffb 1993 spec->reify_type = 0;
8216fac4 1994 spec->shift = sentinel_mortalize(sen, newSVpvs(""));
1995 spec->attrs = sentinel_mortalize(sen, newSVpvs(""));
1996
1997#define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \
1998 const char *fk_ptr_; \
1999 STRLEN fk_len_; \
fd727b3e 2000 I32 fk_xlen_; \
8216fac4 2001 SV *fk_sv_; \
2002 fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \
2003 sv_catpvn(fk_sv_, PTR, LEN); \
2004 fk_ptr_ = SvPV(fk_sv_, fk_len_); \
fd727b3e 2005 fk_xlen_ = fk_len_; \
2006 if (kw_is_utf8) { \
2007 fk_xlen_ = -fk_xlen_; \
2008 } \
2009 if (!((X) = hv_fetch(hints, fk_ptr_, fk_xlen_, 0))) { \
8216fac4 2010 croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \
2011 } \
2012} STMT_END
2013
2014 FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv);
2015 spec->flags = SvIV(*psv);
2016
7193dffb 2017 FETCH_HINTK_INTO(REIFY_, kw_ptr, kw_len, psv);
2018 spec->reify_type = SvIV(*psv);
2019
8216fac4 2020 FETCH_HINTK_INTO(SHIFT_, kw_ptr, kw_len, psv);
2021 SvSetSV(spec->shift, *psv);
2022
2023 FETCH_HINTK_INTO(ATTRS_, kw_ptr, kw_len, psv);
2024 SvSetSV(spec->attrs, *psv);
2025
2026#undef FETCH_HINTK_INTO
2027 return TRUE;
2028 }
2029 }
2030 return FALSE;
2031}
2032
db81d362 2033static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
8216fac4 2034 Sentinel sen = { NULL };
63915d26 2035 KWSpec spec;
db81d362 2036 int ret;
2037
8216fac4 2038 if (kw_flags_enter(aTHX_ sen, keyword_ptr, keyword_len, &spec)) {
2039 /* scope was entered, 'sen' and 'spec' are initialized */
e4648f19 2040 ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec);
8216fac4 2041 FREETMPS;
2042 LEAVE;
db81d362 2043 } else {
8216fac4 2044 /* not one of our keywords, no allocation done */
7dd35535 2045 ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
db81d362 2046 }
2047
db81d362 2048 return ret;
2049}
2050
2051WARNINGS_RESET
2052
53c979f0 2053MODULE = Function::Parameters PACKAGE = Function::Parameters PREFIX = fp_
db81d362 2054PROTOTYPES: ENABLE
2055
53c979f0 2056UV
2057fp__cv_root(sv)
2058 SV * sv
2059 PREINIT:
79bce2d4 2060 CV *xcv;
53c979f0 2061 HV *hv;
2062 GV *gv;
2063 CODE:
79bce2d4 2064 xcv = sv_2cv(sv, &hv, &gv, 0);
2065 RETVAL = PTR2UV(xcv ? CvROOT(xcv) : NULL);
53c979f0 2066 OUTPUT:
2067 RETVAL
2068
db81d362 2069BOOT:
2070WARNINGS_ENABLE {
2071 HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
426a4d69 2072 /**/
d8e5d540 2073 newCONSTSUB(stash, "FLAG_NAME_OK", newSViv(FLAG_NAME_OK));
2074 newCONSTSUB(stash, "FLAG_ANON_OK", newSViv(FLAG_ANON_OK));
63915d26 2075 newCONSTSUB(stash, "FLAG_DEFAULT_ARGS", newSViv(FLAG_DEFAULT_ARGS));
d8e5d540 2076 newCONSTSUB(stash, "FLAG_CHECK_NARGS", newSViv(FLAG_CHECK_NARGS));
2077 newCONSTSUB(stash, "FLAG_INVOCANT", newSViv(FLAG_INVOCANT));
e158cf8f 2078 newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS));
51a483f8 2079 newCONSTSUB(stash, "FLAG_TYPES_OK", newSViv(FLAG_TYPES_OK));
2080 newCONSTSUB(stash, "FLAG_CHECK_TARGS", newSViv(FLAG_CHECK_TARGS));
db81d362 2081 newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
d8e5d540 2082 newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_));
2083 newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_));
2084 newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_));
7193dffb 2085 newCONSTSUB(stash, "HINTK_REIFY_", newSVpvs(HINTK_REIFY_));
426a4d69 2086 /**/
db81d362 2087 next_keyword_plugin = PL_keyword_plugin;
2088 PL_keyword_plugin = my_keyword_plugin;
2089} WARNINGS_RESET
Unnamed repository; edit this file to name it for gitweb.