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 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 =back
 230
 231 Plain C<'function'> is equivalent to C<< { name => 'optional' } >>, and plain
 232 C<'method'> is equivalent to C<< { name => 'optional', shift => '$self' } >>.
 233
 234 =head2 Syntax and generated code
 235
 236 Normally, Perl subroutines are not in scope in their own body, meaning the
 237 parser doesn't know the name C<foo> or its prototype while processing the body
 238 of C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
 239 C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
 240 interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
 241 a I<foo() called too early to check prototype> warning. This module attempts
 242 to fix all of this by adding a subroutine declaration before the definition,
 243 so the parser knows the name (and possibly prototype) while it processes the
 244 body. Thus C<fun foo($x) :($) { $x }> really turns into
 245 C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
 246
 247 If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can
 248 put them after the parameter list with their usual syntax.
 249
 250 Syntactically, these new parameter lists live in the spot normally occupied
 251 by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by
 252 specifying it as the first attribute (this is syntactically unambiguous
 253 because normal attributes have to start with a letter while a prototype starts
 254 with C<(>).
 255
 256 As an example, the following declaration uses every feature available
 257 (subroutine name, parameter list, prototype, attributes, and implicit
 258 C<$self>):
 259
 260  method foo($x, $y, @z) :($;$@) :lvalue :Banana(2 + 2) {
 261    ...
 262  }
 263
 264 And here's what it turns into:
 265
 266  sub foo ($;$@); sub foo ($;$@) :lvalue :Banana(2 + 2) { my $self = shift; my ($x, $y, @z) = @_;
 267    ...
 268  }
 269
 270 Another example:
 271
 272  my $coderef = fun ($p, $q) :(;$$)
 273    :lvalue
 274    :Gazebo((>:O)) {
 275    ...
 276  };
 277
 278 And the generated code:
 279
 280  my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { my ($p, $q) = @_;
 281    ...
 282  };
 283
 284 =head2 Wrapping Function::Parameters
 285
 286 If you want to wrap L<Function::Parameters>, you just have to call its
 287 C<import> method. It always applies to the file that is currently being parsed
 288 and its effects are lexical (i.e. it works like L<warnings> or L<strict>):
 289
 290  package Some::Wrapper;
 291  use Function::Parameters ();
 292  sub import {
 293    Function::Parameters->import;
 294    # or Function::Parameters->import(@other_import_args);
 295  }
 296
 297 =head1 AUTHOR
 298
 299 Lukas Mai, C<< <l.mai at web.de> >>
 300
 301 =head1 COPYRIGHT & LICENSE
 302
 303 Copyright 2010, 2011, 2012 Lukas Mai.
 304
 305 This program is free software; you can redistribute it and/or modify it
 306 under the terms of either: the GNU General Public License as published
 307 by the Free Software Foundation; or the Artistic License.
 308
 309 See http://dev.perl.org/licenses/ for more information.
 310
 311 =cut