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