lib/Function/Parameters.pm

   1 package Function::Parameters;
   2
   3 use v5.14.0;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Carp qw(confess);
   9
  10 use XSLoader;
  11 BEGIN {
  12         our $VERSION = '0.10_03';
  13         XSLoader::load;
  14 }
  15
  16 sub _assert_valid_identifier {
  17         my ($name, $with_dollar) = @_;
  18         my $bonus = $with_dollar ? '\$' : '';
  19         $name =~ /^${bonus}[^\W\d]\w*\z/
  20                 or confess qq{"$name" doesn't look like a valid identifier};
  21 }
  22
  23 sub _assert_valid_attributes {
  24         my ($attrs) = @_;
  25         $attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/
  26                 or confess qq{"$attrs" doesn't look like valid attributes};
  27 }
  28
  29 my @bare_arms = qw(function method);
  30 my %type_map = (
  31         function => {
  32                 name => 'optional',
  33                 default_arguments => 1,
  34                 check_argument_count => 0,
  35                 named_parameters => 1,
  36         },
  37         method   => {
  38                 name => 'optional',
  39                 default_arguments => 1,
  40                 check_argument_count => 0,
  41                 named_parameters => 1,
  42                 attrs => ':method',
  43                 shift => '$self',
  44                 invocant => 1,
  45         },
  46         classmethod   => {
  47                 name => 'optional',
  48                 default_arguments => 1,
  49                 check_argument_count => 0,
  50                 named_parameters => 1,
  51                 attributes => ':method',
  52                 shift => '$class',
  53                 invocant => 1,
  54         },
  55 );
  56 for my $k (keys %type_map) {
  57         $type_map{$k . '_strict'} = {
  58                 %{$type_map{$k}},
  59                 check_argument_count => 1,
  60         };
  61 }
  62
  63 sub import {
  64         my $class = shift;
  65
  66         if (!@_) {
  67                 @_ = {
  68                         fun => 'function',
  69                         method => 'method',
  70                 };
  71         }
  72         if (@_ == 1 && $_[0] eq ':strict') {
  73                 @_ = {
  74                         fun => 'function_strict',
  75                         method => 'method_strict',
  76                 };
  77         }
  78         if (@_ == 1 && ref($_[0]) eq 'HASH') {
  79                 @_ = map [$_, $_[0]{$_}], keys %{$_[0]};
  80         }
  81
  82         my %spec;
  83
  84         my $bare = 0;
  85         for my $proto (@_) {
  86                 my $item = ref $proto
  87                         ? $proto
  88                         : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})]
  89                 ;
  90                 my ($name, $proto_type) = @$item;
  91                 _assert_valid_identifier $name;
  92
  93                 unless (ref $proto_type) {
  94                         # use '||' instead of 'or' to preserve $proto_type in the error message
  95                         $proto_type = $type_map{$proto_type}
  96                                 || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
  97                 }
  98
  99                 my %type = %$proto_type;
 100                 my %clean;
 101
 102                 $clean{name} = delete $type{name} || 'optional';
 103                 $clean{name} =~ /^(?:optional|required|prohibited)\z/
 104                         or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
 105
 106                 $clean{shift} = delete $type{shift} || '';
 107                 _assert_valid_identifier $clean{shift}, 1 if $clean{shift};
 108
 109                 $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs);
 110                 _assert_valid_attributes $clean{attrs} if $clean{attrs};
 111
 112                 $clean{default_arguments} =
 113                         exists $type{default_arguments}
 114                         ? !!delete $type{default_arguments}
 115                         : 1
 116                 ;
 117                 $clean{check_argument_count} = !!delete $type{check_argument_count};
 118                 $clean{invocant} = !!delete $type{invocant};
 119                 $clean{named_parameters} = !!delete $type{named_parameters};
 120
 121                 %type and confess "Invalid keyword property: @{[keys %type]}";
 122
 123                 $spec{$name} = \%clean;
 124         }
 125
 126         for my $kw (keys %spec) {
 127                 my $type = $spec{$kw};
 128
 129                 my $flags =
 130                         $type->{name} eq 'prohibited' ? FLAG_ANON_OK :
 131                         $type->{name} eq 'required' ? FLAG_NAME_OK :
 132                         FLAG_ANON_OK | FLAG_NAME_OK
 133                 ;
 134                 $flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments};
 135                 $flags |= FLAG_CHECK_NARGS if $type->{check_argument_count};
 136                 $flags |= FLAG_INVOCANT if $type->{invocant};
 137                 $flags |= FLAG_NAMED_PARAMS if $type->{named_parameters};
 138                 $^H{HINTK_FLAGS_ . $kw} = $flags;
 139                 $^H{HINTK_SHIFT_ . $kw} = $type->{shift};
 140                 $^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
 141                 $^H{+HINTK_KEYWORDS} .= "$kw ";
 142         }
 143 }
 144
 145 sub unimport {
 146         my $class = shift;
 147
 148         if (!@_) {
 149                 delete $^H{+HINTK_KEYWORDS};
 150                 return;
 151         }
 152
 153         for my $kw (@_) {
 154                 $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g;
 155         }
 156 }
 157
 158
 159 'ok'
 160
 161 __END__
 162
 163 =encoding UTF-8
 164
 165 =head1 NAME
 166
 167 Function::Parameters - subroutine definitions with parameter lists
 168
 169 =head1 SYNOPSIS
 170
 171  use Function::Parameters qw(:strict);
 172
 173  # simple function
 174  fun foo($bar, $baz) {
 175    return $bar + $baz;
 176  }
 177
 178  # function with prototype
 179  fun mymap($fun, @args)
 180    :(&@)
 181  {
 182    my @res;
 183    for (@args) {
 184      push @res, $fun->($_);
 185    }
 186    @res
 187  }
 188
 189  print "$_\n" for mymap { $_ * 2 } 1 .. 4;
 190
 191  # method with implicit $self
 192  method set_name($name) {
 193    $self->{name} = $name;
 194  }
 195
 196  # method with explicit invocant
 197  method new($class: %init) {
 198    return bless { %init }, $class;
 199  }
 200
 201  # function with optional parameters
 202  fun search($haystack, $needle = qr/^(?!)/, $offset = 0) {
 203    ...
 204  }
 205
 206  # method with named parameters
 207  method resize(:$width, :$height) {
 208    $self->{width}  = $width;
 209    $self->{height} = $height;
 210  }
 211
 212  $obj->resize(height => 4, width => 5);
 213
 214  # function with named optional parameters
 215  fun search($haystack, :$needle = qr/^(?!)/, :$offset = 0) {
 216    ...
 217  }
 218
 219  my $results = search $text, offset => 200;
 220
 221 =head1 DESCRIPTION
 222
 223 This module extends Perl with keywords that let you define functions with
 224 parameter lists. It uses Perl's L<keyword plugin|perlapi/PL_keyword_plugin>
 225 API, so it works reliably and doesn't require a source filter.
 226
 227 =head2 Basics
 228
 229 The anatomy of a function (as recognized by this module):
 230
 231 =over
 232
 233 =item 1.
 234
 235 The keyword introducing the function.
 236
 237 =item 2.
 238
 239 The function name (optional).
 240
 241 =item 3.
 242
 243 The parameter list (optional).
 244
 245 =item 4.
 246
 247 The prototype (optional).
 248
 249 =item 5.
 250
 251 The attribute list (optional).
 252
 253 =item 6.
 254
 255 The function body.
 256
 257 =back
 258
 259 Example:
 260
 261   # (1)   (2) (3)      (4)   (5)     (6)
 262     fun   foo ($x, $y) :($$) :lvalue { ... }
 263
 264   #         (1) (6)
 265     my $f = fun { ... };
 266
 267 In the following section I'm going to describe all parts in order from simplest to most complex.
 268
 269 =head3 Body
 270
 271 This is just a normal block of statements, as with L<C<sub>|perlsub>. No surprises here.
 272
 273 =head3 Name
 274
 275 If present, it specifies the name of the function being defined. As with
 276 L<C<sub>|perlsub>, if a name is present, the whole declaration is syntactically
 277 a statement and its effects are performed at compile time (i.e. at runtime you
 278 can call functions whose definitions only occur later in the file). If no name
 279 is present, the declaration is an expression that evaluates to a reference to
 280 the function in question. No surprises here either.
 281
 282 =head3 Attributes
 283
 284 Attributes are relatively unusual in Perl code, but if you want them, they work
 285 exactly the same as with L<C<sub>|perlsub/Subroutine-Attributes>.
 286
 287 =head3 Prototype
 288
 289 As with L<C<sub>|perlsub/Prototypes>, a prototype, if present, contains hints as to how
 290 the compiler should parse calls to this function. This means prototypes have no
 291 effect if the function call is compiled before the function declaration has
 292 been seen by the compiler or if the function to call is only determined at
 293 runtime (e.g. because it's called as a method or through a reference).
 294
 295 With L<C<sub>|perlsub>, a prototype comes directly after the function name (if
 296 any). C<Function::Parameters> reserves this spot for the
 297 L<parameter list|/"Parameter list">. To specify a prototype, put it as the
 298 first attribute (e.g. C<fun foo :(&$$)>). This is syntactically unambiguous
 299 because normal L<attributes|/Attributes> need a name after the colon.
 300
 301 =head3 Parameter list
 302
 303 The parameter list is a list of variables enclosed in parentheses, except it's
 304 actually a bit more complicated than that. A parameter list can include the
 305 following 6 parts, all of which are optional:
 306
 307 =over
 308
 309 =item 1. Invocant
 310
 311 This is a scalar variable followed by a colon (C<:>) and no comma. If an
 312 invocant is present in the parameter list, the first element of
 313 L<C<@_>|perlvar/@ARG> is automatically L<C<shift>ed|perlfunc/shift> off and
 314 placed in this variable. This is intended for methods:
 315
 316   method new($class: %init) {
 317     return bless { %init }, $class;
 318   }
 319
 320   method throw($self:) {
 321     die $self;
 322   }
 323
 324 =item 2. Required positional parameters
 325
 326 The most common kind of parameter. This is simply a comma-separated list of
 327 scalars, which are filled from left to right with the arguments that the caller
 328 passed in:
 329
 330   fun add($x, $y) {
 331     return $x + $y;
 332   }
 333
 334   say add(2, 3);  # "5"
 335
 336 =item 3. Optional positional parameters
 337
 338 Parameters can be marked as optional by putting an equals sign (C<=>) and an
 339 expression (the "default argument") after them. If no corresponding argument is
 340 passed in by the caller, the default argument will be used to initialize the
 341 parameter:
 342
 343   fun scale($base, $factor = 2) {
 344     return $base * $factor;
 345   }
 346
 347   say scale(3, 5);  # "15"
 348   say scale(3);     # "6"
 349
 350 The default argument is I<not> cached. Every time a function is called with
 351 some optional arguments missing, the corresponding default arguments are
 352 evaluated from left to right. This makes no difference for a value like C<2>
 353 but it is important for expressions with side effects, such as reference
 354 constructors (C<[]>, C<{}>) or function calls.
 355
 356 Default arguments see not only the surrounding lexical scope of their function
 357 but also any preceding parameters. This allows the creation of dynamic defaults
 358 based on previous arguments:
 359
 360   method set_name($self: $nick = $self->default_nick, $real_name = $nick) {
 361     $self->{nick} = $nick;
 362     $self->{real_name} = $real_name;
 363   }
 364
 365   $obj->set_name("simplicio");  # same as: $obj->set_name("simplicio", "simplicio");
 366
 367 Because default arguments are actually evaluated as part of the function body,
 368 you can also do silly things like this:
 369
 370   fun foo($n = return "nope") {
 371     "you gave me $n"
 372   }
 373
 374   say foo(2 + 2);  # "you gave me 4"
 375   say foo();       # "nope"
 376
 377 =item 4. Required named parameters
 378
 379 By putting a colon (C<:>) in front of a parameter you can make it named
 380 instead of positional:
 381
 382   fun rectangle(:$width, :$height) {
 383     ...
 384   }
 385
 386   rectangle(width => 2, height => 5);
 387   rectangle(height => 5, width => 2);  # same thing!
 388
 389 That is, the caller must specify a key name in addition to the value, but in
 390 exchange the order of the arguments doesn't matter anymore. As with hash
 391 initialization, you can specify the same key multiple times and the last
 392 occurrence wins:
 393
 394   rectangle(height => 1, width => 2, height => 2, height => 5;
 395   # same as: rectangle(width => 2, height => 5);
 396
 397 You can combine positional and named parameters as long as the positional
 398 parameters come first:
 399
 400   fun named_rectangle($name, :$width, :$height) {
 401     ...
 402   }
 403
 404   named_rectangle("Avocado", width => 0.5, height => 1.2);
 405
 406 =item 5. Optional named parameters
 407
 408 As with positional parameters, you can make named parameters optional by
 409 specifying a default argument after an equals sign (C<=>):
 410
 411   fun rectangle(:$width, :$height, :$color = "chartreuse") {
 412     ...
 413   }
 414
 415   rectangle(height => 10, width => 5);
 416   # same as: rectangle(height => 10, width => 5, color => "chartreuse");
 417
 418 =cut
 419
 420 =pod
 421
 422   fun get($url, :$cookie_jar = HTTP::Cookies->new(), :$referrer = $url) {
 423     ...
 424   }
 425
 426   my $data = get "http://www.example.com/", referrer => undef;  # overrides $referrer = $url
 427
 428 The above example shows that passing any value (even C<undef>) will override
 429 the default argument.
 430
 431 =item 6. Slurpy parameter
 432
 433 Finally you can put an array or hash in the parameter list, which will gobble
 434 up the remaining arguments (if any):
 435
 436   fun foo($x, $y, @rest) { ... }
 437
 438   foo "a", "b";            # $x = "a", $y = "b", @rest = ()
 439   foo "a", "b", "c";       # $x = "a", $y = "b", @rest = ("c")
 440   foo "a", "b", "c", "d";  # $x = "a", $y = "b", @rest = ("c", "d")
 441
 442 If you combine this with named parameters, the slurpy parameter will end up
 443 containing all unrecognized keys:
 444
 445   fun bar(:$size, @whatev) { ... }
 446
 447   bar weight => 20, size => 2, location => [0, -3];
 448   # $size = 2, @whatev = ('weight', 20, 'location', [0, -3])
 449
 450 =back
 451
 452 Apart from the L<C<shift>|perlfunc/shift> performed by the L<invocant|/"1.
 453 Invocant">, all of the above leave L<C<@_>|perlvar/@ARG> unchanged; and if you
 454 don't specify a parameter list at all, L<C<@_>|perlvar/@ARG> is all you get.
 455
 456 =head3 Keyword
 457
 458 The keywords provided by C<Function::Parameters> are customizable. Since
 459 C<Function::Parameters> is actually a L<pragma|perlpragma>, the provided
 460 keywords have lexical scope. The following import variants can be used:
 461
 462 =over
 463
 464 =item C<use Function::Parameters ':strict'>
 465
 466 Provides the keywords C<fun> and C<method> (described below) and enables
 467 argument checks so that calling a function and omitting a required argument (or
 468 passing too many arguments) will throw an error.
 469
 470 =item C<use Function::Parameters>
 471
 472 Provides the keywords C<fun> and C<method> (described below) and enables
 473 "lax" mode: Omitting a required argument sets it to C<undef> while excess
 474 arguments are silently ignored.
 475
 476 =item C<< use Function::Parameters { KEYWORD1 => TYPE1, KEYWORD2 => TYPE2, ... } >>
 477
 478 Provides completely custom keywords as described by their types. A "type" is
 479 either a string (one of the predefined types C<function>, C<method>,
 480 C<classmethod>, C<function_strict>, C<method_strict>, C<classmethod_strict>) or
 481 a reference to a hash with the following keys:
 482
 483 =over
 484
 485 =item C<name>
 486
 487 Valid values: C<optional> (default), C<required> (all functions defined with
 488 this keyword must have a name), and C<prohibited> (functions defined with this
 489 keyword must be anonymous).
 490
 491 =item C<shift>
 492
 493 Valid values: strings that look like scalar variables. This lets you specify a
 494 default L<invocant|/"1. Invocant">, i.e. a function defined with this keyword
 495 that doesn't have an explicit invocant in its parameter list will automatically
 496 L<C<shift>|perlfunc/shift> its first argument into the variable specified here.
 497
 498 =item C<invocant>
 499
 500 Valid values: booleans. If you set this to a true value, the keyword will
 501 accept L<invocants|/"1. Invocant"> in parameter lists; otherwise specifying
 502 an invocant in a function defined with this keyword is a syntax error.
 503
 504 =item C<attributes>
 505
 506 Valid values: strings containing (source code for) attributes. This causes any
 507 function defined with this keyword to have the specified
 508 L<attributes|attributes> (in addition to any attributes specified in the
 509 function definition itself).
 510
 511 =item C<default_arguments>
 512
 513 Valid values: booleans. This property is on by default; use
 514 C<< default_arguments => 0 >> to turn it off. This controls whether optional
 515 parameters are allowed. If it is turned off, using C<=> in parameter lists is
 516 a syntax error.
 517
 518 =item C<check_argument_count>
 519
 520 Valid values: booleans. If turned on, functions defined with this keyword will
 521 automatically check that they have been passed all required arguments and no
 522 excess arguments. If this check fails, an exception will by thrown via
 523 L<C<Carp::croak>|Carp>.
 524
 525 =back
 526
 527 The predefined type C<function> is equivalent to:
 528
 529  {
 530    name => 'optional',
 531    invocant => 0,
 532    default_arguments => 1,
 533    check_argument_count => 0,
 534  }
 535
 536 These are all default values, so C<function> is also equivalent to C<{}>.
 537
 538 C<method> is equivalent to:
 539
 540  {
 541    name => 'optional',
 542    shift => '$self',
 543    invocant => 1,
 544    attributes => ':method',
 545    default_arguments => 1,
 546    check_argument_count => 0,
 547  }
 548
 549
 550 C<classmethod> is equivalent to:
 551
 552  {
 553    name => 'optional',
 554    shift => '$class',
 555    invocant => 1,
 556    attributes => ':method',
 557    default_arguments => 1,
 558    check_argument_count => 0,
 559  }
 560
 561 C<function_strict>, C<method_strict>, and
 562 C<classmethod_strict> are like C<function>, C<method>, and
 563 C<classmethod>, respectively, but with C<< check_argument_count => 1 >>.
 564
 565 =back
 566
 567 Plain C<use Function::Parameters> is equivalent to
 568 C<< use Function::Parameters { fun => 'function', method => 'method' } >>.
 569
 570 C<use Function::Parameters qw(:strict)> is equivalent to
 571 C<< use Function::Parameters { fun => 'function_strict', method => 'method_strict' } >>.
 572
 573 =head2 Wrapping C<Function::Parameters>
 574
 575 If you want to write a wrapper around C<Function::Parameters>, you only have to
 576 call its C<import> method. Due to its L<pragma|perlpragma> nature it always
 577 affects the file that is currently being compiled.
 578
 579  package Some::Wrapper;
 580  use Function::Parameters ();
 581  sub import {
 582    Function::Parameters->import;
 583    # or Function::Parameters->import(@custom_import_args);
 584  }
 585
 586 =head2 How it works
 587
 588 The module is actually written in L<C|perlxs> and uses
 589 L<C<PL_keyword_plugin>|perlapi/PL_keyword_plugin> to generate opcodes directly.
 590 However, you can run L<C<perl -MO=Deparse ...>|B::Deparse> on your code to see
 591 what happens under the hood. In the simplest case (no argument checks, possibly
 592 an L<invocant|/"1. Invocant">, required positional/slurpy parameters only), the
 593 generated code corresponds to:
 594
 595   fun foo($x, $y, @z) { ... }
 596   # ... turns into ...
 597   sub foo { my ($x, $y, @z) = @_; sub foo; ... }
 598
 599   method bar($x, $y, @z) { ... }
 600   # ... turns into ...
 601   sub bar :method { my $self = shift; my ($x, $y, @z) = @_; sub bar; ... }
 602
 603 =head1 AUTHOR
 604
 605 Lukas Mai, C<< <l.mai at web.de> >>
 606
 607 =head1 COPYRIGHT & LICENSE
 608
 609 Copyright 2010, 2011, 2012 Lukas Mai.
 610
 611 This program is free software; you can redistribute it and/or modify it
 612 under the terms of either: the GNU General Public License as published
 613 by the Free Software Foundation; or the Artistic License.
 614
 615 See http://dev.perl.org/licenses/ for more information.
 616
 617 =cut