[p5sagit/Function-Parameters.git] / Parameters.xs

/*
Copyright 2012 Lukas Mai.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.
 */

#ifdef __GNUC__
 #if (__GNUC__ == 4 && __GNUC_MINOR__ >= 6) || __GNUC__ >= 5
  #define PRAGMA_GCC_(X) _Pragma(#X)
  #define PRAGMA_GCC(X) PRAGMA_GCC_(GCC X)
 #endif
#endif

#ifndef PRAGMA_GCC
 #define PRAGMA_GCC(X)
#endif

#ifdef DEVEL
 #define WARNINGS_RESET PRAGMA_GCC(diagnostic pop)
 #define WARNINGS_ENABLEW(X) PRAGMA_GCC(diagnostic warning #X)
 #define WARNINGS_ENABLE \
 	WARNINGS_ENABLEW(-Wall) \
 	WARNINGS_ENABLEW(-Wextra) \
 	WARNINGS_ENABLEW(-Wundef) \
 	WARNINGS_ENABLEW(-Wshadow) \
 	WARNINGS_ENABLEW(-Wbad-function-cast) \
 	WARNINGS_ENABLEW(-Wcast-align) \
 	WARNINGS_ENABLEW(-Wwrite-strings) \
 	/* WARNINGS_ENABLEW(-Wnested-externs) wtf? */ \
 	WARNINGS_ENABLEW(-Wstrict-prototypes) \
 	WARNINGS_ENABLEW(-Wmissing-prototypes) \
 	WARNINGS_ENABLEW(-Winline) \
 	WARNINGS_ENABLEW(-Wdisabled-optimization)

#else
 #define WARNINGS_RESET
 #define WARNINGS_ENABLE
#endif


#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <string.h>

WARNINGS_ENABLE

#define MY_PKG "Function::Parameters"

#define HINTK_KEYWORDS MY_PKG "/keywords"
#define HINTK_NAME_    MY_PKG "/name:"
#define HINTK_SHIFT_   MY_PKG "/shift:"

#define HAVE_PERL_VERSION(R, V, S) \
	(PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))

typedef struct {
	enum {
		FLAG_NAME_OPTIONAL = 1,
		FLAG_NAME_REQUIRED,
		FLAG_NAME_PROHIBITED
	} name;
	char shift[256];
} Spec;

static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);

static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, Spec *spec) {
	HV *hints;
	SV *sv, **psv;
	const char *p, *kw_active;
	STRLEN kw_active_len;

	spec->name = 0;
	spec->shift[0] = '\0';

	if (!(hints = GvHV(PL_hintgv))) {
		return FALSE;
	}
	if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) {
		return FALSE;
	}
	sv = *psv;
	kw_active = SvPV(sv, kw_active_len);
	if (kw_active_len <= kw_len) {
		return FALSE;
	}
	for (p = kw_active; p < kw_active + kw_active_len - kw_len; p++) {
		if (
			(p == kw_active || p[-1] == ' ') &&
			p[kw_len] == ' ' &&
			memcmp(kw_ptr, p, kw_len) == 0
		) {
			const char *kf_ptr;
			STRLEN kf_len;
			SV *kf_sv;

			kf_sv = sv_2mortal(newSVpvs(HINTK_NAME_));
			sv_catpvn(kf_sv, kw_ptr, kw_len);
			kf_ptr = SvPV(kf_sv, kf_len);
			if (!(psv = hv_fetch(hints, kf_ptr, kf_len, 0))) {
				croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)kf_len, kf_ptr);
			}
			spec->name = SvIV(*psv);

			kf_sv = sv_2mortal(newSVpvs(HINTK_SHIFT_));
			sv_catpvn(kf_sv, kw_ptr, kw_len);
			kf_ptr = SvPV(kf_sv, kf_len);
			if (!(psv = hv_fetch(hints, kf_ptr, kf_len, 0))) {
				croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)kf_len, kf_ptr);
			}
			my_sprintf(spec->shift, "%.*s", (int)(sizeof spec->shift - 1), SvPV_nolen(*psv));

			return TRUE;
		}
	}
	return FALSE;
}


#include "toke_on_crack.c.inc"


static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const Spec *spec) {
	SV *gen, *declarator, *params, *sv;
	line_t line_start;
	int saw_name, saw_colon;
	STRLEN len;
	char *s;
	I32 c;

	gen = sv_2mortal(newSVpvs("sub"));
	declarator = sv_2mortal(newSVpvn(keyword_ptr, keyword_len));
	params = sv_2mortal(newSVpvs(""));

	line_start = CopLINE(PL_curcop);
	lex_read_space(0);

	/* function name */
	saw_name = 0;
	s = PL_parser->bufptr;
	if (spec->name != FLAG_NAME_PROHIBITED && (len = S_scan_word(aTHX_ s, TRUE))) {
		sv_catpvs(gen, " ");
		sv_catpvn(gen, s, len);
		sv_catpvs(declarator, " ");
		sv_catpvn(declarator, s, len);
		lex_read_to(s + len);
		lex_read_space(0);
		saw_name = 1;
	} else if (spec->name == FLAG_NAME_REQUIRED) {
		croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - s), s);
	} else {
		sv_catpvs(declarator, " (anon)");
	}

	/* parameters */
	c = lex_peek_unichar(0);
	if (c == '(') {
		SV *saw_slurpy = NULL;

		lex_read_unichar(0);
		lex_read_space(0);

		for (;;) {
			c = lex_peek_unichar(0);
			if (c && strchr("$@%", c)) {
				sv_catpvf(params, "%c", (int)c);
				lex_read_unichar(0);
				lex_read_space(0);

				s = PL_parser->bufptr;
				if (!(len = S_scan_word(aTHX_ s, FALSE))) {
					croak("In %.*s: missing identifier", (int)SvCUR(declarator), SvPV_nolen(declarator));
				}
				if (saw_slurpy) {
					croak("In %.*s: I was expecting \")\" after \"%s\", not \"%c%.*s\"", (int)SvCUR(declarator), SvPV_nolen(declarator), SvPV_nolen(saw_slurpy), (int)c, (int)len, s);
				}
				if (c != '$') {
					saw_slurpy = sv_2mortal(newSVpvf("%c%.*s", (int)c, (int)len, s));
				}
				sv_catpvn(params, s, len);
				sv_catpvs(params, ",");
				lex_read_to(s + len);
				lex_read_space(0);

				c = lex_peek_unichar(0);
				if (c == ',') {
					lex_read_unichar(0);
					lex_read_space(0);
					continue;
				}
			}

			if (c == ')') {
				lex_read_unichar(0);
				lex_read_space(0);
				break;
			}

			if (c == -1) {
				croak("In %.*s: unexpected EOF in parameter list", (int)SvCUR(declarator), SvPV_nolen(declarator));
			}
			croak("In %.*s: unexpected '%c' in parameter list", (int)SvCUR(declarator), SvPV_nolen(declarator), (int)c);
		}
	}

	/* prototype */
	saw_colon = 0;
	c = lex_peek_unichar(0);
	if (c == ':') {
		lex_read_unichar(0);
		lex_read_space(0);

		c = lex_peek_unichar(0);
		if (c != '(') {
			saw_colon = 1;
		} else {
			sv = sv_2mortal(newSVpvs(""));
			if (!S_scan_str(aTHX_ sv, TRUE, TRUE)) {
				croak("In %.*s: malformed prototype", (int)SvCUR(declarator), SvPV_nolen(declarator));
			}
			sv_catsv(gen, sv);
			lex_read_space(0);
		}
	}

	if (saw_name) {
		len = SvCUR(gen);
		s = SvGROW(gen, (len + 1) * 2);
		sv_catpvs(gen, ";");
		sv_catpvn(gen, s, len);
	}

	/* attributes */
	if (!saw_colon) {
		c = lex_peek_unichar(0);
		if (c == ':') {
			saw_colon = 1;
			lex_read_unichar(0);
			lex_read_space(0);
		}
	}
	if (saw_colon) {
		for (;;) {
			s = PL_parser->bufptr;
			if (!(len = S_scan_word(aTHX_ s, FALSE))) {
				break;
			}
			sv_catpvs(gen, ":");
			sv_catpvn(gen, s, len);
			lex_read_to(s + len);
			lex_read_space(0);
			c = lex_peek_unichar(0);
			if (c == '(') {
				sv = sv_2mortal(newSVpvs(""));
				if (!S_scan_str(aTHX_ sv, TRUE, TRUE)) {
					croak("In %.*s: malformed attribute argument list", (int)SvCUR(declarator), SvPV_nolen(declarator));
				}
				sv_catsv(gen, sv);
				lex_read_space(0);
				c = lex_peek_unichar(0);
			}
			if (c == ':') {
				lex_read_unichar(0);
				lex_read_space(0);
			}
		}
	}

	/* body */
	c = lex_peek_unichar(0);
	if (c != '{') {
		croak("In %.*s: I was expecting a function body, not \"%c\"", (int)SvCUR(declarator), SvPV_nolen(declarator), (int)c);
	}
	lex_read_unichar(0);
	sv_catpvs(gen, "{");
	if (spec->shift[0]) {
		sv_catpvf(gen, "my%s=shift;", spec->shift);
	}
	if (SvCUR(params)) {
		sv_catpvs(gen, "my(");
		sv_catsv(gen, params);
		sv_catpvs(gen, ")=@_;");
	}

	/* fprintf(stderr, "! [%.*s]\n", (int)(PL_bufend - PL_bufptr), PL_bufptr); */

	/* named sub */
	if (saw_name) {
		lex_stuff_sv(gen, SvUTF8(gen));
		*pop = parse_barestmt(0);
		return KEYWORD_PLUGIN_STMT;
	}

	/* anon sub */
	sv_catpvs(gen, "BEGIN{" MY_PKG "::_fini}");
	lex_stuff_sv(gen, SvUTF8(gen));
	*pop = parse_arithexpr(0);
	s = PL_parser->bufptr;
	if (*s != '}') {
		croak("%s: internal error: expected '}', found '%c'", MY_PKG, *s);
	}
	lex_unstuff(s + 1);
	return KEYWORD_PLUGIN_EXPR;
}

static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
	Spec spec;
	int ret;

	SAVETMPS;

	if (kw_flags(aTHX_ keyword_ptr, keyword_len, &spec)) {
		ret = parse_fun(aTHX_ op_ptr, keyword_ptr, keyword_len, &spec);
	} else {
		ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
	}

	FREETMPS;

	return ret;
}

WARNINGS_RESET

MODULE = Function::Parameters   PACKAGE = Function::Parameters
PROTOTYPES: ENABLE

BOOT:
WARNINGS_ENABLE {
	HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
	newCONSTSUB(stash, "FLAG_NAME_OPTIONAL", newSViv(FLAG_NAME_OPTIONAL));
	newCONSTSUB(stash, "FLAG_NAME_REQUIRED", newSViv(FLAG_NAME_REQUIRED));
	newCONSTSUB(stash, "FLAG_NAME_PROHIBITED", newSViv(FLAG_NAME_PROHIBITED));
	newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
	newCONSTSUB(stash, "HINTK_NAME_", newSVpvs(HINTK_NAME_));
	newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_));
	newCONSTSUB(stash, "SHIFT_NAME_LIMIT", newSViv(sizeof ((Spec *)NULL)->shift));
	next_keyword_plugin = PL_keyword_plugin;
	PL_keyword_plugin = my_keyword_plugin;
} WARNINGS_RESET

void
xs_fini()
	CODE:
	lex_stuff_pvn("}", 1, 0);
Commit	Line	Data
db81d362	1	/*
	2	Copyright 2012 Lukas Mai.
	3
	4	This program is free software; you can redistribute it and/or modify it
	5	under the terms of either: the GNU General Public License as published
	6	by the Free Software Foundation; or the Artistic License.
	7
	8	See 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) \
	29	WARNINGS_ENABLEW(-Wshadow) \
	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
	52	WARNINGS_ENABLE
	53
	54	#define MY_PKG "Function::Parameters"
	55
	56	#define HINTK_KEYWORDS MY_PKG "/keywords"
	57	#define HINTK_NAME_ MY_PKG "/name:"
	58	#define HINTK_SHIFT_ MY_PKG "/shift:"
	59
7dd35535	60	#define HAVE_PERL_VERSION(R, V, S) \
	61	(PERL_REVISION > (R) \|\| (PERL_REVISION == (R) && (PERL_VERSION > (V) \|\| (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
	62
db81d362	63	typedef struct {
	64	enum {
	65	FLAG_NAME_OPTIONAL = 1,
	66	FLAG_NAME_REQUIRED,
	67	FLAG_NAME_PROHIBITED
	68	} name;
	69	char shift[256];
	70	} Spec;
	71
	72	static int (next_keyword_plugin)(pTHX_ char , STRLEN, OP **);
	73
7dd35535	74	static int kw_flags(pTHX_ const char kw_ptr, STRLEN kw_len, Spec spec) {
db81d362	75	HV *hints;
	76	SV sv, *psv;
	77	const char p, kw_active;
	78	STRLEN kw_active_len;
	79
	80	spec->name = 0;
	81	spec->shift[0] = '\0';
	82
	83	if (!(hints = GvHV(PL_hintgv))) {
	84	return FALSE;
	85	}
	86	if (!(psv = hv_fetchs(hints, HINTK_KEYWORDS, 0))) {
	87	return FALSE;
	88	}
	89	sv = *psv;
	90	kw_active = SvPV(sv, kw_active_len);
	91	if (kw_active_len <= kw_len) {
	92	return FALSE;
	93	}
	94	for (p = kw_active; p < kw_active + kw_active_len - kw_len; p++) {
	95	if (
	96	(p == kw_active \|\| p[-1] == ' ') &&
	97	p[kw_len] == ' ' &&
	98	memcmp(kw_ptr, p, kw_len) == 0
	99	) {
	100	const char *kf_ptr;
	101	STRLEN kf_len;
	102	SV *kf_sv;
	103
	104	kf_sv = sv_2mortal(newSVpvs(HINTK_NAME_));
	105	sv_catpvn(kf_sv, kw_ptr, kw_len);
	106	kf_ptr = SvPV(kf_sv, kf_len);
	107	if (!(psv = hv_fetch(hints, kf_ptr, kf_len, 0))) {
	108	croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)kf_len, kf_ptr);
	109	}
	110	spec->name = SvIV(*psv);
	111
	112	kf_sv = sv_2mortal(newSVpvs(HINTK_SHIFT_));
	113	sv_catpvn(kf_sv, kw_ptr, kw_len);
	114	kf_ptr = SvPV(kf_sv, kf_len);
	115	if (!(psv = hv_fetch(hints, kf_ptr, kf_len, 0))) {
	116	croak("%s: internal error: $^H{'%.*s'} not set", MY_PKG, (int)kf_len, kf_ptr);
	117	}
	118	my_sprintf(spec->shift, "%.s", (int)(sizeof spec->shift - 1), SvPV_nolen(psv));
	119
	120	return TRUE;
	121	}
	122	}
	123	return FALSE;
	124	}
	125
	126
	127	#include "toke_on_crack.c.inc"
	128
	129
7dd35535	130	static int parse_fun(pTHX_ OP *pop, const char keyword_ptr, STRLEN keyword_len, const Spec *spec) {
db81d362	131	SV gen, declarator, params, sv;
	132	line_t line_start;
	133	int saw_name, saw_colon;
	134	STRLEN len;
	135	char *s;
	136	I32 c;
	137
	138	gen = sv_2mortal(newSVpvs("sub"));
	139	declarator = sv_2mortal(newSVpvn(keyword_ptr, keyword_len));
	140	params = sv_2mortal(newSVpvs(""));
	141
	142	line_start = CopLINE(PL_curcop);
	143	lex_read_space(0);
	144
	145	/* function name */
	146	saw_name = 0;
	147	s = PL_parser->bufptr;
7dd35535	148	if (spec->name != FLAG_NAME_PROHIBITED && (len = S_scan_word(aTHX_ s, TRUE))) {
db81d362	149	sv_catpvs(gen, " ");
	150	sv_catpvn(gen, s, len);
	151	sv_catpvs(declarator, " ");
	152	sv_catpvn(declarator, s, len);
	153	lex_read_to(s + len);
	154	lex_read_space(0);
	155	saw_name = 1;
	156	} else if (spec->name == FLAG_NAME_REQUIRED) {
	157	croak("I was expecting a function name, not \"%.*s\"", (int)(PL_parser->bufend - s), s);
	158	} else {
	159	sv_catpvs(declarator, " (anon)");
	160	}
	161
	162	/* parameters */
	163	c = lex_peek_unichar(0);
	164	if (c == '(') {
	165	SV *saw_slurpy = NULL;
	166
	167	lex_read_unichar(0);
	168	lex_read_space(0);
	169
	170	for (;;) {
	171	c = lex_peek_unichar(0);
	172	if (c && strchr("$@%", c)) {
	173	sv_catpvf(params, "%c", (int)c);
	174	lex_read_unichar(0);
	175	lex_read_space(0);
	176
	177	s = PL_parser->bufptr;
7dd35535	178	if (!(len = S_scan_word(aTHX_ s, FALSE))) {
db81d362	179	croak("In %.*s: missing identifier", (int)SvCUR(declarator), SvPV_nolen(declarator));
	180	}
	181	if (saw_slurpy) {
	182	croak("In %.s: I was expecting \")\" after \"%s\", not \"%c%.s\"", (int)SvCUR(declarator), SvPV_nolen(declarator), SvPV_nolen(saw_slurpy), (int)c, (int)len, s);
	183	}
	184	if (c != '$') {
	185	saw_slurpy = sv_2mortal(newSVpvf("%c%.*s", (int)c, (int)len, s));
	186	}
	187	sv_catpvn(params, s, len);
	188	sv_catpvs(params, ",");
	189	lex_read_to(s + len);
	190	lex_read_space(0);
	191
	192	c = lex_peek_unichar(0);
	193	if (c == ',') {
	194	lex_read_unichar(0);
	195	lex_read_space(0);
	196	continue;
	197	}
	198	}
	199
	200	if (c == ')') {
	201	lex_read_unichar(0);
	202	lex_read_space(0);
	203	break;
	204	}
	205
	206	if (c == -1) {
	207	croak("In %.*s: unexpected EOF in parameter list", (int)SvCUR(declarator), SvPV_nolen(declarator));
	208	}
	209	croak("In %.*s: unexpected '%c' in parameter list", (int)SvCUR(declarator), SvPV_nolen(declarator), (int)c);
	210	}
	211	}
	212
	213	/* prototype */
	214	saw_colon = 0;
	215	c = lex_peek_unichar(0);
	216	if (c == ':') {
	217	lex_read_unichar(0);
	218	lex_read_space(0);
	219
	220	c = lex_peek_unichar(0);
	221	if (c != '(') {
	222	saw_colon = 1;
	223	} else {
	224	sv = sv_2mortal(newSVpvs(""));
7dd35535	225	if (!S_scan_str(aTHX_ sv, TRUE, TRUE)) {
db81d362	226	croak("In %.*s: malformed prototype", (int)SvCUR(declarator), SvPV_nolen(declarator));
	227	}
	228	sv_catsv(gen, sv);
	229	lex_read_space(0);
	230	}
	231	}
	232
	233	if (saw_name) {
	234	len = SvCUR(gen);
	235	s = SvGROW(gen, (len + 1) * 2);
	236	sv_catpvs(gen, ";");
	237	sv_catpvn(gen, s, len);
	238	}
	239
	240	/* attributes */
	241	if (!saw_colon) {
	242	c = lex_peek_unichar(0);
	243	if (c == ':') {
	244	saw_colon = 1;
	245	lex_read_unichar(0);
	246	lex_read_space(0);
	247	}
	248	}
	249	if (saw_colon) {
	250	for (;;) {
	251	s = PL_parser->bufptr;
7dd35535	252	if (!(len = S_scan_word(aTHX_ s, FALSE))) {
db81d362	253	break;
	254	}
	255	sv_catpvs(gen, ":");
	256	sv_catpvn(gen, s, len);
	257	lex_read_to(s + len);
	258	lex_read_space(0);
	259	c = lex_peek_unichar(0);
	260	if (c == '(') {
	261	sv = sv_2mortal(newSVpvs(""));
7dd35535	262	if (!S_scan_str(aTHX_ sv, TRUE, TRUE)) {
db81d362	263	croak("In %.*s: malformed attribute argument list", (int)SvCUR(declarator), SvPV_nolen(declarator));
	264	}
	265	sv_catsv(gen, sv);
	266	lex_read_space(0);
	267	c = lex_peek_unichar(0);
	268	}
	269	if (c == ':') {
	270	lex_read_unichar(0);
	271	lex_read_space(0);
	272	}
	273	}
	274	}
	275
	276	/* body */
	277	c = lex_peek_unichar(0);
	278	if (c != '{') {
	279	croak("In %.*s: I was expecting a function body, not \"%c\"", (int)SvCUR(declarator), SvPV_nolen(declarator), (int)c);
	280	}
	281	lex_read_unichar(0);
	282	sv_catpvs(gen, "{");
	283	if (spec->shift[0]) {
	284	sv_catpvf(gen, "my%s=shift;", spec->shift);
	285	}
	286	if (SvCUR(params)) {
	287	sv_catpvs(gen, "my(");
	288	sv_catsv(gen, params);
	289	sv_catpvs(gen, ")=@_;");
	290	}
	291
	292	/* fprintf(stderr, "! [%.s]\n", (int)(PL_bufend - PL_bufptr), PL_bufptr); /
	293
	294	/* named sub */
	295	if (saw_name) {
	296	lex_stuff_sv(gen, SvUTF8(gen));
	297	*pop = parse_barestmt(0);
	298	return KEYWORD_PLUGIN_STMT;
	299	}
	300
	301	/* anon sub */
	302	sv_catpvs(gen, "BEGIN{" MY_PKG "::_fini}");
	303	lex_stuff_sv(gen, SvUTF8(gen));
	304	*pop = parse_arithexpr(0);
	305	s = PL_parser->bufptr;
	306	if (*s != '}') {
	307	croak("%s: internal error: expected '}', found '%c'", MY_PKG, *s);
	308	}
	309	lex_unstuff(s + 1);
	310	return KEYWORD_PLUGIN_EXPR;
	311	}
	312
	313	static int my_keyword_plugin(pTHX_ char keyword_ptr, STRLEN keyword_len, OP *op_ptr) {
	314	Spec spec;
	315	int ret;
	316
	317	SAVETMPS;
	318
7dd35535	319	if (kw_flags(aTHX_ keyword_ptr, keyword_len, &spec)) {
7dd35535	320	ret = parse_fun(aTHX_ op_ptr, keyword_ptr, keyword_len, &spec);
db81d362	321	} else {
7dd35535	322	ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
db81d362	323	}
	324
	325	FREETMPS;
	326
	327	return ret;
	328	}
	329
	330	WARNINGS_RESET
	331
	332	MODULE = Function::Parameters PACKAGE = Function::Parameters
	333	PROTOTYPES: ENABLE
	334
	335	BOOT:
	336	WARNINGS_ENABLE {
	337	HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
	338	newCONSTSUB(stash, "FLAG_NAME_OPTIONAL", newSViv(FLAG_NAME_OPTIONAL));
	339	newCONSTSUB(stash, "FLAG_NAME_REQUIRED", newSViv(FLAG_NAME_REQUIRED));
	340	newCONSTSUB(stash, "FLAG_NAME_PROHIBITED", newSViv(FLAG_NAME_PROHIBITED));
	341	newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
	342	newCONSTSUB(stash, "HINTK_NAME_", newSVpvs(HINTK_NAME_));
	343	newCONSTSUB(stash, "HINTK_SHIFT_", newSVpvs(HINTK_SHIFT_));
	344	newCONSTSUB(stash, "SHIFT_NAME_LIMIT", newSViv(sizeof ((Spec *)NULL)->shift));
	345	next_keyword_plugin = PL_keyword_plugin;
	346	PL_keyword_plugin = my_keyword_plugin;
	347	} WARNINGS_RESET
	348
	349	void
	350	xs_fini()
	351	CODE:
	352	lex_stuff_pvn("}", 1, 0);