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