lib/Function/Parameters.pm

   1 package Function::Parameters;
   2
   3 use v5.14.0;
   4
   5 use strict;
   6 use warnings;
   7
   8 use XSLoader;
   9 BEGIN {
  10         our $VERSION = '0.05_02';
  11         XSLoader::load;
  12 }
  13
  14 use B::Hooks::EndOfScope qw(on_scope_end);
  15 use Carp qw(confess);
  16 use bytes ();
  17
  18 sub _assert_valid_identifier {
  19         my ($name, $with_dollar) = @_;
  20         my $bonus = $with_dollar ? '\$' : '';
  21         $name =~ /^${bonus}[^\W\d]\w*\z/
  22                 or confess qq{"$name" doesn't look like a valid identifier};
  23 }
  24
  25 my @bare_arms = qw(function method);
  26 my %type_map = (
  27         function => { name => 'optional' },
  28         method   => { name => 'optional', shift => '$self' },
  29 );
  30
  31 sub import {
  32         my $class = shift;
  33
  34         @_ or @_ = ('fun', 'method');
  35         if (@_ == 1 && ref($_[0]) eq 'HASH') {
  36                 @_ = map [$_, $_[0]{$_}], keys %{$_[0]}
  37                         or return;
  38         }
  39
  40         my %spec;
  41
  42         my $bare = 0;
  43         for my $proto (@_) {
  44                 my $item = ref $proto
  45                         ? $proto
  46                         : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})]
  47                 ;
  48                 my ($name, $proto_type) = @$item;
  49                 _assert_valid_identifier $name;
  50
  51                 unless (ref $proto_type) {
  52                         # use '||' instead of 'or' to preserve $proto_type in the error message
  53                         $proto_type = $type_map{$proto_type}
  54                                 || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
  55                 }
  56                 my %type = %$proto_type;
  57                 my %clean;
  58                 $clean{name} = delete $type{name} || 'optional';
  59                 $clean{name} =~ /^(?:optional|required|prohibited)\z/
  60                         or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
  61                 $clean{shift} = delete $type{shift} || '';
  62                 if ($clean{shift}) {
  63                         _assert_valid_identifier $clean{shift}, 1;
  64                         bytes::length($clean{shift}) < SHIFT_NAME_LIMIT
  65                                 or confess qq["$clean{shift}" is longer than I can handle];
  66                 }
  67
  68                 %type and confess "Invalid keyword property: @{[keys %type]}";
  69
  70                 $spec{$name} = \%clean;
  71         }
  72
  73         for my $kw (keys %spec) {
  74                 my $type = $spec{$kw};
  75
  76                 $^H{HINTK_SHIFT_ . $kw} = $type->{shift};
  77                 $^H{HINTK_NAME_ . $kw} =
  78                         $type->{name} eq 'prohibited' ? FLAG_NAME_PROHIBITED :
  79                         $type->{name} eq 'required' ? FLAG_NAME_REQUIRED :
  80                         FLAG_NAME_OPTIONAL
  81                 ;
  82                 $^H{+HINTK_KEYWORDS} .= "$kw ";
  83         }
  84 }
  85
  86 sub unimport {
  87         my $class = shift;
  88
  89         if (!@_) {
  90                 delete $^H{+HINTK_KEYWORDS};
  91                 return;
  92         }
  93
  94         for my $kw (@_) {
  95                 $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g;
  96         }
  97 }
  98
  99 sub _fini {
 100         on_scope_end {
 101                 xs_fini;
 102         };
 103 }
 104
 105
 106 'ok'
 107
 108 __END__
 109
 110 =head1 NAME
 111
 112 Function::Parameters - subroutine definitions with parameter lists
 113
 114 =head1 SYNOPSIS
 115
 116  use Function::Parameters;
 117
 118  fun foo($bar, $baz) {
 119    return $bar + $baz;
 120  }
 121
 122  fun mymap($fun, @args) :(&@) {
 123    my @res;
 124    for (@args) {
 125      push @res, $fun->($_);
 126    }
 127    @res
 128  }
 129
 130  print "$_\n" for mymap { $_ * 2 } 1 .. 4;
 131
 132  method set_name($name) {
 133    $self->{name} = $name;
 134  }
 135
 136 =cut
 137
 138 =pod
 139
 140  use Function::Parameters {
 141    proc => 'function',
 142    meth => 'method',
 143  };
 144
 145  my $f = proc ($x) { $x * 2 };
 146  meth get_age() {
 147    return $self->{age};
 148  }
 149
 150 =head1 DESCRIPTION
 151
 152 This module lets you use parameter lists in your subroutines. Thanks to
 153 L<PL_keyword_plugin|perlapi/PL_keyword_plugin> it works without source filters.
 154
 155 WARNING: This is my first attempt at writing L<XS code|perlxs> and I have
 156 almost no experience with perl's internals. So while this module might
 157 appear to work, it could also conceivably make your programs segfault.
 158 Consider this module alpha quality.
 159
 160 =head2 Basic stuff
 161
 162 To use this new functionality, you have to use C<fun> instead of C<sub> -
 163 C<sub> continues to work as before. The syntax is almost the same as for
 164 C<sub>, but after the subroutine name (or directly after C<fun> if you're
 165 writing an anonymous sub) you can write a parameter list in parentheses. This
 166 list consists of comma-separated variables.
 167
 168 The effect of C<fun foo($bar, $baz) {> is as if you'd written
 169 C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply
 170 copied into C<my> and initialized from L<@_|perlvar/"@_">.
 171
 172 In addition you can use C<method>, which understands the same syntax as C<fun>
 173 but automatically creates a C<$self> variable for you. So by writing
 174 C<method foo($bar, $baz) {> you get the same effect as
 175 C<sub foo { my $self = shift; my ($bar, $baz) = @_; >.
 176
 177 =head2 Customizing the generated keywords
 178
 179 You can customize the names of the keywords injected into your scope. To do
 180 that you pass a hash reference in the import list:
 181
 182  use Function::Parameters { proc => 'function', meth => 'method' }; # -or-
 183  use Function::Parameters { proc => 'function' }; # -or-
 184  use Function::Parameters { meth => 'method' };
 185
 186 The first line creates two keywords, C<proc> and C<meth> (for defining
 187 functions and methods, respectively). The last two lines only create one
 188 keyword. Generally the hash keys can be any identifiers you want while the
 189 values have to be either C<function>, C<method>, or a hash reference (see
 190 below). The difference between C<function> and C<method> is that C<method>s
 191 automatically L<shift|perlfunc/shift> their first argument into C<$self>.
 192
 193 The following shortcuts are available:
 194
 195  use Function::Parameters;
 196     # is equivalent to #
 197  use Function::Parameters { fun => 'function', method => 'method' };
 198
 199 =cut
 200
 201 =pod
 202
 203 The following shortcuts are deprecated and may be removed from a future version
 204 of the module:
 205
 206  # DEPRECATED
 207  use Function::Parameters 'foo';
 208    # is equivalent to #
 209  use Function::Parameters { 'foo' => 'function' };
 210
 211 =cut
 212
 213 =pod
 214
 215  # DEPRECATED
 216  use Function::Parameters 'foo', 'bar';
 217    # is equivalent to #
 218  use Function::Parameters { 'foo' => 'function', 'bar' => 'method' };
 219
 220 That is, if you want to pass arguments to L<Function::Parameters>, use a
 221 hashref, not a list of strings.
 222
 223 You can customize things even more by passing a hashref instead of C<function>
 224 or C<method>. This hash can have the following keys:
 225
 226 =over
 227
 228 =item C<name>
 229
 230 Valid values: C<optional> (default), C<required> (all uses of this keyword must
 231 specify a function name), and C<prohibited> (all uses of this keyword must not
 232 specify a function name). This means a C<< name => 'prohibited' >> keyword can
 233 only be used for defining anonymous functions.
 234
 235 =item C<shift>
 236
 237 Valid values: strings that look like a scalar variable. Any function created by
 238 this keyword will automatically L<shift|perlfunc/shift> its first argument into
 239 a local variable whose name is specified here.
 240
 241 =back
 242
 243 Plain C<'function'> is equivalent to C<< { name => 'optional' } >>, and plain
 244 C<'method'> is equivalent to C<< { name => 'optional', shift => '$self' } >>.
 245
 246 =head2 Syntax and generated code
 247
 248 Normally, Perl subroutines are not in scope in their own body, meaning the
 249 parser doesn't know the name C<foo> or its prototype while processing the body
 250 of C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
 251 C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
 252 interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
 253 a I<foo() called too early to check prototype> warning. This module attempts
 254 to fix all of this by adding a subroutine declaration before the definition,
 255 so the parser knows the name (and possibly prototype) while it processes the
 256 body. Thus C<fun foo($x) :($) { $x }> really turns into
 257 C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
 258
 259 If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can
 260 put them after the parameter list with their usual syntax.
 261
 262 Syntactically, these new parameter lists live in the spot normally occupied
 263 by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by
 264 specifying it as the first attribute (this is syntactically unambiguous
 265 because normal attributes have to start with a letter while a prototype starts
 266 with C<(>).
 267
 268 As an example, the following declaration uses every feature available
 269 (subroutine name, parameter list, prototype, attributes, and implicit
 270 C<$self>):
 271
 272  method foo($x, $y, @z) :($;$@) :lvalue :Banana(2 + 2) {
 273    ...
 274  }
 275
 276 And here's what it turns into:
 277
 278  sub foo ($;$@); sub foo ($;$@) :lvalue :Banana(2 + 2) { my $self = shift; my ($x, $y, @z) = @_;
 279    ...
 280  }
 281
 282 Another example:
 283
 284  my $coderef = fun ($p, $q) :(;$$)
 285    :lvalue
 286    :Gazebo((>:O)) {
 287    ...
 288  };
 289
 290 And the generated code:
 291
 292  my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { my ($p, $q) = @_;
 293    ...
 294  };
 295
 296 =head2 Wrapping Function::Parameters
 297
 298 If you want to wrap L<Function::Parameters>, you just have to call its
 299 C<import> method. It always applies to the file that is currently being parsed
 300 and its effects are lexical (i.e. it works like L<warnings> or L<strict>):
 301
 302  package Some::Wrapper;
 303  use Function::Parameters ();
 304  sub import {
 305    Function::Parameters->import;
 306    # or Function::Parameters->import(@other_import_args);
 307  }
 308
 309 =head1 AUTHOR
 310
 311 Lukas Mai, C<< <l.mai at web.de> >>
 312
 313 =head1 COPYRIGHT & LICENSE
 314
 315 Copyright 2010, 2011, 2012 Lukas Mai.
 316
 317 This program is free software; you can redistribute it and/or modify it
 318 under the terms of either: the GNU General Public License as published
 319 by the Free Software Foundation; or the Artistic License.
 320
 321 See http://dev.perl.org/licenses/ for more information.
 322
 323 =cut