add *_strict variants of all symbolic types
[p5sagit/Function-Parameters.git] / lib / Function / Parameters.pm
index 0f4a82d..1eeae05 100644 (file)
@@ -5,14 +5,14 @@ use v5.14.0;
 use strict;
 use warnings;
 
+use Carp qw(confess);
+
 use XSLoader;
 BEGIN {
-       our $VERSION = '0.05_03';
+       our $VERSION = '0.06';
        XSLoader::load;
 }
 
-use Carp qw(confess);
-
 sub _assert_valid_identifier {
        my ($name, $with_dollar) = @_;
        my $bonus = $with_dollar ? '\$' : '';
@@ -28,13 +28,32 @@ sub _assert_valid_attributes {
 
 my @bare_arms = qw(function method);
 my %type_map = (
-       function => { name => 'optional' },
+       function => {
+               name => 'optional',
+               default_arguments => 1,
+               check_argument_count => 0,
+       },
        method   => {
                name => 'optional',
-               shift => '$self',
+               default_arguments => 1,
+               check_argument_count => 0,
                attrs => ':method',
+               shift => '$self',
+       },
+       classmethod   => {
+               name => 'optional',
+               default_arguments => 1,
+               check_argument_count => 0,
+               attributes => ':method',
+               shift => '$class',
        },
 );
+for my $k (keys %type_map) {
+       $type_map{$k . '_strict'} = {
+               %{$type_map{$k}},
+               check_argument_count => 1,
+       };
+}
 
 sub import {
        my $class = shift;
@@ -56,34 +75,53 @@ 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})];
+               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})];
                }
-               $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)];
 
-               $type->{shift} and _assert_valid_identifier $type->{shift}, 1;
-               $type->{attrs} and _assert_valid_attributes $type->{attrs};
+               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};
+
+               %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_ATTRS_ . $kw} = $type->{attrs} || '';
-               $^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 ";
        }
 }
@@ -106,6 +144,8 @@ sub unimport {
 
 __END__
 
+=encoding UTF-8
+
 =head1 NAME
 
 Function::Parameters - subroutine definitions with parameter lists
@@ -114,10 +154,12 @@ Function::Parameters - subroutine definitions with parameter lists
 
  use Function::Parameters;
  
+ # simple function
  fun foo($bar, $baz) {
    return $bar + $baz;
  }
  
+ # function with prototype
  fun mymap($fun, @args) :(&@) {
    my @res;
    for (@args) {
@@ -128,14 +170,26 @@ 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;
  }
 
+ # 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 different keywords
  use Function::Parameters {
    proc => 'function',
    meth => 'method',
@@ -166,7 +220,7 @@ list consists of comma-separated variables.
 
 The effect of C<fun foo($bar, $baz) {> is as if you'd written
 C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply
-copied into C<my> and initialized from L<@_|perlvar/"@_">.
+copied into L<my|perlfunc/my-EXPR> and initialized from L<@_|perlvar/"@_">.
 
 In addition you can use C<method>, which understands the same syntax as C<fun>
 but automatically creates a C<$self> variable for you. So by writing
@@ -176,18 +230,30 @@ C<sub foo { my $self = shift; my ($bar, $baz) = @_; >.
 =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<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>.
+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<shift|perlfunc/shift> their first argument into C<$self> (C<'classmethod'>s
+are similar but shift into C<$class>).
 
 The following shortcuts are available:
 
@@ -200,7 +266,7 @@ The following shortcuts are available:
 =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';
@@ -219,8 +285,8 @@ of the module:
 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:
+You can customize the properties of the generated keywords even more by passing
+a hashref instead of a string. This hash can have the following keys:
 
 =over
 
@@ -237,13 +303,13 @@ 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 whose name is specified here.
 
-=item C<attrs>
+=item C<attributes>, 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' } };
+ use Function::Parameters { sub_l => { attributes => ':lvalue' } };
  sub_l foo() {
    ...
  }
@@ -254,11 +320,103 @@ turns into
    ...
  }
 
+It is recommended that you use C<attributes> in new code but C<attrs> is also
+accepted for now.
+
+=item C<default_arguments>
+
+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;
+   ...
+ }
+
+except that none of the parameters are in scope in the expressions that specify
+default values. Thus:
+
+  my $var = "outer";
+
+  fun foo($var, $wat = $var) {
+    # $wat will default to "outer", not to what was passed
+    # as the first argument!
+    ...
+  }
+
+This may change in a future version of this module.
+
+=item C<check_argument_count>
+
+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<Carp::croak|Carp>):
+
+  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', attrs => ':method' } >>.
+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',
+ }
+
+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',
+ }
+
+C<'classmethod_strict'> is like C<'classmethod'> but with
+C<< check_argument_count => 1 >>.
 
 =head2 Syntax and generated code
 
@@ -268,12 +426,12 @@ 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
-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<fun foo($x) :($) { $x }> really turns into
-C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
+C<sub foo ($) { sub foo ($); my ($x) = @_; $x }>.
 
-If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can
+If you need L<subroutine attributes|perlsub/Subroutine-Attributes>, you can
 put them after the parameter list with their usual syntax.
 
 Syntactically, these new parameter lists live in the spot normally occupied
@@ -282,17 +440,23 @@ 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>):
 
- method foo($x, $y, @z) :($;$@) :lvalue :Banana(2 + 2) {
+ method foo($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 @_ < 2;
+   Carp::croak "Too many arguments for method foo" if @_ > 4;
+   my $self = shift;
+   my ($x, $y, $z) = @_;
+   $z = sqrt 5 if @_ < 3;
    ...
  }
 
@@ -306,7 +470,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) = @_;
    ...
  };
 
@@ -314,13 +483,14 @@ And the generated code:
 
 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>):
+and its effects are L<lexical|perlpragma> (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);
+   # or Function::Parameters->import(@custom_import_args);
  }
 
 =head1 AUTHOR