X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=a39f93bbbf273190ef46388f4c29f59062e13258;hb=42e595b0d7841bfda100f6af7115ea41cc46b818;hp=4bcec7e94b0809302c309ddf265ebaf1aec2cdf2;hpb=096dbcecd7c2a600af8aa92c236dbc96b59373ca;p=p5sagit%2FFunction-Parameters.git diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm index 4bcec7e..a39f93b 100644 --- a/lib/Function/Parameters.pm +++ b/lib/Function/Parameters.pm @@ -1,14 +1,13 @@ package Function::Parameters; use v5.14.0; - use warnings; use Carp qw(confess); use XSLoader; BEGIN { - our $VERSION = '1.0003'; + our $VERSION = '1.0202'; XSLoader::load; } @@ -21,43 +20,76 @@ sub _assert_valid_identifier { sub _assert_valid_attributes { my ($attrs) = @_; - $attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/ - or confess qq{"$attrs" doesn't look like valid attributes}; + $attrs =~ m{ + ^ \s*+ + : \s*+ + (?&ident) (?! [^\s:(] ) (?¶m)?+ \s*+ + (?: + (?: : \s*+ )? + (?&ident) (?! [^\s:(] ) (?¶m)?+ \s*+ + )*+ + \z + + (?(DEFINE) + (? + [^\W\d] + \w*+ + ) + (? + \( + [^()\\]*+ + (?: + (?: + \\ . + | + (?¶m) + ) + [^()\\]*+ + )*+ + \) + ) + ) + }sx or confess qq{"$attrs" doesn't look like valid attributes}; +} + +sub _reify_type_default { + require Moose::Util::TypeConstraints; + Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0]) +} + +sub _delete_default { + my ($href, $key, $default) = @_; + exists $href->{$key} ? delete $href->{$key} : $default } my @bare_arms = qw(function method); my %type_map = ( - function => { - name => 'optional', - default_arguments => 1, - check_argument_count => 0, - named_parameters => 1, - }, - method => { - name => 'optional', - default_arguments => 1, - check_argument_count => 0, - named_parameters => 1, - attrs => ':method', - shift => '$self', - invocant => 1, + function => {}, # all default settings + function_strict => { + defaults => 'function', + strict => 1, }, - classmethod => { - name => 'optional', - default_arguments => 1, - check_argument_count => 0, - named_parameters => 1, + method => { + defaults => 'function', attributes => ':method', - shift => '$class', - invocant => 1, + shift => '$self', + invocant => 1, + }, + method_strict => { + defaults => 'method', + strict => 1, + }, + classmethod => { + defaults => 'method', + shift => '$class', + }, + classmethod_strict => { + defaults => 'classmethod', + strict => 1, }, ); -for my $k (keys %type_map) { - $type_map{$k . '_strict'} = { - %{$type_map{$k}}, - check_argument_count => 1, - }; -} + +our @type_reifiers = \&_reify_type_default; sub import { my $class = shift; @@ -89,33 +121,54 @@ sub import { my ($name, $proto_type) = @$item; _assert_valid_identifier $name; - unless (ref $proto_type) { - # use '||' instead of 'or' to preserve $proto_type in the error message - $proto_type = $type_map{$proto_type} - || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})]; - } + $proto_type = {defaults => $proto_type} unless ref $proto_type; my %type = %$proto_type; + while (my $defaults = delete $type{defaults}) { + my $base = $type_map{$defaults} + or confess qq["$defaults" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})]; + %type = (%$base, %type); + } + my %clean; - $clean{name} = delete $type{name} || 'optional'; + $clean{name} = delete $type{name} // 'optional'; $clean{name} =~ /^(?:optional|required|prohibited)\z/ or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)]; - $clean{shift} = delete $type{shift} || ''; + $clean{shift} = delete $type{shift} // ''; _assert_valid_identifier $clean{shift}, 1 if $clean{shift}; - $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs); + $clean{attrs} = join ' ', map delete $type{$_} // (), qw(attributes attrs); _assert_valid_attributes $clean{attrs} if $clean{attrs}; - $clean{default_arguments} = - exists $type{default_arguments} - ? !!delete $type{default_arguments} - : 1 - ; - $clean{check_argument_count} = !!delete $type{check_argument_count}; - $clean{invocant} = !!delete $type{invocant}; - $clean{named_parameters} = !!delete $type{named_parameters}; + $clean{default_arguments} = _delete_default \%type, 'default_arguments', 1; + $clean{named_parameters} = _delete_default \%type, 'named_parameters', 1; + $clean{types} = _delete_default \%type, 'types', 1; + + $clean{invocant} = _delete_default \%type, 'invocant', 0; + $clean{runtime} = _delete_default \%type, 'runtime', 0; + $clean{check_argument_count} = _delete_default \%type, 'check_argument_count', 0; + $clean{check_argument_types} = _delete_default \%type, 'check_argument_types', 0; + $clean{check_argument_count} = $clean{check_argument_types} = 1 if delete $type{strict}; + + if (my $rt = delete $type{reify_type}) { + ref $rt eq 'CODE' or confess qq{"$rt" doesn't look like a type reifier}; + + my $index; + for my $i (0 .. $#type_reifiers) { + if ($type_reifiers[$i] == $rt) { + $index = $i; + last; + } + } + unless (defined $index) { + $index = @type_reifiers; + push @type_reifiers, $rt; + } + + $clean{reify_type} = $index; + } %type and confess "Invalid keyword property: @{[keys %type]}"; @@ -126,17 +179,21 @@ sub import { my $type = $spec{$kw}; my $flags = - $type->{name} eq 'prohibited' ? FLAG_ANON_OK : - $type->{name} eq 'required' ? FLAG_NAME_OK : - FLAG_ANON_OK | FLAG_NAME_OK + $type->{name} eq 'prohibited' ? FLAG_ANON_OK : + $type->{name} eq 'required' ? FLAG_NAME_OK : + 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_INVOCANT if $type->{invocant}; + $flags |= FLAG_CHECK_NARGS if $type->{check_argument_count}; + $flags |= FLAG_CHECK_TARGS if $type->{check_argument_types}; + $flags |= FLAG_INVOCANT if $type->{invocant}; $flags |= FLAG_NAMED_PARAMS if $type->{named_parameters}; + $flags |= FLAG_TYPES_OK if $type->{types}; + $flags |= FLAG_RUNTIME if $type->{runtime}; $^H{HINTK_FLAGS_ . $kw} = $flags; $^H{HINTK_SHIFT_ . $kw} = $type->{shift}; $^H{HINTK_ATTRS_ . $kw} = $type->{attrs}; + $^H{HINTK_REIFY_ . $kw} = $type->{reify_type} // 0; $^H{+HINTK_KEYWORDS} .= "$kw "; } } @@ -155,6 +212,68 @@ sub unimport { } +our %metadata; + +sub _register_info { + my ( + $key, + $declarator, + $invocant, + $invocant_type, + $positional_required, + $positional_optional, + $named_required, + $named_optional, + $slurpy, + $slurpy_type, + ) = @_; + + 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 $info = $metadata{$key} or return undef; + require Function::Parameters::Info; + Function::Parameters::Info->new( + keyword => $info->{declarator}, + invocant => _mkparam1($info->{invocant}), + slurpy => _mkparam1($info->{slurpy}), + (map +("_$_" => _mkparams @{$info->{$_}}), glob '{positional,named}_{required,optional}') + ) +} + 'ok' __END__ @@ -272,11 +391,12 @@ This is just a normal block of statements, as with L|perlsub>. No surpris =head3 Name If present, it specifies the name of the function being defined. As with -L|perlsub>, if a name is present, the whole declaration is syntactically -a statement and its effects are performed at compile time (i.e. at runtime you -can call functions whose definitions only occur later in the file). If no name -is present, the declaration is an expression that evaluates to a reference to -the function in question. No surprises here either. +L|perlsub>, if a name is present, by default the whole declaration is +syntactically a statement and its effects are performed at compile time (i.e. +at runtime you can call functions whose definitions only occur later in the +file - but see the C flag below). If no name is present, the +declaration is an expression that evaluates to a reference to the function in +question. =head3 Attributes @@ -390,7 +510,7 @@ exchange the order of the arguments doesn't matter anymore. As with hash initialization, you can specify the same key multiple times and the last occurrence wins: - rectangle(height => 1, width => 2, height => 2, height => 5; + rectangle(height => 1, width => 2, height => 2, height => 5); # same as: rectangle(width => 2, height => 5); You can combine positional and named parameters as long as the positional @@ -481,12 +601,49 @@ a reference to a hash with the following keys: =over +=item C + +Valid values: One of the predefined types C, C, +C, C, C, C. +This will set the defaults for all other keys from the specified type, which is +useful if you only want to override some properties: + + use Function::Parameters { defmethod => { defaults => 'method', shift => '$this' } }; + +This example defines a keyword called C that works like the standard +C keyword, but the implicit object variable is called C<$this> instead +of C<$self>. + +Using the string types directly is equivalent to C with no further +customization: + + use Function::Parameters { + foo => 'function', # like: foo => { defaults => 'function' }, + bar => 'function_strict', # like: bar => { defaults => 'function_strict' }, + baz => 'method_strict', # like: baz => { defaults => 'method_strict' }, + }; + =item C Valid values: C (default), C (all functions defined with this keyword must have a name), and C (functions defined with this keyword must be anonymous). +=item C + +Valid values: booleans. If enabled, this keyword takes effect at runtime, not +compile time: + + use Function::Parameters { fun => { defaults => 'function_strict', runtime => 1 } }; + say defined &foo ? "defined" : "not defined"; # not defined + fun foo() {} + say defined &foo ? "defined" : "not defined"; # defined + +C<&foo> is only defined after C has been reached at runtime. + +B A future version of this module may enable C<< runtime => 1 >> by +default for methods. + =item C Valid values: strings that look like scalar variables. This lets you specify a @@ -521,15 +678,41 @@ automatically check that they have been passed all required arguments and no excess arguments. If this check fails, an exception will by thrown via L|Carp>. +=item C + +Valid values: booleans. If turned on, functions defined with this keyword will +automatically check that the arguments they are passed pass the declared type +constraints (if any). See L below. + +=item C + +Valid values: booleans. This turns on both C and +C. + +=item C + +Valid values: code references. The function specified here will be called to +turn type annotations into constraint objects (see +L below). It will receive two arguments: a string +containing the type description, and the name of the current package. + +The default type reifier is equivalent to: + + sub { + require Moose::Util::TypeConstraints; + Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0]) + } + =back The predefined type C is equivalent to: { - name => 'optional', - invocant => 0, + name => 'optional', default_arguments => 1, - check_argument_count => 0, + strict => 0, + invocant => 0, + runtime => 0, } These are all default values, so C is also equivalent to C<{}>. @@ -537,29 +720,24 @@ These are all default values, so C is also equivalent to C<{}>. C is equivalent to: { - name => 'optional', - shift => '$self', - invocant => 1, - attributes => ':method', - default_arguments => 1, - check_argument_count => 0, + defaults => 'function', + attributes => ':method', + shift => '$self', + invocant => 1, + # runtime => 1, ## possibly in a future version of this module } C is equivalent to: { - name => 'optional', - shift => '$class', - invocant => 1, - attributes => ':method', - default_arguments => 1, - check_argument_count => 0, + defaults => 'method', + shift => '$class', } C, C, and C are like C, C, and -C, respectively, but with C<< check_argument_count => 1 >>. +C, respectively, but with C<< strict => 1 >>. =back @@ -569,6 +747,21 @@ C<< use Function::Parameters { fun => 'function', method => 'method' } >>. C is equivalent to C<< use Function::Parameters { fun => 'function_strict', method => 'method_strict' } >>. +=head2 Introspection + +You can ask a function at runtime what parameters it has. This functionality is +available through the function C (which is not +exported, so you have to call it by its full name). It takes a reference to a +function, and returns either C (if it knows nothing about the function) +or a L object describing the parameter list. + +Note: This feature is implemented using L, so you'll need to have L +installed if you want to call C (alternatively, if +L is already loaded by the time C is first +called, it will use that instead). + +See L for examples. + =head2 Wrapping C If you want to write a wrapper around C, you only have to @@ -582,6 +775,46 @@ affects the file that is currently being compiled. # or Function::Parameters->import(@custom_import_args); } +=head2 Experimental feature: Types + +An experimental feature is now available: You can annotate parameters with +types. That is, before each parameter you can put a type specification +consisting of identifiers (C), unions (C<... | ...>), and parametric types +(C<...[...]>). Example: + + fun foo(Int $n, ArrayRef[Str | CodeRef] $cb) { ... } + +If you do this, the type reification function corresponding to the keyword will +be called to turn the type (a string) into a constraint object. The default +type reifier simply loads L and forwards to +L|Moose::Util::TypeConstraints/find_or_parse_type_constraint>, +which creates L. + +If you are in "lax" mode, nothing further happens and the types are ignored. If +you are in "strict" mode, C generates code to make sure +any values passed in conform to the type (via +L<< C<< $constraint->check($value) >>|Moose::Meta::TypeConstraint/$constraint->check($value) >>). + +In addition, these type constraints are inspectable through the +L object returned by +L|/Introspection>. + +=head2 Experimental experimental feature: Type expressions + +An even more experimental feature is the ability to specify arbitrary +expressions as types. The syntax for this is like the literal types described +above, but with an expression wrapped in parentheses (C<( EXPR )>). Example: + + fun foo(('Int') $n, ($othertype) $x) { ... } + +Every type expression must return either a string (which is resolved as for +literal types), or a L +(providing C and C methods). + +Note that these expressions are evaluated (once) at parse time (similar to +C blocks), so make sure that any variables you use are set and any +functions you call are defined at parse time. + =head2 How it works The module is actually written in L and uses @@ -599,13 +832,56 @@ generated code corresponds to: # ... turns into ... sub bar :method { my $self = shift; my ($x, $y, @z) = @_; sub bar; ... } +=head1 BUGS AND INCOMPATIBILITIES + +A future version of this module may enable C<< runtime => 1 >> by default for +methods. If this would break your code, please send me a note or file a bug on +RT. + +=head1 SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Function::Parameters + +You can also look for information at: + +=over + +=item MetaCPAN + +L + +=item RT, CPAN's request tracker + +L + +=item AnnoCPAN, Annotated CPAN documentation + +L + +=item CPAN Ratings + +L + +=item Search CPAN + +L + +=back + +=head1 SEE ALSO + +L + =head1 AUTHOR Lukas Mai, C<< >> =head1 COPYRIGHT & LICENSE -Copyright 2010, 2011, 2012 Lukas Mai. +Copyright 2010-2013 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