X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=4c040d1bb02a7b22bb2343388e1ab81e945c54d8;hb=51a483f8759fdd86fd00cdef0c2322be86ad4652;hp=c67e6ecc8c8ba906be8260c1d362902d0c6761f2;hpb=420e3b82292bffb2b57f7775fc2f276a2dad7d1c;p=p5sagit%2FFunction-Parameters.git

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index c67e6ec..4c040d1 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -32,12 +32,14 @@ my %type_map = (
 		default_arguments => 1,
 		check_argument_count => 0,
 		named_parameters => 1,
+		types => 1,
 	},
 	method   => {
 		name => 'optional',
 		default_arguments => 1,
 		check_argument_count => 0,
 		named_parameters => 1,
+		types => 1,
 		attrs => ':method',
 		shift => '$self',
 		invocant => 1,
@@ -47,6 +49,7 @@ my %type_map = (
 		default_arguments => 1,
 		check_argument_count => 0,
 		named_parameters => 1,
+		types => 1,
 		attributes => ':method',
 		shift => '$class',
 		invocant => 1,
@@ -116,6 +119,7 @@ sub import {
 		$clean{check_argument_count} = !!delete $type{check_argument_count};
 		$clean{invocant} = !!delete $type{invocant};
 		$clean{named_parameters} = !!delete $type{named_parameters};
+		$clean{types} = !!delete $type{types};
 
 		%type and confess "Invalid keyword property: @{[keys %type]}";
 
@@ -131,9 +135,10 @@ sub import {
 			FLAG_ANON_OK | FLAG_NAME_OK
 		;
 		$flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments};
-		$flags |= FLAG_CHECK_NARGS if $type->{check_argument_count};
+		$flags |= FLAG_CHECK_NARGS | FLAG_CHECK_TARGS if $type->{check_argument_count};
 		$flags |= FLAG_INVOCANT if $type->{invocant};
 		$flags |= FLAG_NAMED_PARAMS if $type->{named_parameters};
+		$flags |= FLAG_TYPES_OK if $type->{types};
 		$^H{HINTK_FLAGS_ . $kw} = $flags;
 		$^H{HINTK_SHIFT_ . $kw} = $type->{shift};
 		$^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
@@ -162,40 +167,58 @@ sub _register_info {
 		$key,
 		$declarator,
 		$invocant,
+		$invocant_type,
 		$positional_required,
 		$positional_optional,
 		$named_required,
 		$named_optional,
 		$slurpy,
+		$slurpy_type,
 	) = @_;
 
-	my $blob = pack '(Z*)*',
-		$declarator,
-		$invocant // '',
-		join(' ', @$positional_required),
-		join(' ', @$positional_optional),
-		join(' ', @$named_required),
-		join(' ', @$named_optional),
-		$slurpy // '',
-	;
-
-	$metadata{$key} = $blob;
+	my $info = {
+		declarator => $declarator,
+		invocant => defined $invocant ? [$invocant, $invocant_type] : undef,
+		slurpy   => defined $slurpy   ? [$slurpy  , $slurpy_type  ] : undef,
+		positional_required => $positional_required,
+		positional_optional => $positional_optional,
+		named_required => $named_required,
+		named_optional => $named_optional,
+	};
+
+	$metadata{$key} = $info;
+}
+
+sub _mkparam1 {
+	my ($pair) = @_;
+	my ($v, $t) = @{$pair || []} or return undef;
+	Function::Parameters::Param->new(
+		name => $v,
+		type => $t,
+	)
+}
+
+sub _mkparams {
+	my @r;
+	while (my ($v, $t) = splice @_, 0, 2) {
+		push @r, Function::Parameters::Param->new(
+			name => $v,
+			type => $t,
+		);
+	}
+	\@r
 }
 
 sub info {
 	my ($func) = @_;
 	my $key = _cv_root $func or return undef;
-	my $blob = $metadata{$key} or return undef;
-	my @info = unpack '(Z*)*', $blob;
+	my $info = $metadata{$key} or return undef;
 	require Function::Parameters::Info;
 	Function::Parameters::Info->new(
-		keyword => $info[0],
-		invocant => $info[1] || undef,
-		_positional_required => [split ' ', $info[2]],
-		_positional_optional => [split ' ', $info[3]],
-		_named_required => [split ' ', $info[4]],
-		_named_optional => [split ' ', $info[5]],
-		slurpy => $info[6] || undef,
+		keyword => $info->{declarator},
+		invocant => _mkparam1($info->{invocant}),
+		slurpy => _mkparam1($info->{slurpy}),
+		(map +("_$_" => _mkparams @{$info->{$_}}), glob '{positional,named}_{required,optional}')
 	)
 }