package Function::Parameters;
+use v5.14.0;
+
use strict;
use warnings;
+use Carp qw(confess);
+
use XSLoader;
BEGIN {
- our $VERSION = '0.05_01';
+ our $VERSION = '0.06';
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 ? '\$' : '';
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',
+ },
+ classmethod => {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ attrs => ':method',
+ shift => '$class',
+ },
);
sub import {
my $class = shift;
- @_ or @_ = ('fun', 'method');
+ @_ or @_ = {
+ fun => 'function',
+ method => 'method',
+ };
if (@_ == 1 && ref($_[0]) eq 'HASH') {
@_ = map [$_, $_[0]{$_}], keys %{$_[0]}
or return;
? $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} = delete $type{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};
+
+ %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};
+ $^H{HINTK_FLAGS_ . $kw} = $flags;
+ $^H{HINTK_SHIFT_ . $kw} = $type->{shift};
+ $^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
$^H{+HINTK_KEYWORDS} .= "$kw ";
}
}
}
}
-sub _fini {
- on_scope_end {
- xs_fini;
- };
-}
-
'ok'
__END__
+=encoding UTF-8
+
=head1 NAME
Function::Parameters - subroutine definitions with parameter lists
=pod
- use Function::Parameters 'proc', 'meth';
+ use Function::Parameters {
+ proc => 'function',
+ meth => 'method',
+ };
my $f = proc ($x) { $x * 2 };
meth get_age() {
=head1 DESCRIPTION
This module lets you use parameter lists in your subroutines. Thanks to
-L<perlapi/PL_keyword_plugin> it works without source filters.
+L<PL_keyword_plugin|perlapi/PL_keyword_plugin> it works without source filters.
WARNING: This is my first attempt at writing L<XS code|perlxs> and I have
almost no experience with perl's internals. So while this module might
=head2 Customizing the generated keywords
-You can customize the names of the keywords injected in your package. To do that
-you pass a hash reference in the import list:
+You can customize the names of the keywords injected into your scope. To do
+that you pass a hash reference in the import list:
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<proc> and C<meth> (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<function>, C<method>, or a hash reference (see
-below). The difference between C<function> and C<method> is that C<method>s
-automatically L<shift|perlfunc/shift> their first argument into C<$self>.
+values have to be either C<function>, C<method>, C<classmethod> or a hash
+reference (see below). The difference between C<function> and C<method> is that
+C<method>s automatically L<shift|perlfunc/shift> their first argument into
+C<$self> (C<classmethod>s are similar but shift into C<$class>).
The following shortcuts are available:
=pod
+The following shortcuts are deprecated and may be removed from a future version
+of the module:
+
+ # DEPRECATED
use Function::Parameters 'foo';
# is equivalent to #
use Function::Parameters { 'foo' => 'function' };
=pod
+ # DEPRECATED
use Function::Parameters 'foo', 'bar';
# is equivalent to #
use Function::Parameters { 'foo' => 'function', 'bar' => 'method' };
+That is, if you want to pass arguments to L<Function::Parameters>, use a
+hashref, not a list of strings.
+
You can customize things even more by passing a hashref instead of C<function>
or C<method>. This hash can have the following keys:
Valid values: strings that look like a scalar variable. Any function created by
this keyword will automatically L<shift|perlfunc/shift> its first argument into
-a local variable with the name specified here.
+a local variable whose name is specified here.
+
+=item C<attrs>
+
+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 => { attrs => ':lvalue' } };
+ sub_l foo() {
+ ...
+ }
+
+turns into
+
+ sub foo :lvalue {
+ ...
+ }
=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 C<< { name => 'optional' } >>, plain
+C<'method'> is equivalent to
+C<< { name => 'optional', shift => '$self', attrs => ':method' } >>, and plain
+C<'classmethod'> is equivalent to
+C<< { name => 'optional', shift => '$class', attrs => ':method' } >>.
-=head2 Other advanced stuff
+=head2 Syntax and generated code
Normally, Perl subroutines are not in scope in their own body, meaning the
-parser doesn't know the name C<foo> or its prototype while processing
-C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
+parser doesn't know the name C<foo> or its prototype while processing the body
+of C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
a I<foo() called too early to check prototype> warning. This module attempts
Syntactically, these new parameter lists live in the spot normally occupied
by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by
specifying it as the first attribute (this is syntactically unambiguous
-because normal attributes have to start with a letter).
+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>):
+
+ method foo($x, $y, @z) :($;$@) :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) = @_;
+ ...
+ }
+
+Another example:
+
+ my $coderef = fun ($p, $q) :(;$$)
+ :lvalue
+ :Gazebo((>:O)) {
+ ...
+ };
+
+And the generated code:
+
+ my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { my ($p, $q) = @_;
+ ...
+ };
+
+=head2 Wrapping Function::Parameters
If you want to wrap L<Function::Parameters>, you just have to call its
C<import> method. It always applies to the file that is currently being parsed
-and its effects are lexical (i.e. it works like L<warnings> or L<strict>);
-
- package Some::Wrapper;
- use Function::Parameters ();
- sub import {
- Function::Parameters->import;
- # or Function::Parameters->import(@other_import_args);
- }
+and its effects are lexical (i.e. it works like L<warnings> or L<strict>):
+
+ package Some::Wrapper;
+ use Function::Parameters ();
+ sub import {
+ Function::Parameters->import;
+ # or Function::Parameters->import(@other_import_args);
+ }
=head1 AUTHOR
projects / p5sagit/Function-Parameters.git / blobdiff