X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Parameters.xs;h=bcff6ab51aea2ad35cd7eff0b33d5f4859d969c6;hb=a4c13d402a1fdcab88937f6c1db91c399d2ae254;hp=286e79d8422abef31fab927af8cbf0be4b8f6444;hpb=91ad192b5d94ea86efed8a11b02174d7216897aa;p=p5sagit%2FFunction-Parameters.git

diff --git a/Parameters.xs b/Parameters.xs
index 286e79d..bcff6ab 100644
--- a/Parameters.xs
+++ b/Parameters.xs
@@ -96,7 +96,9 @@ enum {
 	FLAG_DEFAULT_ARGS = 0x04,
 	FLAG_CHECK_NARGS  = 0x08,
 	FLAG_INVOCANT     = 0x10,
-	FLAG_NAMED_PARAMS = 0x20
+	FLAG_NAMED_PARAMS = 0x20,
+	FLAG_TYPES_OK     = 0x40,
+	FLAG_CHECK_TARGS  = 0x80
 };
 
 DEFSTRUCT(KWSpec) {
@@ -107,15 +109,96 @@ DEFSTRUCT(KWSpec) {
 
 static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **);
 
-static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
+DEFSTRUCT(Resource) {
+	Resource *next;
+	void *data;
+	void (*destroy)(pTHX_ void *);
+};
+
+typedef Resource *Sentinel[1];
+
+static void sentinel_clear_void(pTHX_ void *p) {
+	Resource **pp = p;
+	while (*pp) {
+		Resource *cur = *pp;
+		if (cur->destroy) {
+			cur->destroy(aTHX_ cur->data);
+		}
+		cur->data = (void *)"no";
+		cur->destroy = NULL;
+		*pp = cur->next;
+		Safefree(cur);
+	}
+}
+
+static Resource *sentinel_register(Sentinel sen, void *data, void (*destroy)(pTHX_ void *)) {
+	Resource *cur;
+
+	Newx(cur, 1, Resource);
+	cur->data = data;
+	cur->destroy = destroy;
+	cur->next = *sen;
+	*sen = cur;
+
+	return cur;
+}
+
+static void sentinel_disarm(Resource *p) {
+	p->destroy = NULL;
+}
+
+static void my_sv_refcnt_dec_void(pTHX_ void *p) {
+	SV *sv = p;
+	SvREFCNT_dec(sv);
+}
+
+static SV *sentinel_mortalize(Sentinel sen, SV *sv) {
+	sentinel_register(sen, sv, my_sv_refcnt_dec_void);
+	return sv;
+}
+
+static void my_safefree(void *p) {
+	Safefree(p);
+}
+
+#define SENTINEL_ALLOC(SEN, P, N, T) STMT_START { \
+	Newx(P, N, T); \
+	sentinel_register(SEN, P, my_safefree); \
+} STMT_END
+
+#define SENTINEL_MDUP(SEN, P, O, N, T) STMT_START { \
+	void *const _sentinel_mdup_tmp_ = (P); \
+	SENTINEL_ALLOC(SEN, P, N, T); \
+	memcpy(P, _sentinel_mdup_tmp_, O * sizeof (T)); \
+} STMT_END
+
+#define SENTINEL_REALLOC(SEN, P, N, T) STMT_START { \
+	assert((N) > 0); \
+	if (!(P)) { \
+		SENTINEL_ALLOC(SEN, P, N, T); \
+	} else { \
+		Resource **_sentinel_realloc_tmp_ = (SEN); \
+		for (;;) { \
+			assert(*_sentinel_realloc_tmp_ != NULL); \
+			if ((*_sentinel_realloc_tmp_)->data == (P)) { \
+				Renew((*_sentinel_realloc_tmp_)->data, N, T); \
+				(P) = (*_sentinel_realloc_tmp_)->data; \
+				break; \
+			} \
+			_sentinel_realloc_tmp_ = &(*_sentinel_realloc_tmp_)->next; \
+		} \
+	} \
+} STMT_END
+
+static int kw_flags(pTHX_ Sentinel sen, const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
 	HV *hints;
 	SV *sv, **psv;
 	const char *p, *kw_active;
 	STRLEN kw_active_len;
 
 	spec->flags = 0;
-	spec->shift = sv_2mortal(newSVpvs(""));
-	spec->attrs = sv_2mortal(newSVpvs(""));
+	spec->shift = sentinel_mortalize(sen, newSVpvs(""));
+	spec->attrs = sentinel_mortalize(sen, newSVpvs(""));
 
 	if (!(hints = GvHV(PL_hintgv))) {
 		return FALSE;
@@ -144,7 +227,7 @@ static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
 	const char *fk_ptr_; \
 	STRLEN fk_len_; \
 	SV *fk_sv_; \
-	fk_sv_ = sv_2mortal(newSVpvs(HINTK_ ## NAME)); \
+	fk_sv_ = sentinel_mortalize(sen, newSVpvs(HINTK_ ## NAME)); \
 	sv_catpvn(fk_sv_, PTR, LEN); \
 	fk_ptr_ = SvPV(fk_sv_, fk_len_); \
 	if (!((X) = hv_fetch(hints, fk_ptr_, fk_len_, 0))) { \
@@ -169,12 +252,17 @@ static int kw_flags(pTHX_ const char *kw_ptr, STRLEN kw_len, KWSpec *spec) {
 }
 
 
-static void free_ptr_op(pTHX_ void *vp) {
+static void free_ptr_op_void(pTHX_ void *vp) {
 	OP **pp = vp;
 	op_free(*pp);
 	Safefree(pp);
 }
 
+static void free_op_void(pTHX_ void *vp) {
+	OP *p = vp;
+	op_free(p);
+}
+
 #define sv_eq_pvs(SV, S) my_sv_eq_pvn(aTHX_ SV, "" S "", sizeof (S) - 1)
 
 static int my_sv_eq_pvn(pTHX_ SV *sv, const char *p, STRLEN n) {
@@ -214,10 +302,10 @@ static bool my_is_uni_xidcont(pTHX_ UV c) {
 	return is_utf8_xidcont(tmpbuf);
 }
 
-static SV *my_scan_word(pTHX_ bool allow_package) {
+static SV *my_scan_word(pTHX_ Sentinel sen, bool allow_package) {
 	bool at_start, at_substart;
 	I32 c;
-	SV *sv = sv_2mortal(newSVpvs(""));
+	SV *sv = sentinel_mortalize(sen, newSVpvs(""));
 	if (lex_bufutf8()) {
 		SvUTF8_on(sv);
 	}
@@ -263,14 +351,14 @@ static SV *my_scan_word(pTHX_ bool allow_package) {
 	return SvCUR(sv) ? sv : NULL;
 }
 
-static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) {
+static SV *my_scan_parens_tail(pTHX_ Sentinel sen, bool keep_backslash) {
 	I32 c, nesting;
 	SV *sv;
 	line_t start;
 
 	start = CopLINE(PL_curcop);
 
-	sv = sv_2mortal(newSVpvs(""));
+	sv = sentinel_mortalize(sen, newSVpvs(""));
 	if (lex_bufutf8()) {
 		SvUTF8_on(sv);
 	}
@@ -307,7 +395,7 @@ static SV *my_scan_parens_tail(pTHX_ bool keep_backslash) {
 	return sv;
 }
 
-static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) {
+static void my_check_prototype(pTHX_ Sentinel sen, const SV *declarator, SV *proto) {
 	char *start, *r, *w, *end;
 	STRLEN len;
 
@@ -331,7 +419,7 @@ static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) {
 
 	/* check for bad characters */
 	if (strspn(start, "$@%*;[]&\\_+") != len) {
-		SV *dsv = newSVpvs_flags("", SVs_TEMP);
+		SV *dsv = sentinel_mortalize(sen, newSVpvs(""));
 		warner(
 			packWARN(WARN_ILLEGALPROTO),
 			"Illegal character in prototype for %"SVf" : %s",
@@ -416,10 +504,97 @@ static void my_check_prototype(pTHX_ const SV *declarator, SV *proto) {
 	}
 }
 
+static SV *parse_type(pTHX_ Sentinel, const SV *);
+
+static SV *parse_type_paramd(pTHX_ Sentinel sen, const SV *declarator) {
+	I32 c;
+	SV *t;
+
+	t = my_scan_word(aTHX_ sen, TRUE);
+	lex_read_space(0);
+
+	c = lex_peek_unichar(0);
+	if (c == '[') {
+		SV *u;
+
+		lex_read_unichar(0);
+		lex_read_space(0);
+		my_sv_cat_c(aTHX_ t, c);
+
+		u = parse_type(aTHX_ sen, declarator);
+		sv_catsv(t, u);
+
+		c = lex_peek_unichar(0);
+		if (c != ']') {
+			croak("In %"SVf": missing ']' after '%"SVf"'", SVfARG(declarator), SVfARG(t));
+		}
+		lex_read_unichar(0);
+		lex_read_space(0);
+
+		my_sv_cat_c(aTHX_ t, c);
+	}
+
+	return t;
+}
+
+static SV *parse_type(pTHX_ Sentinel sen, const SV *declarator) {
+	I32 c;
+	SV *t;
+
+	t = parse_type_paramd(aTHX_ sen, declarator);
+
+	c = lex_peek_unichar(0);
+	while (c == '|') {
+		SV *u;
+
+		lex_read_unichar(0);
+		lex_read_space(0);
+
+		my_sv_cat_c(aTHX_ t, c);
+		u = parse_type_paramd(aTHX_ sen, declarator);
+		sv_catsv(t, u);
+
+		c = lex_peek_unichar(0);
+	}
+
+	return t;
+}
+
+static SV *reify_type(pTHX_ Sentinel sen, const SV *declarator, SV *name) {
+	SV *t;
+	int n;
+	dSP;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	EXTEND(SP, 1);
+	PUSHs(name);
+	PUTBACK;
+
+	n = call_pv("Moose::Util::TypeConstraints::find_or_parse_type_constraint", G_SCALAR);
+	SPAGAIN;
+
+	assert(n == 1);
+	t = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	if (!SvTRUE(t)) {
+		croak("In %"SVf": undefined type '%"SVf"'", SVfARG(declarator), SVfARG(name));
+	}
+
+	return t;
+}
+
 
 DEFSTRUCT(Param) {
 	SV *name;
 	PADOFFSET padoff;
+	SV *type;
 };
 
 DEFSTRUCT(ParamInit) {
@@ -459,6 +634,7 @@ DEFVECTOR_INIT(piv_init, ParamInit);
 static void p_init(Param *p) {
 	p->name = NULL;
 	p->padoff = NOT_IN_PAD;
+	p->type = NULL;
 }
 
 static void ps_init(ParamSpec *ps) {
@@ -497,6 +673,7 @@ DEFVECTOR_EXTEND(piv_extend, ParamInit);
 static void p_clear(pTHX_ Param *p) {
 	p->name = NULL;
 	p->padoff = NOT_IN_PAD;
+	p->type = NULL;
 }
 
 static void pi_clear(pTHX_ ParamInit *pi) {
@@ -598,6 +775,35 @@ static size_t count_named_params(const ParamSpec *ps) {
 	return ps->named_required.used + ps->named_optional.used;
 }
 
+static void my_require(pTHX_ const char *file) {
+	require_pv(file);
+	if (SvTRUE(ERRSV)) {
+		croak_sv(ERRSV);
+	}
+}
+
+static SV *my_eval(pTHX_ Sentinel sen, I32 floor, OP *op) {
+	SV *sv;
+	CV *cv;
+	dSP;
+
+	cv = newATTRSUB(floor, NULL, NULL, NULL, op);
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	call_sv((SV *)cv, G_SCALAR | G_NOARGS);
+	SPAGAIN;
+	sv = sentinel_mortalize(sen, SvREFCNT_inc(POPs));
+
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+
+	return sv;
+}
+
 enum {
 	PARAM_INVOCANT = 0x01,
 	PARAM_NAMED    = 0x02
@@ -608,8 +814,9 @@ enum {
  */
 static PADOFFSET parse_param(
 	pTHX_
+	Sentinel sen,
 	const SV *declarator, const KWSpec *spec, ParamSpec *param_spec,
-	int *pflags, SV **pname, OP **pinit
+	int *pflags, SV **pname, OP **pinit, SV **ptype
 ) {
 	I32 c;
 	char sigil;
@@ -617,9 +824,53 @@ static PADOFFSET parse_param(
 
 	assert(!*pinit);
 	*pflags = 0;
+	*ptype = NULL;
 
 	c = lex_peek_unichar(0);
 
+	if (spec->flags & FLAG_TYPES_OK) {
+		if (c == '(') {
+			I32 floor;
+			OP *expr;
+			Resource *expr_sentinel;
+
+			lex_read_unichar(0);
+
+			floor = start_subparse(FALSE, 0);
+			SAVEFREESV(PL_compcv);
+			CvSPECIAL_on(PL_compcv);
+
+			if (!(expr = parse_fullexpr(PARSE_OPTIONAL))) {
+				croak("In %"SVf": invalid type expression", SVfARG(declarator));
+			}
+			expr_sentinel = sentinel_register(sen, expr, free_op_void);
+
+			lex_read_space(0);
+			c = lex_peek_unichar(0);
+			if (c != ')') {
+				croak("In %"SVf": missing ')' after type expression", SVfARG(declarator));
+			}
+			lex_read_unichar(0);
+			lex_read_space(0);
+
+			SvREFCNT_inc_simple_void(PL_compcv);
+			sentinel_disarm(expr_sentinel);
+			*ptype = my_eval(aTHX_ sen, floor, expr);
+			*ptype = reify_type(aTHX_ sen, declarator, *ptype);
+			if (!sv_isobject(*ptype)) {
+				croak("In %"SVf": (%"SVf") doesn't look like a type object", SVfARG(declarator), SVfARG(*ptype));
+			}
+
+			c = lex_peek_unichar(0);
+		} else if (my_is_uni_xidfirst(aTHX_ c)) {
+			*ptype = parse_type(aTHX_ sen, declarator);
+			my_require(aTHX_ "Moose/Util/TypeConstraints.pm");
+			*ptype = reify_type(aTHX_ sen, declarator, *ptype);
+
+			c = lex_peek_unichar(0);
+		}
+	}
+
 	if (c == ':') {
 		lex_read_unichar(0);
 		lex_read_space(0);
@@ -632,6 +883,7 @@ static PADOFFSET parse_param(
 	if (c == -1) {
 		croak("In %"SVf": unterminated parameter list", SVfARG(declarator));
 	}
+
 	if (!(c == '$' || c == '@' || c == '%')) {
 		croak("In %"SVf": unexpected '%c' in parameter list (expecting a sigil)", SVfARG(declarator), (int)c);
 	}
@@ -641,7 +893,7 @@ static PADOFFSET parse_param(
 	lex_read_unichar(0);
 	lex_read_space(0);
 
-	if (!(name = my_scan_word(aTHX_ FALSE))) {
+	if (!(name = my_scan_word(aTHX_ sen, FALSE))) {
 		croak("In %"SVf": missing identifier after '%c'", SVfARG(declarator), sigil);
 	}
 	sv_insert(name, 0, 0, &sigil, 1);
@@ -712,7 +964,203 @@ static OP *mkconstpv(pTHX_ const char *p, size_t n) {
 
 #define mkconstpvs(S) mkconstpv(aTHX_ "" S "", sizeof S - 1)
 
-static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
+static OP *mktypecheck(pTHX_ const SV *declarator, int nr, SV *name, PADOFFSET padoff, SV *type) {
+	/* $type->check($value) or Carp::croak "...: " . $type->get_message($value) */
+	OP *chk, *cond, *err, *msg, *xcroak;
+
+	err = mkconstsv(aTHX_ newSVpvf("In %"SVf": parameter %d (%"SVf"): ", SVfARG(declarator), nr, SVfARG(name)));
+	{
+		OP *args = NULL;
+
+		args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
+		args = op_append_elem(
+			OP_LIST, args,
+			padoff == NOT_IN_PAD
+				? S_newDEFSVOP(aTHX)
+				: my_var(aTHX_ 0, padoff)
+		);
+		args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("get_message")));
+
+		msg = args;
+		msg->op_type = OP_ENTERSUB;
+		msg->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+		msg->op_flags |= OPf_STACKED;
+	}
+
+	msg = newBINOP(OP_CONCAT, 0, err, msg);
+
+	xcroak = newCVREF(
+		OPf_WANT_SCALAR,
+		newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
+	);
+	xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
+
+	{
+		OP *args = NULL;
+
+		args = op_append_elem(OP_LIST, args, mkconstsv(aTHX_ SvREFCNT_inc_simple_NN(type)));
+		args = op_append_elem(
+			OP_LIST, args,
+			padoff == NOT_IN_PAD
+				? S_newDEFSVOP(aTHX)
+				: my_var(aTHX_ 0, padoff)
+		);
+		args = op_append_elem(OP_LIST, args, newUNOP(OP_METHOD, 0, mkconstpvs("check")));
+
+		chk = args;
+		chk->op_type = OP_ENTERSUB;
+		chk->op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+		chk->op_flags |= OPf_STACKED;
+	}
+
+	chk = newLOGOP(OP_OR, 0, chk, xcroak);
+	return chk;
+}
+
+static OP *mktypecheckp(pTHX_ const SV *declarator, int nr, const Param *param) {
+	return mktypecheck(aTHX_ declarator, nr, param->name, param->padoff, param->type);
+}
+
+static void register_info(pTHX_ UV key, SV *declarator, const KWSpec *kws, const ParamSpec *ps) {
+	dSP;
+
+	ENTER;
+	SAVETMPS;
+
+	PUSHMARK(SP);
+	EXTEND(SP, 10);
+
+	/* 0 */ {
+		mPUSHu(key);
+	}
+	/* 1 */ {
+		size_t n;
+		char *p = SvPV(declarator, n);
+		char *q = memchr(p, ' ', n);
+		mPUSHp(p, q ? q - p : n);
+	}
+	if (!ps) {
+		if (SvTRUE(kws->shift)) {
+			PUSHs(kws->shift);
+		} else {
+			PUSHmortal;
+		}
+		PUSHmortal;
+		mPUSHs(newRV_noinc((SV *)newAV()));
+		mPUSHs(newRV_noinc((SV *)newAV()));
+		mPUSHs(newRV_noinc((SV *)newAV()));
+		mPUSHs(newRV_noinc((SV *)newAV()));
+		mPUSHp("@_", 2);
+		PUSHmortal;
+	} else {
+		/* 2, 3 */ {
+			if (ps->invocant.name) {
+				PUSHs(ps->invocant.name);
+				if (ps->invocant.type) {
+					PUSHs(ps->invocant.type);
+				} else {
+					PUSHmortal;
+				}
+			} else {
+				PUSHmortal;
+				PUSHmortal;
+			}
+		}
+		/* 4 */ {
+			size_t i, lim;
+			AV *av;
+
+			lim = ps->positional_required.used;
+
+			av = newAV();
+			if (lim) {
+				av_extend(av, (lim - 1) * 2);
+				for (i = 0; i < lim; i++) {
+					Param *cur = &ps->positional_required.data[i];
+					av_push(av, SvREFCNT_inc_simple_NN(cur->name));
+					av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
+				}
+			}
+
+			mPUSHs(newRV_noinc((SV *)av));
+		}
+		/* 5 */ {
+			size_t i, lim;
+			AV *av;
+
+			lim = ps->positional_optional.used;
+
+			av = newAV();
+			if (lim) {
+				av_extend(av, (lim - 1) * 2);
+				for (i = 0; i < lim; i++) {
+					Param *cur = &ps->positional_optional.data[i].param;
+					av_push(av, SvREFCNT_inc_simple_NN(cur->name));
+					av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
+				}
+			}
+
+			mPUSHs(newRV_noinc((SV *)av));
+		}
+		/* 6 */ {
+			size_t i, lim;
+			AV *av;
+
+			lim = ps->named_required.used;
+
+			av = newAV();
+			if (lim) {
+				av_extend(av, (lim - 1) * 2);
+				for (i = 0; i < lim; i++) {
+					Param *cur = &ps->named_required.data[i];
+					av_push(av, SvREFCNT_inc_simple_NN(cur->name));
+					av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
+				}
+			}
+
+			mPUSHs(newRV_noinc((SV *)av));
+		}
+		/* 7 */ {
+			size_t i, lim;
+			AV *av;
+
+			lim = ps->named_optional.used;
+
+			av = newAV();
+			if (lim) {
+				av_extend(av, (lim - 1) * 2);
+				for (i = 0; i < lim; i++) {
+					Param *cur = &ps->named_optional.data[i].param;
+					av_push(av, SvREFCNT_inc_simple_NN(cur->name));
+					av_push(av, cur->type ? SvREFCNT_inc_simple_NN(cur->type) : &PL_sv_undef);
+				}
+			}
+
+			mPUSHs(newRV_noinc((SV *)av));
+		}
+		/* 8, 9 */ {
+			if (ps->slurpy.name) {
+				PUSHs(ps->slurpy.name);
+				if (ps->slurpy.type) {
+					PUSHs(ps->slurpy.type);
+				} else {
+					PUSHmortal;
+				}
+			} else {
+				PUSHmortal;
+				PUSHmortal;
+			}
+		}
+	}
+	PUTBACK;
+
+	call_pv(MY_PKG "::_register_info", G_VOID);
+
+	FREETMPS;
+	LEAVE;
+}
+
+static int parse_fun(pTHX_ Sentinel sen, OP **pop, const char *keyword_ptr, STRLEN keyword_len, const KWSpec *spec) {
 	ParamSpec *param_spec;
 	SV *declarator;
 	I32 floor_ix;
@@ -724,7 +1172,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 	unsigned builtin_attrs;
 	I32 c;
 
-	declarator = sv_2mortal(newSVpvn(keyword_ptr, keyword_len));
+	declarator = sentinel_mortalize(sen, newSVpvn(keyword_ptr, keyword_len));
 
 	lex_read_space(0);
 
@@ -732,7 +1180,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 
 	/* function name */
 	saw_name = NULL;
-	if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ TRUE))) {
+	if ((spec->flags & FLAG_NAME_OK) && (saw_name = my_scan_word(aTHX_ sen, TRUE))) {
 
 		if (PL_parser->expect != XSTATE) {
 			/* bail out early so we don't predeclare $saw_name */
@@ -769,7 +1217,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 	/* initialize synthetic optree */
 	Newx(prelude_sentinel, 1, OP *);
 	*prelude_sentinel = NULL;
-	SAVEDESTRUCTOR_X(free_ptr_op, prelude_sentinel);
+	sentinel_register(sen, prelude_sentinel, free_ptr_op_void);
 
 	/* parameters */
 	param_spec = NULL;
@@ -780,22 +1228,22 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 
 		Newx(init_sentinel, 1, OP *);
 		*init_sentinel = NULL;
-		SAVEDESTRUCTOR_X(free_ptr_op, init_sentinel);
+		sentinel_register(sen, init_sentinel, free_ptr_op_void);
 
 		Newx(param_spec, 1, ParamSpec);
 		ps_init(param_spec);
-		SAVEDESTRUCTOR_X(ps_free_void, param_spec);
+		sentinel_register(sen, param_spec, ps_free_void);
 
 		lex_read_unichar(0);
 		lex_read_space(0);
 
 		while ((c = lex_peek_unichar(0)) != ')') {
 			int flags;
-			SV *name;
+			SV *name, *type;
 			char sigil;
 			PADOFFSET padoff;
 
-			padoff = parse_param(aTHX_ declarator, spec, param_spec, &flags, &name, init_sentinel);
+			padoff = parse_param(aTHX_ sen, declarator, spec, param_spec, &flags, &name, init_sentinel, &type);
 
 			S_intro_my(aTHX);
 
@@ -828,6 +1276,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 				assert(!*init_sentinel);
 				param_spec->slurpy.name = name;
 				param_spec->slurpy.padoff = padoff;
+				param_spec->slurpy.type = type;
 				continue;
 			}
 
@@ -847,6 +1296,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 				}
 				param_spec->invocant.name = name;
 				param_spec->invocant.padoff = padoff;
+				param_spec->invocant.type = type;
 				continue;
 			}
 
@@ -867,6 +1317,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 					ParamInit *pi = piv_extend(&param_spec->named_optional);
 					pi->param.name = name;
 					pi->param.padoff = padoff;
+					pi->param.type = type;
 					pi->init = *init_sentinel;
 					*init_sentinel = NULL;
 					param_spec->named_optional.used++;
@@ -878,6 +1329,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 					Param *p = pv_extend(&param_spec->named_required);
 					p->name = name;
 					p->padoff = padoff;
+					p->type = type;
 					param_spec->named_required.used++;
 				}
 			} else {
@@ -885,6 +1337,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 					ParamInit *pi = piv_extend(&param_spec->positional_optional);
 					pi->param.name = name;
 					pi->param.padoff = padoff;
+					pi->param.type = type;
 					pi->init = *init_sentinel;
 					*init_sentinel = NULL;
 					param_spec->positional_optional.used++;
@@ -892,6 +1345,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 					Param *p = pv_extend(&param_spec->positional_required);
 					p->name = name;
 					p->padoff = padoff;
+					p->type = type;
 					param_spec->positional_required.used++;
 				}
 			}
@@ -924,10 +1378,10 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 			c = ':';
 		} else {
 			lex_read_unichar(0);
-			if (!(proto = my_scan_parens_tail(aTHX_ FALSE))) {
+			if (!(proto = my_scan_parens_tail(aTHX_ sen, FALSE))) {
 				croak("In %"SVf": prototype not terminated", SVfARG(declarator));
 			}
-			my_check_prototype(aTHX_ declarator, proto);
+			my_check_prototype(aTHX_ sen, declarator, proto);
 			lex_read_space(0);
 			c = lex_peek_unichar(0);
 			if (!(c == ':' || c == '{')) {
@@ -940,7 +1394,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 	/* attributes */
 	Newx(attrs_sentinel, 1, OP *);
 	*attrs_sentinel = NULL;
-	SAVEDESTRUCTOR_X(free_ptr_op, attrs_sentinel);
+	sentinel_register(sen, attrs_sentinel, free_ptr_op_void);
 
 	if (c == ':' || c == '{') /* '}' - hi, vim */ {
 
@@ -958,7 +1412,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 			for (;;) {
 				SV *attr;
 
-				if (!(attr = my_scan_word(aTHX_ FALSE))) {
+				if (!(attr = my_scan_word(aTHX_ sen, FALSE))) {
 					break;
 				}
 
@@ -976,7 +1430,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 				} else {
 					SV *sv;
 					lex_read_unichar(0);
-					if (!(sv = my_scan_parens_tail(aTHX_ TRUE))) {
+					if (!(sv = my_scan_parens_tail(aTHX_ sen, TRUE))) {
 						croak("In %"SVf": unterminated attribute parameter in attribute list", SVfARG(declarator));
 					}
 					sv_catpvs(attr, "(");
@@ -1040,7 +1494,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 
 		amin = args_min(aTHX_ param_spec, spec);
 		if (amin > 0) {
-			OP *chk, *cond, *err, *croak;
+			OP *chk, *cond, *err, *xcroak;
 
 			err = mkconstsv(aTHX_ newSVpvf("Not enough arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amin));
 			err = newBINOP(
@@ -1054,10 +1508,10 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 				mkconstpvs(")")
 			);
 
-			croak = newCVREF(OPf_WANT_SCALAR,
-			                 newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
+			xcroak = newCVREF(OPf_WANT_SCALAR,
+			                  newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV)));
 			err = newUNOP(OP_ENTERSUB, OPf_STACKED,
-			              op_append_elem(OP_LIST, err, croak));
+			              op_append_elem(OP_LIST, err, xcroak));
 
 			cond = newBINOP(OP_LT, 0,
 			                newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
@@ -1069,7 +1523,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 
 		amax = args_max(param_spec);
 		if (amax >= 0) {
-			OP *chk, *cond, *err, *croak;
+			OP *chk, *cond, *err, *xcroak;
 
 			err = mkconstsv(aTHX_ newSVpvf("Too many arguments for %"SVf" (expected %d, got ", SVfARG(declarator), amax));
 			err = newBINOP(
@@ -1083,12 +1537,12 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 				mkconstpvs(")")
 			);
 
-			croak = newCVREF(
+			xcroak = newCVREF(
 				OPf_WANT_SCALAR,
 				newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
 			);
 			err = newUNOP(OP_ENTERSUB, OPf_STACKED,
-			op_append_elem(OP_LIST, err, croak));
+			op_append_elem(OP_LIST, err, xcroak));
 
 			cond = newBINOP(
 				OP_GT, 0,
@@ -1101,17 +1555,17 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 		}
 
 		if (param_spec && (count_named_params(param_spec) || (param_spec->slurpy.name && SvPV_nolen(param_spec->slurpy.name)[0] == '%'))) {
-			OP *chk, *cond, *err, *croak;
+			OP *chk, *cond, *err, *xcroak;
 			const UV fixed = count_positional_params(param_spec) + !!param_spec->invocant.name;
 
 			err = mkconstsv(aTHX_ newSVpvf("Odd number of paired arguments for %"SVf"", SVfARG(declarator)));
 
-			croak = newCVREF(
+			xcroak = newCVREF(
 				OPf_WANT_SCALAR,
 				newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
 			);
 			err = newUNOP(OP_ENTERSUB, OPf_STACKED,
-			op_append_elem(OP_LIST, err, croak));
+			op_append_elem(OP_LIST, err, xcroak));
 
 			cond = newBINOP(OP_GT, 0,
 			                newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
@@ -1158,6 +1612,10 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 			var = newASSIGNOP(OPf_STACKED, var, 0, newOP(OP_SHIFT, 0));
 
 			*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, var));
+
+			if (param_spec->invocant.type && (spec->flags & FLAG_CHECK_TARGS)) {
+				*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, 0, &param_spec->invocant)));
+			}
 		}
 
 		/* my (...) = @_; */
@@ -1309,21 +1767,21 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 				cond = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
 
 				if (spec->flags & FLAG_CHECK_NARGS) {
-					OP *croak, *msg;
+					OP *xcroak, *msg;
 
 					var = mkhvelem(aTHX_ param_spec->rest_hash, mkconstpv(aTHX_ p + 1, n - 1));
 					var = newUNOP(OP_DELETE, 0, var);
 
 					msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": missing named parameter: %.*s", SVfARG(declarator), (int)(n - 1), p + 1));
-					croak = newCVREF(
+					xcroak = newCVREF(
 						OPf_WANT_SCALAR,
 						newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
 					);
-					croak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, croak));
+					xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
 
 					cond = newUNOP(OP_EXISTS, 0, cond);
 
-					cond = newCONDOP(0, cond, var, croak);
+					cond = newCONDOP(0, cond, var, xcroak);
 				}
 
 				var = my_var(
@@ -1364,7 +1822,7 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 			if (!param_spec->slurpy.name) {
 				if (spec->flags & FLAG_CHECK_NARGS) {
 					/* croak if %{rest} */
-					OP *croak, *cond, *keys, *msg;
+					OP *xcroak, *cond, *keys, *msg;
 
 					keys = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
 					keys = newLISTOP(OP_SORT, 0, newOP(OP_PUSHMARK, 0), keys);
@@ -1386,16 +1844,16 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 					msg = mkconstsv(aTHX_ newSVpvf("In %"SVf": no such named parameter: ", SVfARG(declarator)));
 					msg = newBINOP(OP_CONCAT, 0, msg, keys);
 
-					croak = newCVREF(
+					xcroak = newCVREF(
 						OPf_WANT_SCALAR,
 						newGVOP(OP_GV, 0, gv_fetchpvs("Carp::croak", 0, SVt_PVCV))
 					);
-					croak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, croak));
+					xcroak = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, msg, xcroak));
 
 					cond = newUNOP(OP_KEYS, 0, my_var_g(aTHX_ OP_PADHV, 0, param_spec->rest_hash));
-					croak = newCONDOP(0, cond, croak, NULL);
+					xcroak = newCONDOP(0, cond, xcroak, NULL);
 
-					*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, croak));
+					*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, xcroak));
 				} else {
 					OP *clear;
 
@@ -1434,6 +1892,65 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 				*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, clear));
 			}
 		}
+
+		if (spec->flags & FLAG_CHECK_TARGS) {
+			size_t i, lim, base;
+
+			base = 1;
+			for (i = 0, lim = param_spec->positional_required.used; i < lim; i++) {
+				Param *cur = &param_spec->positional_required.data[i];
+
+				if (cur->type) {
+					*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
+				}
+			}
+			base += i;
+
+			for (i = 0, lim = param_spec->positional_optional.used; i < lim; i++) {
+				Param *cur = &param_spec->positional_optional.data[i].param;
+
+				if (cur->type) {
+					*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
+				}
+			}
+			base += i;
+
+			for (i = 0, lim = param_spec->named_required.used; i < lim; i++) {
+				Param *cur = &param_spec->named_required.data[i];
+
+				if (cur->type) {
+					*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
+				}
+			}
+			base += i;
+
+			for (i = 0, lim = param_spec->named_optional.used; i < lim; i++) {
+				Param *cur = &param_spec->named_optional.data[i].param;
+
+				if (cur->type) {
+					*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, mktypecheckp(aTHX_ declarator, base + i, cur)));
+				}
+			}
+			base += i;
+
+			if (param_spec->slurpy.type) {
+				/* $type->valid($_) or croak $type->get_message($_) for @rest / values %rest */
+				OP *body, *list, *loop;
+
+				body = mktypecheck(aTHX_ declarator, base, param_spec->slurpy.name, NOT_IN_PAD, param_spec->slurpy.type);
+
+				if (SvPV_nolen(param_spec->slurpy.name)[0] == '@') {
+					list = my_var_g(aTHX_ OP_PADAV, 0, param_spec->slurpy.padoff);
+				} else {
+					list = my_var_g(aTHX_ OP_PADHV, 0, param_spec->slurpy.padoff);
+					list = newUNOP(OP_VALUES, 0, list);
+				}
+
+				loop = newFOROP(0, NULL, list, body, NULL);
+
+				*prelude_sentinel = op_append_list(OP_LINESEQ, *prelude_sentinel, newSTATEOP(0, NULL, loop));
+			}
+		}
 	}
 
 	/* finally let perl parse the actual subroutine body */
@@ -1451,57 +1968,81 @@ static int parse_fun(pTHX_ OP **pop, const char *keyword_ptr, STRLEN keyword_len
 
 	/* it's go time. */
 	{
+		CV *cv;
 		OP *const attrs = *attrs_sentinel;
 		*attrs_sentinel = NULL;
+
 		SvREFCNT_inc_simple_void(PL_compcv);
 
 		/* close outer block: '}' */
 		S_block_end(aTHX_ save_ix, body);
 
-		if (!saw_name) {
-			*pop = newANONATTRSUB(
-				floor_ix,
-				proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
-				attrs,
-				body
-			);
-			return KEYWORD_PLUGIN_EXPR;
-		}
-
-		newATTRSUB(
+		cv = newATTRSUB(
 			floor_ix,
-			newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)),
+			saw_name ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(saw_name)) : NULL,
 			proto ? newSVOP(OP_CONST, 0, SvREFCNT_inc_simple_NN(proto)) : NULL,
 			attrs,
 			body
 		);
-		*pop = newOP(OP_NULL, 0);
-		return KEYWORD_PLUGIN_STMT;
+
+		register_info(aTHX_ PTR2UV(CvROOT(cv)), declarator, spec, param_spec);
+
+		if (saw_name) {
+			*pop = newOP(OP_NULL, 0);
+			return KEYWORD_PLUGIN_STMT;
+		}
+
+		*pop = newUNOP(
+			OP_REFGEN, 0,
+			newSVOP(
+				OP_ANONCODE, 0,
+				(SV *)cv
+			)
+		);
+		return KEYWORD_PLUGIN_EXPR;
 	}
 }
 
 static int my_keyword_plugin(pTHX_ char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) {
 	KWSpec spec;
 	int ret;
+	Sentinel sen = { NULL };
 
+	ENTER;
 	SAVETMPS;
 
-	if (kw_flags(aTHX_ keyword_ptr, keyword_len, &spec)) {
-		ret = parse_fun(aTHX_ op_ptr, keyword_ptr, keyword_len, &spec);
+	SAVEDESTRUCTOR_X(sentinel_clear_void, sen);
+
+	if (kw_flags(aTHX_ sen, keyword_ptr, keyword_len, &spec)) {
+		ret = parse_fun(aTHX_ sen, op_ptr, keyword_ptr, keyword_len, &spec);
 	} else {
 		ret = next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr);
 	}
 
 	FREETMPS;
+	LEAVE;
 
 	return ret;
 }
 
 WARNINGS_RESET
 
-MODULE = Function::Parameters   PACKAGE = Function::Parameters
+MODULE = Function::Parameters   PACKAGE = Function::Parameters   PREFIX = fp_
 PROTOTYPES: ENABLE
 
+UV
+fp__cv_root(sv)
+	SV * sv
+	PREINIT:
+		CV *cv;
+		HV *hv;
+		GV *gv;
+	CODE:
+		cv = sv_2cv(sv, &hv, &gv, 0);
+		RETVAL = PTR2UV(cv ? CvROOT(cv) : NULL);
+	OUTPUT:
+		RETVAL
+
 BOOT:
 WARNINGS_ENABLE {
 	HV *const stash = gv_stashpvs(MY_PKG, GV_ADD);
@@ -1512,6 +2053,8 @@ WARNINGS_ENABLE {
 	newCONSTSUB(stash, "FLAG_CHECK_NARGS",  newSViv(FLAG_CHECK_NARGS));
 	newCONSTSUB(stash, "FLAG_INVOCANT",     newSViv(FLAG_INVOCANT));
 	newCONSTSUB(stash, "FLAG_NAMED_PARAMS", newSViv(FLAG_NAMED_PARAMS));
+	newCONSTSUB(stash, "FLAG_TYPES_OK",     newSViv(FLAG_TYPES_OK));
+	newCONSTSUB(stash, "FLAG_CHECK_TARGS",  newSViv(FLAG_CHECK_TARGS));
 	newCONSTSUB(stash, "HINTK_KEYWORDS", newSVpvs(HINTK_KEYWORDS));
 	newCONSTSUB(stash, "HINTK_FLAGS_",   newSVpvs(HINTK_FLAGS_));
 	newCONSTSUB(stash, "HINTK_SHIFT_",   newSVpvs(HINTK_SHIFT_));