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