X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=018faf91103354bb4cbb8cc1223d76f12449990c;hb=f7651a6e5b18523fd6e00f809a8c40dd0127251a;hp=72d93d933ab4219283f65cfa16bef7cfe232644a;hpb=bd040be664b763fb8e5a01c5365e5e5c0bed2e00;p=p5sagit%2FFunction-Parameters.git diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm index 72d93d9..018faf9 100644 --- a/lib/Function/Parameters.pm +++ b/lib/Function/Parameters.pm @@ -1,16 +1,13 @@ package Function::Parameters; use v5.14.0; - use warnings; use Carp qw(confess); use XSLoader; BEGIN { - our $VERSION = '1.00_02'; - our $XS_VERSION = $VERSION; - $VERSION = eval $VERSION; + our $VERSION = '1.0202'; XSLoader::load; } @@ -23,46 +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, - types => 1, + function => {}, # all default settings + function_strict => { + defaults => 'function', + strict => 1, }, - method => { - name => 'optional', - default_arguments => 1, - check_argument_count => 0, - named_parameters => 1, - types => 1, - attrs => ':method', - shift => '$self', - invocant => 1, - }, - classmethod => { - name => 'optional', - default_arguments => 1, - check_argument_count => 0, - named_parameters => 1, - types => 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; @@ -94,34 +121,53 @@ 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{types} = !!delete $type{types}; + $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{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]}"; @@ -132,18 +178,20 @@ 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 | FLAG_CHECK_TARGS 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_TYPES_OK if $type->{types}; $^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 "; } } @@ -459,7 +507,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 @@ -550,6 +598,28 @@ 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 @@ -590,15 +660,40 @@ 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, } These are all default values, so C is also equivalent to C<{}>. @@ -606,29 +701,23 @@ 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, } 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 @@ -647,7 +736,9 @@ 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. +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. @@ -667,15 +758,17 @@ affects the file that is currently being compiled. =head2 Experimental feature: Types An experimental feature is now available: You can annotate parameters with -L. That is, before each parameter you can put -a type specification consisting of identifiers (C), unions (C<... | ...>), -and parametric types (C<...[...]>). Example: +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[String | CodeRef] $cb) { ... } + fun foo(Int $n, ArrayRef[Str | CodeRef] $cb) { ... } -If you do this, L will be loaded automatically (if that hasn't happened -yet). These specifications are parsed and validated using -L|Moose::Util::TypeConstraints/find_or_parse_type_constraint>. +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 @@ -762,7 +855,7 @@ 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