projects / p5sagit/Function-Parameters.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
implement 'runtime' keyword attribute
[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
63915d26 92enum {
42e595b0 93 FLAG_NAME_OK = 0x001,
94 FLAG_ANON_OK = 0x002,
95 FLAG_DEFAULT_ARGS = 0x004,
96 FLAG_CHECK_NARGS = 0x008,
97 FLAG_INVOCANT = 0x010,
98 FLAG_NAMED_PARAMS = 0x020,
99 FLAG_TYPES_OK = 0x040,
100 FLAG_CHECK_TARGS = 0x080,
101 FLAG_RUNTIME = 0x100
63915d26 102};
103
104DEFSTRUCT(KWSpec) {
105 unsigned flags;
7193dffb 106 I32 reify_type;
b72eb6ee 107 SV *shift;
108 SV *attrs;
63915d26 109};
db81d362 110
111static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
112
e4648f19 113DEFSTRUCT(Resource) {
114 Resource *next;
115 void *data;
116 void (*destroy)(pTHX_ void *);
117};
118
119typedef Resource *Sentinel[1];
120
121static void sentinel_clear_void(pTHX_ void *p) {
122 Resource **pp = p;
123 while (*pp) {
124 Resource *cur = *pp;
a4c13d40 125 if (cur->destroy) {
126 cur->destroy(aTHX_ cur->data);
127 }
e4648f19 128 cur->data = (void *)"no";
129 cur->destroy = NULL;
130 *pp = cur->next;
131 Safefree(cur);
132 }
133}
134
a4c13d40 135static Resource *sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) {
e4648f19 136 Resource *cur;
137
138 Newx(cur, 1, Resource);
139 cur->data = data;
140 cur->destroy = destroy;
141 cur->next = *sen;
142 *sen = cur;
a4c13d40 143
144 return cur;
145}
146
147static void sentinel_disarm(Resource *p) {
148 p->destroy = NULL;
e4648f19 149}
150
151static void my_sv_refcnt_dec_void(pTHX_ void *p) {
152 SV *sv = p;
153 SvREFCNT_dec(sv);
154}
155
156static SV *sentinel_mortalize(Sentinel sen, SV *sv) {
157 sentinel_register(sen, sv, my_sv_refcnt_dec_void);
158 return sv;
159}
160
db81d362 161
ed95eeff 162#if HAVE_PERL_VERSION(5, 17, 2)
163 #define MY_OP_SLABBED(O) ((O)->op_slabbed)
164#else
165 #define MY_OP_SLABBED(O) 0
166#endif
167
168DEFSTRUCT(OpGuard) {
169 OP *op;
170 bool needs_freed;
171};
172
173static void op_guard_init(OpGuard *p) {
174 p->op = NULL;
175 p->needs_freed = FALSE;
176}
177
178static OpGuard op_guard_transfer(OpGuard *p) {
179 OpGuard r = *p;
180 op_guard_init(p);
181 return r;
182}
183
184static OP *op_guard_relinquish(OpGuard *p) {
185 OP *o = p->op;
186 op_guard_init(p);
187 return o;
188}
189
190static void op_guard_update(OpGuard *p, OP *o) {
191 p->op = o;
192 p->needs_freed = o && !MY_OP_SLABBED(o);
193}
194
195static void op_guard_clear(pTHX_ OpGuard *p) {
196 if (p->needs_freed) {
197 op_free(p->op);
198 }
199}
200
201static void free_op_guard_void(pTHX_ void *vp) {
202 OpGuard *p = vp;
203 op_guard_clear(aTHX_ p);
204 Safefree(p);
c311cef3 205}
206
51a483f8 207static void free_op_void(pTHX_ void *vp) {
208 OP *p = vp;
209 op_free(p);
210}
211
59016bfb 212#define sv_eq_pvs(SV, S) my_sv_eq_pvn(aTHX_ SV, "" S "", sizeof (S) - 1)
c311cef3 213
59016bfb 214static int my_sv_eq_pvn(pTHX_ SV *sv, const char *p, STRLEN n) {
c311cef3 215 STRLEN sv_len;
216 const char *sv_p = SvPV(sv, sv_len);
59016bfb 217 return memcmp(sv_p, p, n) == 0;
c311cef3 218}
219
220
221#include "padop_on_crack.c.inc"
222
223
c311cef3 224enum {
225 MY_ATTR_LVALUE = 0x01,
226 MY_ATTR_METHOD = 0x02,
227 MY_ATTR_SPECIAL = 0x04
228};
229
31534187 230static void my_sv_cat_c(pTHX_ SV *sv, U32 c) {
231 char ds[UTF8_MAXBYTES + 1], *d;
67fc1ddb 232 d = (char *)uvchr_to_utf8((U8 *)ds, c);
31534187 233 if (d - ds > 1) {
234 sv_utf8_upgrade(sv);
235 }
236 sv_catpvn(sv, ds, d - ds);
237}
238
31534187 239
e6d62383 240#define MY_UNI_IDFIRST(C) isIDFIRST_uni(C)
241#define MY_UNI_IDCONT(C) isALNUM_uni(C)
31534187 242
e4648f19 243static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) {
31534187 244 bool at_start, at_substart;
245 I32 c;
e4648f19 246 SV *sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 247 if (lex_bufutf8()) {
248 SvUTF8_on(sv);
249 }
250
251 at_start = at_substart = TRUE;
252 c = lex_peek_unichar(0);
253
254 while (c != -1) {
e6d62383 255 if (at_substart ? MY_UNI_IDFIRST(c) : MY_UNI_IDCONT(c)) {
31534187 256 lex_read_unichar(0);
257 my_sv_cat_c(aTHX_ sv, c);
258 at_substart = FALSE;
259 c = lex_peek_unichar(0);
260 } else if (allow_package && !at_substart && c == '\'') {
261 lex_read_unichar(0);
262 c = lex_peek_unichar(0);
e6d62383 263 if (!MY_UNI_IDFIRST(c)) {
31534187 264 lex_stuff_pvs("'", 0);
265 break;
266 }
267 sv_catpvs(sv, "'");
268 at_substart = TRUE;
269 } else if (allow_package && (at_start || !at_substart) && c == ':') {
270 lex_read_unichar(0);
271 if (lex_peek_unichar(0) != ':') {
272 lex_stuff_pvs(":", 0);
273 break;
274 }
275 lex_read_unichar(0);
276 c = lex_peek_unichar(0);
e6d62383 277 if (!MY_UNI_IDFIRST(c)) {
31534187 278 lex_stuff_pvs("::", 0);
279 break;
280 }
281 sv_catpvs(sv, "::");
282 at_substart = TRUE;
283 } else {
284 break;
285 }
286 at_start = FALSE;
287 }
288
289 return SvCUR(sv) ? sv : NULL;
290}
291
e4648f19 292static SV *my_scan_parens_tail(pTHX_ Sentinel sen, bool keep_backslash) {
31534187 293 I32 c, nesting;
294 SV *sv;
295 line_t start;
296
297 start = CopLINE(PL_curcop);
298
e4648f19 299 sv = sentinel_mortalize(sen, newSVpvs(""));
31534187 300 if (lex_bufutf8()) {
301 SvUTF8_on(sv);
302 }
303
304 nesting = 0;
305 for (;;) {
306 c = lex_read_unichar(0);
307 if (c == EOF) {
308 CopLINE_set(PL_curcop, start);
309 return NULL;
310 }
311
312 if (c == '\\') {
313 c = lex_read_unichar(0);
314 if (c == EOF) {
315 CopLINE_set(PL_curcop, start);
316 return NULL;
317 }
318 if (keep_backslash || (c != '(' && c != ')')) {
319 sv_catpvs(sv, "\\");
320 }
321 } else if (c == '(') {
322 nesting++;
323 } else if (c == ')') {
324 if (!nesting) {
325 break;
326 }
327 nesting--;
328 }
329
330 my_sv_cat_c(aTHX_ sv, c);
331 }
332
333 return sv;
334}
335
e4648f19 336static void my_check_prototype(pTHX_ Sentinel sen, const SV *declarator, SV *proto) {
31534187 337 char *start, *r, *w, *end;
338 STRLEN len;
339
340 /* strip spaces */
341 start = SvPV(proto, len);
342 end = start + len;
343
344 for (w = r = start; r < end; r++) {
345 if (!isSPACE(*r)) {
346 *w++ = *r;
347 }
348 }
349 *w = '\0';
350 SvCUR_set(proto, w - start);
351 end = w;
352 len = end - start;
353
354 if (!ckWARN(WARN_ILLEGALPROTO)) {
355 return;
356 }
357
358 /* check for bad characters */
359 if (strspn(start, "$@%*;[]&\\_+") != len) {
e4648f19 360 SV *dsv = sentinel_mortalize(sen, newSVpvs(""));
31534187 361 warner(
362 packWARN(WARN_ILLEGALPROTO),
363 "Illegal character in prototype for %"SVf" : %s",
364 SVfARG(declarator),
365 SvUTF8(proto)
366 ? sv_uni_display(
367 dsv,
368 proto,
369 len,
370 UNI_DISPLAY_ISPRINT
371 )
372 : pv_pretty(dsv, start, len, 60, NULL, NULL,
373 PERL_PV_ESCAPE_NONASCII
374 )
375 );
376 return;
377 }
378
379 for (r = start; r < end; r++) {
380 switch (*r) {
381 default:
382 warner(
383 packWARN(WARN_ILLEGALPROTO),
384 "Illegal character in prototype for %"SVf" : %s",
385 SVfARG(declarator), r
386 );
387 return;
388
389 case '_':
390 if (r[1] && !strchr(";@%", *r)) {
391 warner(
392 packWARN(WARN_ILLEGALPROTO),
393 "Illegal character after '_' in prototype for %"SVf" : %s",
394 SVfARG(declarator), r
395 );
396 return;
397 }
398 break;
399
400 case '@':
401 case '%':
402 if (r[1]) {
403 warner(
404 packWARN(WARN_ILLEGALPROTO),
405 "prototype after '%c' for %"SVf": %s",
406 *r, SVfARG(declarator), r + 1
407 );
408 return;
409 }
410 break;
411
412 case '\\':
413 r++;
414 if (strchr("$@%&*", *r)) {
415 break;
416 }
417 if (*r == '[') {
418 r++;
419 for (; r < end && *r != ']'; r++) {
420 if (!strchr("$@%&*", *r)) {
421 break;
422 }
423 }
424 if (*r == ']' && r[-1] != '[') {
425 break;
426 }
427 }
428 warner(
429 packWARN(WARN_ILLEGALPROTO),
430 "Illegal character after '\\' in prototype for %"SVf" : %s",
431 SVfARG(declarator), r
432 );
433 return;
434
435 case '$':
436 case '*':
437 case '&':
438 case ';':
439 case '+':
440 break;
441 }
442 }
443}
444
51a483f8 445static SV *parse_type(pTHX_ Sentinel, const SV *);
446
447static SV *parse_type_paramd(pTHX_ Sentinel sen, const SV *declarator) {
448 I32 c;
449 SV *t;
450
451 t = my_scan_word(aTHX_ sen, TRUE);
452 lex_read_space(0);
453
454 c = lex_peek_unichar(0);
455 if (c == '[') {
456 SV *u;
457
458 lex_read_unichar(0);
459 lex_read_space(0);
460 my_sv_cat_c(aTHX_ t, c);
461
462 u = parse_type(aTHX_ sen, declarator);
463 sv_catsv(t, u);
464
465 c = lex_peek_unichar(0);
466 if (c != ']') {
467 croak("In %"SVf": missing ']' after '%"SVf"'", SVfARG(declarator), SVfARG(t));
468 }
469 lex_read_unichar(0);
470 lex_read_space(0);
471
472 my_sv_cat_c(aTHX_ t, c);
473 }
474
475 return t;
476}
477
478static SV *parse_type(pTHX_ Sentinel sen, const SV *declarator) {
479 I32 c;
480 SV *t;
481
482 t = parse_type_paramd(aTHX_ sen, declarator);
483
484 c = lex_peek_unichar(0);
485 while (c == '|') {
486 SV *u;
487
488 lex_read_unichar(0);
489 lex_read_space(0);
490
491 my_sv_cat_c(aTHX_ t, c);
492 u = parse_type_paramd(aTHX_ sen, declarator);
493 sv_catsv(t, u);
494
495 c = lex_peek_unichar(0);
496 }
497
498 return t;
499}
500
7193dffb 501static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, const KWSpec *spec, SV *name) {
502 AV *type_reifiers;
503 SV *t, *sv, **psv;
51a483f8 504 int n;
505 dSP;
506
7193dffb 507 type_reifiers = get_av(MY_PKG "::type_reifiers", 0);
508 assert(type_reifiers != NULL);
509
510 if (spec->reify_type < 0 || spec->reify_type > av_len(type_reifiers)) {
511 croak("In %"SVf": internal error: reify_type [%ld] out of range [%ld]", SVfARG(declarator), (long)spec->reify_type, (long)(av_len(type_reifiers) + 1));
512 }
513
514 psv = av_fetch(type_reifiers, spec->reify_type, 0);
515 assert(psv != NULL);
516 sv = *psv;
52c18b0f 517
51a483f8 518 ENTER;
519 SAVETMPS;
520
521 PUSHMARK(SP);
e7c6de2c 522 EXTEND(SP, 2);
51a483f8 523 PUSHs(name);
e7c6de2c 524 PUSHs(PL_curstname);
51a483f8 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! */
42e595b0 1415 if (saw_name && !(spec->flags & FLAG_RUNTIME)) {
63915d26 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 {
42e595b0 1919 int runtime = spec->flags & FLAG_RUNTIME;
53c979f0 1920 CV *cv;
ed95eeff 1921 OP *const attrs = op_guard_relinquish(attrs_sentinel);
53c979f0 1922
c311cef3 1923 SvREFCNT_inc_simple_void(PL_compcv);
1924
63915d26 1925 /* close outer block: '}' */
1926 S_block_end(aTHX_ save_ix, body);
1927
53c979f0 1928 cv = newATTRSUB(
c311cef3 1929 floor_ix,
42e595b0 1930 saw_name && !runtime ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL,
1931 proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
c311cef3 1932 attrs,
1933 body
1934 );
53c979f0 1935
2c1cb7bd 1936 if (cv) {
1937 register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec);
1938 }
53c979f0 1939
1940 if (saw_name) {
42e595b0 1941 if (!runtime) {
1942 *pop = newOP(OP_NULL, 0);
1943 } else {
1944 *pop = newUNOP(
1945 OP_ENTERSUB, OPf_STACKED,
1946 op_append_elem(
1947 OP_LIST,
1948 op_append_elem(
1949 OP_LIST,
1950 mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(saw_name)),
1951 newUNOP(
1952 OP_REFGEN, 0,
1953 newSVOP(OP_ANONCODE, 0, (SV *)cv)
1954 )
1955 ),
1956 newCVREF(0, newGVOP(OP_GV, 0, gv_fetchpvs(MY_PKG "::_defun", 0, SVt_PVCV)))
1957 )
1958 );
1959 }
53c979f0 1960 return KEYWORD_PLUGIN_STMT;
1961 }
1962
1963 *pop = newUNOP(
1964 OP_REFGEN, 0,
1965 newSVOP(
1966 OP_ANONCODE, 0,
1967 (SV *)cv
1968 )
1969 );
1970 return KEYWORD_PLUGIN_EXPR;
db81d362 1971 }
db81d362 1972}
1973
8216fac4 1974static int kw_flags_enter(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
1975 HV *hints;
1976 SV *sv, **psv;
1977 const char *p, *kw_active;
1978 STRLEN kw_active_len;
fd727b3e 1979 bool kw_is_utf8;
8216fac4 1980
1981 if (!(hints = GvHV(PL_hintgv))) {
1982 return FALSE;
1983 }
1984 if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) {
1985 return FALSE;
1986 }
1987 sv = *psv;
1988 kw_active = SvPV(sv, kw_active_len);
1989 if (kw_active_len <= kw_len) {
1990 return FALSE;
1991 }
fd727b3e 1992
1993 kw_is_utf8 = lex_bufutf8();
1994
8216fac4 1995 for (
1996 p = kw_active;
1997 (p = strchr(p, *kw_ptr)) &&
1998 p < kw_active + kw_active_len - kw_len;
1999 p++
2000 ) {
2001 if (
2002 (p == kw_active || p[-1] == ' ') &&
2003 p[kw_len] == ' ' &&
2004 memcmp(kw_ptr, p, kw_len) == 0
2005 ) {
2006 ENTER;
2007 SAVETMPS;
2008
2009 SAVEDESTRUCTOR_X(sentinel_clear_void, sen);
2010
2011 spec->flags = 0;
7193dffb 2012 spec->reify_type = 0;
8216fac4 2013 spec->shift = sentinel_mortalize(sen, newSVpvs(""));
2014 spec->attrs = sentinel_mortalize(sen, newSVpvs(""));
2015
2016#define FETCH_HINTK_INTO(NAME, PTR, LEN, X) STMT_START { \
2017 const char *fk_ptr_; \
2018 STRLEN fk_len_; \
fd727b3e 2019 I32 fk_xlen_; \
8216fac4 2020 SV *fk_sv_; \
2021 fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \
2022 sv_catpvn(fk_sv_, PTR, LEN); \
2023 fk_ptr_ = SvPV(fk_sv_, fk_len_); \
fd727b3e 2024 fk_xlen_ = fk_len_; \
2025 if (kw_is_utf8) { \
2026 fk_xlen_ = -fk_xlen_; \
2027 } \
2028 if (!((X) = hv_fetch(hints, fk_ptr_, fk_xlen_, 0))) { \
8216fac4 2029 croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)fk_len_, fk_ptr_); \
2030 } \
2031} STMT_END
2032
2033 FETCH_HINTK_INTO(FLAGS_, kw_ptr, kw_len, psv);
2034 spec->flags = SvIV(*psv);
2035
7193dffb 2036 FETCH_HINTK_INTO(REIFY_, kw_ptr, kw_len, psv);
2037 spec->reify_type = SvIV(*psv);
2038
8216fac4 2039 FETCH_HINTK_INTO(SHIFT_, kw_ptr, kw_len, psv);
2040 SvSetSV(spec->shift, *psv);
2041
2042 FETCH_HINTK_INTO(ATTRS_, kw_ptr, kw_len, psv);
2043 SvSetSV(spec->attrs, *psv);
2044
2045#undef FETCH_HINTK_INTO
2046 return TRUE;
2047 }
2048 }
2049 return FALSE;
2050}
2051
db81d362 2052static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
8216fac4 2053 Sentinel sen = { NULL };
63915d26 2054 KWSpec spec;
db81d362 2055 int ret;
2056
8216fac4 2057 if (kw_flags_enter(aTHX_ sen, keyword_ptr, keyword_len, &spec)) {
2058 /* scope was entered, 'sen' and 'spec' are initialized */
e4648f19 2059 ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec);
8216fac4 2060 FREETMPS;
2061 LEAVE;
db81d362 2062 } else {
8216fac4 2063 /* not one of our keywords, no allocation done */
7dd35535 2064 ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
db81d362 2065 }
2066
db81d362 2067 return ret;
2068}
2069
42e595b0 2070#ifndef SvREFCNT_dec_NN
2071#define SvREFCNT_dec_NN(SV) SvREFCNT_dec(SV)
2072#endif
2073
2074#ifndef assert_
2075#ifdef DEBUGGING
2076#define assert_(X) assert(X),
2077#else
2078#define assert_(X)
2079#endif
2080#endif
2081
2082#ifndef gv_method_changed
2083#define gv_method_changed(GV) ( \
2084 assert_(isGV_with_GP(GV)) \
2085 GvREFCNT(GV) > 1 \
2086 ? (void)PL_sub_generation++ \
2087 : mro_method_changed_in(GvSTASH(GV)) \
2088)
2089#endif
2090
db81d362 2091WARNINGS_RESET
2092
53c979f0 2093MODULE = Function::Parameters PACKAGE = Function::Parameters PREFIX = fp_
db81d362 2094PROTOTYPES: ENABLE
2095
53c979f0 2096UV
2097fp__cv_root(sv)
42e595b0 2098 SV *sv
53c979f0 2099 PREINIT:
79bce2d4 2100 CV *xcv;
53c979f0 2101 HV *hv;
2102 GV *gv;
2103 CODE:
79bce2d4 2104 xcv = sv_2cv(sv, &hv, &gv, 0);
2105 RETVAL = PTR2UV(xcv ? CvROOT(xcv) : NULL);
53c979f0 2106 OUTPUT:
2107 RETVAL
2108
42e595b0 2109void
2110fp__defun(name, body)
2111 SV *name
2112 CV *body
2113 PREINIT:
2114 GV *gv;
2115 CV *xcv;
2116 CODE:
2117 assert(SvTYPE(body) == SVt_PVCV);
2118 gv = gv_fetchsv(name, GV_ADDMULTI, SVt_PVCV);
2119 xcv = GvCV(gv);
2120 if (xcv) {
2121 if (!GvCVGEN(gv) && (CvROOT(xcv) || CvXSUB(xcv)) && ckWARN(WARN_REDEFINE)) {
2122 warner(packWARN(WARN_REDEFINE), "Subroutine %"SVf" redefined", SVfARG(name));
2123 }
2124 SvREFCNT_dec_NN(xcv);
2125 }
2126 GvCVGEN(gv) = 0;
2127 GvASSUMECV_on(gv);
2128 if (GvSTASH(gv)) {
2129 gv_method_changed(gv);
2130 }
2131 GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(body));
2132 CvGV_set(body, gv);
2133 CvANON_off(body);
2134
db81d362 2135BOOT:
2136WARNINGS_ENABLE {
2137 HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
426a4d69 2138 /**/
d8e5d540 2139 newCONSTSUB(stash, "FLAG_NAME_OK", newSViv(FLAG_NAME_OK));
2140 newCONSTSUB(stash, "FLAG_ANON_OK", newSViv(FLAG_ANON_OK));
63915d26 2141 newCONSTSUB(stash, "FLAG_DEFAULT_ARGS", newSViv(FLAG_DEFAULT_ARGS));
d8e5d540 2142 newCONSTSUB(stash, "FLAG_CHECK_NARGS", newSViv(FLAG_CHECK_NARGS));
2143 newCONSTSUB(stash, "FLAG_INVOCANT", newSViv(FLAG_INVOCANT));
e158cf8f 2144 newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS));
51a483f8 2145 newCONSTSUB(stash, "FLAG_TYPES_OK", newSViv(FLAG_TYPES_OK));
2146 newCONSTSUB(stash, "FLAG_CHECK_TARGS", newSViv(FLAG_CHECK_TARGS));
42e595b0 2147 newCONSTSUB(stash, "FLAG_RUNTIME", newSViv(FLAG_RUNTIME));
db81d362 2148 newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
d8e5d540 2149 newCONSTSUB(stash, "HINTK_FLAGS_", newSVpvs(HINTK_FLAGS_));
2150 newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_));
2151 newCONSTSUB(stash, "HINTK_ATTRS_", newSVpvs(HINTK_ATTRS_));
7193dffb 2152 newCONSTSUB(stash, "HINTK_REIFY_", newSVpvs(HINTK_REIFY_));
426a4d69 2153 /**/
db81d362 2154 next_keyword_plugin = PL_keyword_plugin;
2155 PL_keyword_plugin = my_keyword_plugin;
2156} WARNINGS_RESET
Unnamed repository; edit this file to name it for gitweb.