X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=3b0794f209b175ae2a41df59b1e09e1975cdf0aa;hb=8c79ea4a9df54fc083be365d107dd81036057864;hp=97dd88e575ab1424b98fd55b075ab1f612841041;hpb=63a24d7c16cf124fab4ac57fd3d44dc26e7ae587;p=p5sagit%2FFunction-Parameters.git diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm index 97dd88e..3b0794f 100644 --- a/lib/Function/Parameters.pm +++ b/lib/Function/Parameters.pm @@ -5,16 +5,14 @@ use v5.14.0; use strict; use warnings; +use Carp qw(confess); + use XSLoader; BEGIN { - our $VERSION = '0.05_02'; + our $VERSION = '0.10_01'; XSLoader::load; } -use B::Hooks::EndOfScope qw(on_scope_end); -use Carp qw(confess); -use bytes (); - sub _assert_valid_identifier { my ($name, $with_dollar) = @_; my $bonus = $with_dollar ? '\$' : ''; @@ -22,19 +20,60 @@ sub _assert_valid_identifier { or confess qq{"$name" doesn't look like a 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}; +} + my @bare_arms = qw(function method); my %type_map = ( - function => { name => 'optional' }, - method => { name => 'optional', shift => '$self' }, + function => { + name => 'optional', + default_arguments => 1, + check_argument_count => 0, + }, + method => { + name => 'optional', + default_arguments => 1, + check_argument_count => 0, + attrs => ':method', + shift => '$self', + invocant => 1, + }, + classmethod => { + name => 'optional', + default_arguments => 1, + check_argument_count => 0, + attributes => ':method', + shift => '$class', + invocant => 1, + }, ); +for my $k (keys %type_map) { + $type_map{$k . '_strict'} = { + %{$type_map{$k}}, + check_argument_count => 1, + }; +} sub import { my $class = shift; - @_ or @_ = ('fun', 'method'); + if (!@_) { + @_ = { + fun => 'function', + method => 'method', + }; + } + if (@_ == 1 && $_[0] eq ':strict') { + @_ = { + fun => 'function_strict', + method => 'method_strict', + }; + } if (@_ == 1 && ref($_[0]) eq 'HASH') { - @_ = map [$_, $_[0]{$_}], keys %{$_[0]} - or return; + @_ = map [$_, $_[0]{$_}], keys %{$_[0]}; } my %spec; @@ -45,35 +84,55 @@ sub import { ? $proto : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})] ; - my ($name, $type) = @$item; + my ($name, $proto_type) = @$item; _assert_valid_identifier $name; - unless (ref $type) { - # use '||' instead of 'or' to preserve $type in the error message - $type = $type_map{$type} - || confess qq["$type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})]; - } - $type->{name} ||= 'optional'; - $type->{name} =~ /^(?:optional|required|prohibited)\z/ - or confess qq["$type->{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)]; - if ($type->{shift}) { - _assert_valid_identifier $type->{shift}, 1; - bytes::length($type->{shift}) < SHIFT_NAME_LIMIT - or confess qq["$type->{shift}" is longer than I can handle]; + 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})]; } + + my %type = %$proto_type; + my %clean; + + $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} || ''; + _assert_valid_identifier $clean{shift}, 1 if $clean{shift}; + + $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs); + _assert_valid_attributes $clean{attrs} if $clean{attrs}; - $spec{$name} = $type; + $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}; + + %type and confess "Invalid keyword property: @{[keys %type]}"; + + $spec{$name} = \%clean; } for my $kw (keys %spec) { my $type = $spec{$kw}; - $^H{HINTK_SHIFT_ . $kw} = $type->{shift} || ''; - $^H{HINTK_NAME_ . $kw} = - $type->{name} eq 'prohibited' ? FLAG_NAME_PROHIBITED : - $type->{name} eq 'required' ? FLAG_NAME_REQUIRED : - FLAG_NAME_OPTIONAL + my $flags = + $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}; + $^H{HINTK_FLAGS_ . $kw} = $flags; + $^H{HINTK_SHIFT_ . $kw} = $type->{shift}; + $^H{HINTK_ATTRS_ . $kw} = $type->{attrs}; $^H{+HINTK_KEYWORDS} .= "$kw "; } } @@ -91,17 +150,13 @@ sub unimport { } } -sub _fini { - on_scope_end { - xs_fini; - }; -} - 'ok' __END__ +=encoding UTF-8 + =head1 NAME Function::Parameters - subroutine definitions with parameter lists @@ -110,11 +165,15 @@ Function::Parameters - subroutine definitions with parameter lists use Function::Parameters; + # simple function fun foo($bar, $baz) { return $bar + $baz; } - fun mymap($fun, @args) :(&@) { + # function with prototype + fun mymap($fun, @args) + :(&@) + { my @res; for (@args) { push @res, $fun->($_); @@ -124,14 +183,47 @@ Function::Parameters - subroutine definitions with parameter lists print "$_\n" for mymap { $_ * 2 } 1 .. 4; + # method with implicit $self method set_name($name) { $self->{name} = $name; } + + # method with explicit invocant + method new($class: %init) { + return bless { %init }, $class; + } + + # function with default arguments + fun search($haystack, $needle = qr/^(?!)/, $offset = 0) { + ... + } + + # method with default arguments + method skip($amount = 1) { + $self->{position} += $amount; + } + +=cut + +=pod + + use Function::Parameters qw(:strict); + + fun greet($x) { + print "Hello, $x\n"; + } + + greet "foo", "bar"; + # Dies at runtime with "Too many arguments for fun greet" + + greet; + # Dies at runtime with "Not enough arguments for fun greet" =cut =pod + # use different keywords use Function::Parameters { proc => 'function', meth => 'method', @@ -147,11 +239,6 @@ Function::Parameters - subroutine definitions with parameter lists This module lets you use parameter lists in your subroutines. Thanks to L it works without source filters. -WARNING: This is my first attempt at writing L and I have -almost no experience with perl's internals. So while this module might -appear to work, it could also conceivably make your programs segfault. -Consider this module alpha quality. - =head2 Basic stuff To use this new functionality, you have to use C instead of C - @@ -162,7 +249,7 @@ list consists of comma-separated variables. The effect of C is as if you'd written C, i.e. the parameter list is simply -copied into C and initialized from L<@_|perlvar/"@_">. +copied into L and initialized from L<@_|perlvar/"@_">. In addition you can use C, which understands the same syntax as C but automatically creates a C<$self> variable for you. So by writing @@ -172,18 +259,30 @@ C. =head2 Customizing the generated keywords You can customize the names of the keywords injected into your scope. To do -that you pass a hash reference in the import list: +that you pass a reference to a hash mapping keywords to types in the import +list: + + use Function::Parameters { + KEYWORD1 => TYPE1, + KEYWORD2 => TYPE2, + ... + }; + +Or more concretely: use Function::Parameters { proc => 'function', meth => 'method' }; # -or- use Function::Parameters { proc => 'function' }; # -or- - use Function::Parameters { meth => 'method' }; + use Function::Parameters { meth => 'method' }; # etc. The first line creates two keywords, C and C (for defining functions and methods, respectively). The last two lines only create one -keyword. Generally the hash keys can be any identifiers you want while the -values have to be either C, C, or a hash reference (see -below). The difference between C and C is that Cs -automatically L their first argument into C<$self>. +keyword. Generally the hash keys (keywords) can be any identifiers you want +while the values (types) have to be either a hash reference (see below) or +C<'function'>, C<'method'>, C<'classmethod'>, C<'function_strict'>, +C<'method_strict'>, or C<'classmethod_strict'>. The main difference between +C<'function'> and C<'method'> is that C<'method'>s automatically +L their first argument into C<$self> (C<'classmethod'>s +are similar but shift into C<$class>). The following shortcuts are available: @@ -195,8 +294,14 @@ The following shortcuts are available: =pod + use Function::Parameters ':strict'; + # is equivalent to # + use Function::Parameters { fun => 'function_strict', method => 'method_strict' }; + +=pod + The following shortcuts are deprecated and may be removed from a future version -of the module: +of this module: # DEPRECATED use Function::Parameters 'foo'; @@ -212,11 +317,11 @@ of the module: # is equivalent to # use Function::Parameters { 'foo' => 'function', 'bar' => 'method' }; -That is, if you want to pass arguments to L, use a -hashref, not a list of strings. +That is, if you want to create custom keywords with L, +use a hashref, not a list of strings. -You can customize things even more by passing a hashref instead of C -or C. This hash can have the following keys: +You can tune the properties of the generated keywords even more by passing +a hashref instead of a string. This hash can have the following keys: =over @@ -233,10 +338,130 @@ Valid values: strings that look like a scalar variable. Any function created by this keyword will automatically L its first argument into a local variable whose name is specified here. +=item C + +Valid values: booleans. This lets users of this keyword specify an explicit +invocant, that is, the first parameter may be followed by a C<:> (colon) +instead of a comma and will by initialized by shifting the first element off +C<@_>. + +You can combine C and C, in which case the variable named in +C serves as a default shift target for functions that don't specify an +explicit invocant. + +=item C, C + +Valid values: strings that are valid source code for attributes. Any value +specified here will be inserted as a subroutine attribute in the generated +code. Thus: + + use Function::Parameters { sub_l => { attributes => ':lvalue' } }; + sub_l foo() { + ... + } + +turns into + + sub foo :lvalue { + ... + } + +It is recommended that you use C in new code but C is also +accepted for now. + +=item C + +Valid values: booleans. This property is on by default, so you have to pass +C<< default_arguments => 0 >> to turn it off. If it is disabled, using C<=> in +a parameter list causes a syntax error. Otherwise it lets you specify +default arguments directly in the parameter list: + + fun foo($x, $y = 42, $z = []) { + ... + } + +turns into + + sub foo { + my ($x, $y, $z) = @_; + $y = 42 if @_ < 2; + $z = [] if @_ < 3; + ... + } + +You can even refer to previous parameters in the same parameter list: + + print fun ($x, $y = $x + 1) { "$x and $y" }->(9); # "9 and 10" + +This also works with the implicit first parameter of methods: + + method scale($factor = $self->default_factor) { + $self->{amount} *= $factor; + } + +=item C + +Valid values: booleans. This property is off by default. If it is enabled, the +generated code will include checks to make sure the number of passed arguments +is correct (and otherwise throw an exception via L): + + fun foo($x, $y = 42, $z = []) { + ... + } + +turns into + + sub foo { + Carp::croak "Not enough arguments for fun foo" if @_ < 1; + Carp::croak "Too many arguments for fun foo" if @_ > 3; + my ($x, $y, $z) = @_; + $y = 42 if @_ < 2; + $z = [] if @_ < 3; + ... + } + =back -Plain C<'function'> is equivalent to C<< { name => 'optional' } >>, and plain -C<'method'> is equivalent to C<< { name => 'optional', shift => '$self' } >>. +Plain C<'function'> is equivalent to: + + { + name => 'optional', + default_arguments => 1, + check_argument_count => 0, + } + +(These are all default values so C<'function'> is also equivalent to C<{}>.) + +C<'function_strict'> is like C<'function'> but with +C<< check_argument_count => 1 >>. + +C<'method'> is equivalent to: + + { + name => 'optional', + default_arguments => 1, + check_argument_count => 0, + attributes => ':method', + shift => '$self', + invocant => 1, + } + +C<'method_strict'> is like C<'method'> but with +C<< check_argument_count => 1 >>. + +C<'classmethod'> is equivalent to: + + { + name => 'optional', + default_arguments => 1, + check_argument_count => 0, + attributes => ':method', + shift => '$class', + invocant => 1, + } + +C<'classmethod_strict'> is like C<'classmethod'> but with +C<< check_argument_count => 1 >>. =head2 Syntax and generated code @@ -246,12 +471,12 @@ of C, parsing it as C<$bar-Efoo([1], $bar[0])>. Yes. You can add parens to change the interpretation of this code, but C will only trigger a I warning. This module attempts -to fix all of this by adding a subroutine declaration before the definition, +to fix all of this by adding a subroutine declaration before the function body, so the parser knows the name (and possibly prototype) while it processes the body. Thus C really turns into -C. +C. -If you need L, you can +If you need L, you can put them after the parameter list with their usual syntax. Syntactically, these new parameter lists live in the spot normally occupied @@ -260,23 +485,35 @@ specifying it as the first attribute (this is syntactically unambiguous because normal attributes have to start with a letter while a prototype starts with C<(>). -As an example, the following declaration uses every feature available -(subroutine name, parameter list, prototype, attributes, and implicit -C<$self>): +As an example, the following declaration uses every available feature +(subroutine name, parameter list, default arguments, prototype, default +attributes, attributes, argument count checks, and implicit C<$self> overriden +by an explicit invocant declaration): - method foo($x, $y, @z) :($;$@) :lvalue :Banana(2 + 2) { + method foo($this: $x, $y, $z = sqrt 5) + :($$$;$) + :lvalue + :Banana(2 + 2) + { ... } And here's what it turns into: - sub foo ($;$@); sub foo ($;$@) :lvalue :Banana(2 + 2) { my $self = shift; my ($x, $y, @z) = @_; + sub foo ($$$;$) :method :lvalue :Banana(2 + 2) { + sub foo ($$$;$); + Carp::croak "Not enough arguments for method foo" if @_ < 3; + Carp::croak "Too many arguments for method foo" if @_ > 4; + my $this = shift; + my ($x, $y, $z) = @_; + $z = sqrt 5 if @_ < 3; ... } Another example: - my $coderef = fun ($p, $q) :(;$$) + my $coderef = fun ($p, $q) + :(;$$) :lvalue :Gazebo((>:O)) { ... @@ -284,7 +521,12 @@ Another example: And the generated code: - my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { my ($p, $q) = @_; + my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { + # vvv only if check_argument_count is enabled vvv + Carp::croak "Not enough arguments for fun (anon)" if @_ < 2; + Carp::croak "Too many arguments for fun (anon)" if @_ > 2; + # ^^^ ^^^ + my ($p, $q) = @_; ... }; @@ -292,13 +534,14 @@ And the generated code: If you want to wrap L, you just have to call its C method. It always applies to the file that is currently being parsed -and its effects are lexical (i.e. it works like L or L): +and its effects are L (i.e. it works like L or +L). package Some::Wrapper; use Function::Parameters (); sub import { Function::Parameters->import; - # or Function::Parameters->import(@other_import_args); + # or Function::Parameters->import(@custom_import_args); } =head1 AUTHOR