サブルーチン名に「!」「?」を使えるようにがんばった

昨日の続き。
ソースフィルタを使って作った。

Xubname.pm

package Xubname;
use strict;
use warnings;
use Filter::Simple;

my %IDENT = (
  '?' => __PACKAGE__.'_is_',
  '!' => __PACKAGE__.'_destroy_or_danger_',
);

FILTER_ONLY
  code => sub {
  s[ ( sub \s* )
     ( [^\W]\w* )\?
     ( \s* )
  ]
  [${1}$IDENT{'?'}$2$3]gxs;

  s[ ( \&? \s* (?:[^\W]\w*::)* )
     ([^\W][\w]*)\?
  ]
  [${1}$IDENT{'?'}$2]gxs;
  },

  code => sub {
  s[ ( sub \s* )
     ( [^\W]\w* )\!
     ( \s* )
  ]
  [${1}$IDENT{'!'}$2$3]gxs;

  s[ ( \&? \s* (?:[^\W]\w*::)* )
     ([^\W][\w]*)\!
  ]
  [${1}$IDENT{'!'}$2]gxs;
  }
;

1;
__END__

そのまま使う

test.pl

use Xubname;

sub even? {
  return !($_[0] % 2);
}

for my $i (1..10) {
  if (even?($i)) {
    print "$i is even.\n";
  }
}

$ perl test.pl 
2 is even.
4 is even.
6 is even.
8 is even.
10 is even.

B::Deparseでフィルタ後の結果確認。

$ perl -MO=Deparse test.pl 
use Xubname;
sub Xubname_is_even {
  return !($_[0] % 2);
}
foreach my $i (1 .. 10) {
  if (Xubname_is_even $i) {
    print "$i is even.\n";
  }
}
test.pl syntax OK

置き換わってましたー。

.pmファイルで使う

MyUtil.pm

package MyUtil;
use strict;
use warnings;
use Xubname;

sub import {
  Xubname->import;
}

sub odd? {
  return $_[0] % 2;
}

sub sort! {
  my @sorted = sort @_;
  for (my $i = 0; $i < @_; $i++) {
    $_[$i] = $sorted[$i];
  }
}

1;
__END__

test2.pl

use strict;
use warnings;
use feature qw/ say /;
use MyUtil;

sub even? {
  return ! MyUtil::odd?($_[0]);
}

for my $i (1..10) {
  if (MyUtil::odd?($i)) {
    say "$i is odd.";
  }
  if (even?($i)) {
    say "$i is even.";
  }
}

my @list = qw/ 7 6 4 1 9 3 2 8 5 /;
MyUtil::sort!(@list);

say "@list";

フィルタ後確認。

$ perl -MO=Deparse MyUtil.pm 
package MyUtil;
sub BEGIN {
  require strict;
  do {
    'strict'->import
  };
}
use Xubname;
sub import {
  use warnings;
  use strict 'refs';
  'Xubname'->import;
}
sub Xubname_is_odd {
  use warnings;
  use strict 'refs';
  return $_[0] % 2;
}
sub Xubname_destroy_or_danger_sort {
  use warnings;
  use strict 'refs';
  my(@sorted) = sort(@_);
  for (my $i = 0; $i < @_; ++$i) {
    $_[$i] = $sorted[$i];
  }
}
use warnings;
use strict 'refs';
'???';
MyUtil.pm syntax OK

$ perl -MO=Deparse test2.pl 
use MyUtil;
sub Xubname_is_even {
  use warnings;
  use strict 'refs';
  BEGIN {
    $^H{'feature_say'} = q(1);
  }
  return !MyUtil::Xubname_is_odd($_[0]);
}
use warnings;
use strict 'refs';
BEGIN {
  $^H{'feature_say'} = q(1);
}
foreach my $i (1 .. 10) {
  if (MyUtil::Xubname_is_odd($i)) {
    say "$i is odd.";
  }
  if (Xubname_is_even $i) {
    say "$i is even.";
  }
}
my(@list) = ('7', '6', '4', '1', '9', '3', '2', '8', '5');
MyUtil::Xubname_destroy_or_danger_sort(@list);
say "@list";
test2.pl syntax OK

実行してみる。

$ perl test2.pl 
1 is odd.
2 is even.
3 is odd.
4 is even.
5 is odd.
6 is even.
7 is odd.
8 is even.
9 is odd.
10 is even.
1 2 3 4 5 6 7 8 9

できた。

あとはパッケージの関係とimportをなんとかすればそれなりに使えそうな感じ。