先日のYAPC::Asia Tokyo 2010でLTをしてきたWerlとwwencodeについて簡単にですが書いてみます。
きっかけ
今年の夏に開催されたLLTigerにてPythonライクなRubyとRubyライクなPythonであるPubyとRhythonを実装したというLTを見てすげー笑いながら感動したのが始まりです。
LLの虎 準決勝: 殺伐Python - 「タイガー&ドラゴン」 - muddy brown thang
(moriyoshiさんのLTの資料見ていただけるとわかると思いますが、私のLTの一枚目を「はい」としたのはmoriyoshiさんのスライドのパクリです。スイマセン＞＜)
また、同夏に開催されたRubyKaigi2010でGoogleWaveのカリスマであるあんどうさんがLTしたFuzzy Rubyで完全に火がついた感じです。
(中略)
それでPerlで草植活動を行なおうという考えに至りました。
Werl
Perl5.12.1を元に開発(?)しました。
dameninngenn's werl at master - GitHub
実装するにあたりいくつか方法を考えました。
1.ソースフィルタを使う
2.Perlのソースコード内でファイル読んだ直後にソースフィルタみたいな処理をさせる。
3.字句解析してるとこでごにょごにょする。
1の方法はインパクトに欠けるかなと思い、2の方法は自分の実力が足らず期間内にできそうにないなと思ったため結局3の方法で実装しました。
Perlをビルドするとこからやらないといけないので気軽に試しに使ってもらうということができないのがデメリットです。
実際の実装ですが、大したことなくtoke.cで既存の字句解析をしてコードを返してるとこを真似てwやらWWやらWWWWWやらを追加したやっただけです。
[サンプル]
sub larger_num { my $num1 = shift; my $num2 = shift; if ($num1 >= $num2) { return $num1; } else { return $num2; } } print larger_num(10,20),"\n";
Wwwww wwww_wwww {
WWW $w_w = WWwWWW;
WWW $w_ww = WWwWWW;
wWW ($w_w >= $w_ww) {
wwWwWWw $w_w;
} WWwWW {
wwWwWWw $w_ww;
}
}
wwWwWww wwww_wwww(10,20),"\n";
Werlで実行すればちゃんと20が返ってきます:)
wwencode
dameninngenn's wwencode at master - GitHub
竹迫さんのppencodeのパクリです＞＜
ppencode - JAPH perl program encode
ただ、文字がwWとスペースだけしか使用できないのでコード生成ルールが制限されています。
1.length q wWWWWW WWWWWw などとして基底となる数値を得ます。
2.1で得た数値をhexもしくはoctに渡して任意の数値になるまで繰り返します。
3.2で得た任意の数値をasciiコードとみなしchrで文字にして出力します。
やってることはこれだけです。
[サンプル]
% echo -n "dameninngenn" | ./wwencode WWwwWW WWww wWwww wwwWWWw W wWWWWW WWWWWWw WwWW WWwwWW WWww wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W wWWWWW WWWWw WwWW WWwwWW WWww wWwww wWwww wWwww wWwww wWwww wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWWWw W wWWWWW WWWWWw WwWW WWwwWW WWww wWwww wWwww wWwww wWwww wWwww wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWWWw W wWWWWW WWWWWw WwWW WWwwWW WWww wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W wWWWWW WWWWWw WwWW WWwwWW WWww wWwww wWwww wWwww wwwWW wWwww wWwww wWwww wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W Wwwwwww wwwwwwW WwWW WWwwWW WWww wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWW wwwWWWw W Wwwwwww wwwwwwW WwWW WWwwWW WWww wWwww wWwww wWwww wwwWW wWwww wWwww wWwww wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W Wwwwwww wwwwwwW WwWW WWwwWW WWww wWwww wWwww wWwww wwwWW wWwww wWwww wWwww wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W Wwwwwww wwwwwwW WwWW WWwwWW WWww wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWW wwwWWWw W wWWWWW WWWWWw WwWW WWwwWW WWww wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W wWWWWW WWWWWw WwWW WWwwWW WWww wWwww wWwww wWwww wwwWW wWwww wWwww wWwww wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W Wwwwwww wwwwwwW WwWW WWwwWW WWww wWwww wWwww wWwww wwwWW wWwww wWwww wWwww wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wwwWW wWwww wwwWW wwwWW wwwWW wwwWWWw W Wwwwwww wwwwwwW WwWW WWwwWW WWww wWwww wwwWWWw W wWWWWW WWWWWWw
% echo -n "dameninngenn" | ./wwencode | werl dameninngenn
ただ、これを生成する際のコードでちゃんとエラーチェックしていないため文字の種類によってはエラーが出てしまうようになってます。
1.8進数の形式でないものをoctで変換しようとする。
2.オーバーフロー
ちゃんと選べばオーバーフローで無理やり変換しているものを省ける(はず)のですが、wwencodeはそれを含んでます。
そうじゃなくちゃんとエラー処理しとけよって話ですよね、すいませんorz
gdgdな生成コードも戒めのために載せておきます。
出力が草ではなくoctとかhexになってるので安定バージョンじゃないかもしれませんがコンセプトとしてはこんな感じです。
(ある日ついカッとなってgitのリポジトリを消した。。。)
1 #!/usr/bin/perl
2
3 use strict;
4 no warnings;
5 use Dumpvalue;
6
7 my @base_num = (10,11,12,13);
8 my %base_hash;
9 $base_hash{10} = 'length q wWWWWW WWWWw ';
10 $base_hash{11} = 'length q wWWWWW WWWWWw ';
11 $base_hash{12} = 'length q wWWWWW WWWWWWw ';
12 $base_hash{13} = 'length q Wwwwwww wwwwwwW ';
13
14 sub get_min_token {
15 my $token_list = shift;
16 my $min_length;
17 my $min_key;
18 my $result_token;
19
20 foreach my $key (keys %$token_list) {
21 foreach (@{$token_list->{$key}}) {
22 unless($min_length) {
23 $min_length = length($_);
24 $min_key = $key;
25 $result_token = $_.$base_hash{$key};
26 }
27 if($min_length > length($_)) {
28 $min_length = length($_);
29 $min_key = $key;
30 $result_token = $_.$base_hash{$key};
31 }
32 }
33 }
34
35 return $result_token;
36 }
37
38 sub oct_hex {
39 my $org_num = shift;
40 my $hope_num = shift;
41 my $result_array = shift;
42 my $r_max = shift;
43 my $result_str_org = shift || undef;
44 my $r_num = shift || 0;
45 my $result_num_hex;
46 my $result_num_oct;
47
48 $r_num += 1;
49
50 # hex
51 my $result_str_hex = 'hex '.$result_str_org;
52 eval{
53 $result_num_hex = hex($org_num);
54 };
55
56 if($result_num_hex eq $hope_num) {
57 push(@$result_array,$result_str_hex);
58 return $result_array;
59 }
60
61 # oct
62 my $result_str_oct = 'oct '.$result_str_org;
63 eval{
64 $result_num_oct = oct($org_num);
65 };
66
67 if($result_num_oct eq $hope_num) {
68 push(@$result_array,$result_str_oct);
69 return $result_array;
70 }
71
72 if ($r_num > $r_max) {
73 return $result_array;
74 }
75 $result_array = oct_hex(
76 $result_num_hex,
77 $hope_num,
78 $result_array,
79 $r_max,
80 $result_str_hex,
81 $r_num
82 );
83 $result_array = oct_hex(
84 $result_num_oct,
85 $hope_num,
86 $result_array,
87 $r_max,
88 $result_str_oct,
89 $r_num
90 );
91
92 return $result_array;
93 }
94
95 sub get_hex_oct {
96 my $character = shift;
97 my $r_max = 10;
98 my $loop;
99 my %result;
100
101 while(!$loop) {
102 foreach (@base_num) {
103 my @result_array;
104 $result{$_} = oct_hex($_,$character,\@result_array,$r_max);
105 $loop = @result_array;
106 }
107 $r_max += 5;
108 }
109
110 my $min_token = get_min_token(\%result);
111
112 return $min_token;
113 }
114
115 sub wwencode {
116 my $text = shift;
117 my $r = "";
118 for (my $i = 0; $i < length($text); $i++) {
119 my $code = get_hex_oct(ord(substr($text, $i, 1)));
120 if ($code ne '') {
121 $r .= 'and print chr ' . $code;
122 }
123 }
124 return $r;
125 }
126
127 print "#!/usr/bin/perl\n";
128 print "WWwwWW WWww wWwww wwwWWWw W wWWWWW WWWWWWw ";
129 while (my $line = <>) {
130 print wwencode($line);
131 }
132 print "and WWwwWW WWww wWwww wwwWWWw W wWWWWW WWWWWWw";
133 print "\n";
134
135 1;
136
逐次で変換して出力するパターンもやってみたのですが、処理時間がかかりすぎたためwwencodeでは生成したコードをハッシュで予め用意して使うようにしました。
今後
今回はボツとしたソースフィルタ使うパターンをAcmeモジュールとして作ろうかなとか考えてます:P
あとRubyバージョンのWuby作るためにparse.y読んでます。
おまけ
Werl予約語対応表
w /* m */
W /* q */
ww /* s */
wW /* x */
Ww /* y */
WW /* do */
www /* eq */
wwW /* ge */
wWw /* gt */
wWW /* if */
Www /* lc */
WwW /* le */
WWw /* lt */
WWW /* my */
wwww /* ne */
wwwW /* no */
wwWw /* or */
wwWW /* qq */
wWww /* qr */
wWwW /* qw */
wWWw /* qx */
wWWW /* tr */
Wwww /* uc */
WwwW /* END */
WwWw /* abs */
WwWW /* and */
WWww /* chr */
WWwW /* cmp */
WWWw /* cos */
WWWW /* die */
wwwww /* eof */
wwwwW /* exp */
wwwWw /* for */
wwwWW /* hex */
wwWww /* int */
wwWwW /* log */
wwWWw /* map */
wwWWW /* not */
wWwww /* oct */
wWwwW /* ord */
wWwWw /* our */
wWwWW /* pop */
wWWww /* pos */
wWWwW /* ref */
wWWWw /* say */
wWWWW /* sin */
Wwwww /* sub */
WwwwW /* tie */
WwwWw /* use */
WwwWW /* vec */
WwWww /* xor */
WwWwW /* CORE */
WwWWw /* INIT */
WwWWW /* bind */
WWwww /* chop */
WWwwW /* dump */
WWwWw /* each */
WWwWW /* else */
WWWww /* eval */
WWWwW /* exec */
WWWWw /* exit */
WWWWW /* fork */
wwwwww /* getc */
wwwwwW /* glob */
wwwwWw /* goto */
wwwwWW /* grep */
wwwWww /* join */
wwwWwW /* keys */
wwwWWw /* kill */
wwwWWW /* last */
wwWwww /* link */
wwWwwW /* lock */
wwWwWw /* next */
wwWwWW /* open */
wwWWww /* pack */
wwWWwW /* pipe */
wwWWWw /* push */
wwWWWW /* rand */
wWwwww /* read */
wWwwwW /* recv */
wWwwWw /* redo */
wWwwWW /* seek */
wWwWww /* send */
wWwWwW /* sort */
wWwWWw /* sqrt */
wWwWWW /* stat */
wWWwww /* tell */
wWWwwW /* tied */
wWWwWw /* time */
wWWwWW /* wait */
wWWWww /* warn */
wWWWwW /* when */
wWWWWw /* BEGIN */
wWWWWW /* CHECK */
Wwwwww /* alarm */
WwwwwW /* atan2 */
WwwwWw /* bless */
WwwwWW /* break */
WwwWww /* chdir */
WwwWwW /* chmod */
WwwWWw /* chomp */
WwwWWW /* chown */
WwWwww /* close */
WwWwwW /* crypt */
WwWwWw /* elsif */
WwWwWW /* fcntl */
WwWWww /* flock */
WwWWwW /* given */
WwWWWw /* index */
WwWWWW /* ioctl */
WWwwww /* local */
WWwwwW /* lstat */
WWwwWw /* mkdir */
WWwwWW /* print */
WWwWww /* reset */
WWwWwW /* rmdir */
WWwWWw /* semop */
WWwWWW /* shift */
WWWwww /* sleep */
WWWwwW /* split */
WWWwWw /* srand */
WWWwWW /* state */
WWWWww /* study */
WWWWwW /* times */
WWWWWw /* umask */
WWWWWW /* undef */
wwwwwww /* untie */
wwwwwwW /* until */
wwwwwWw /* utime */
wwwwwWW /* while */
wwwwWww /* write */
wwwwWwW /* accept */
wwwwWWw /* caller */
wwwwWWW /* chroot */
wwwWwww /* delete */
wwwWwwW /* elseif */
wwwWwWw /* exists */
wwwWwWW /* fileno */
wwwWWww /* format */
wwwWWwW /* gmtime */
wwwWWWw /* length */
wwwWWWW /* listen */
wwWwwww /* msgctl */
wwWwwwW /* msgget */
wwWwwWw /* msgrcv */
wwWwwWW /* msgsnd */
wwWwWww /* printf */
wwWwWwW /* rename */
wwWwWWw /* return */
wwWwWWW /* rindex */
wwWWwww /* scalar */
wwWWwwW /* select */
wwWWwWw /* semctl */
wwWWwWW /* semget */
wwWWWww /* shmctl */
wwWWWwW /* shmget */
wwWWWWw /* socket */
wwWWWWW /* splice */
wWwwwww /* substr */
wWwwwwW /* system */
wWwwwWw /* unless */
wWwwwWW /* unlink */
wWwwWww /* unpack */
wWwwWwW /* values */
wWwwWWw /* DESTROY */
wWwwWWW /* __END__ */
wWwWwww /* binmode */
wWwWwwW /* connect */
wWwWwWw /* dbmopen */
wWwWwWW /* default */
wWwWWww /* defined */
wWwWWwW /* foreach */
wWwWWWw /* getpgrp */
wWwWWWW /* getppid */
wWWwwww /* lcfirst */
wWWwwwW /* opendir */
wWWwwWw /* package */
wWWwwWW /* readdir */
wWWwWww /* require */
wWWwWwW /* reverse */
wWWwWWw /* seekdir */
wWWwWWW /* setpgrp */
wWWWwww /* shmread */
wWWWwwW /* sprintf */
wWWWwWw /* symlink */
wWWWwWW /* syscall */
wWWWWww /* sysopen */
wWWWWwW /* sysread */
wWWWWWw /* sysseek */
wWWWWWW /* telldir */
Wwwwwww /* ucfirst */
WwwwwwW /* unshift */
WwwwwWw /* waitpid */
WwwwwWW /* AUTOLOAD */
WwwwWww /* __DATA__ */
WwwwWwW /* __FILE__ */
WwwwWWw /* __LINE__ */
WwwwWWW /* closedir */
WwwWwww /* continue */
WwwWwwW /* dbmclose */
WwwWwWw /* endgrent */
WwwWwWW /* endpwent */
WwwWWww /* formline */
WwwWWwW /* getgrent */
WwwWWWw /* getgrgid */
WwwWWWW /* getgrnam */
WwWwwww /* getlogin */
WwWwwwW /* getpwent */
WwWwwWw /* getpwnam */
WwWwwWW /* getpwuid */
WwWwWww /* readline */
WwWwWwW /* readlink */
WwWwWWw /* readpipe */
WwWwWWW /* setgrent */
WwWWwww /* setpwent */
WwWWwwW /* shmwrite */
WwWWwWw /* shutdown */
WwWWwWW /* syswrite */
WwWWWww /* truncate */
WwWWWwW /* UNITCHECK */
WwWWWWw /* endnetent */
WwWWWWW /* getnetent */
WWwwwww /* localtime */
WWwwwwW /* prototype */
WWwwwWw /* quotemeta */
WWwwwWW /* rewinddir */
WWwwWww /* setnetent */
WWwwWwW /* wantarray */
WWwwWWw /* endhostent */
WWwwWWW /* endservent */
WWwWwww /* gethostent */
WWwWwwW /* getservent */
WWwWwWw /* getsockopt */
WWwWwWW /* sethostent */
WWwWWww /* setservent */
WWwWWwW /* setsockopt */
WWwWWWw /* socketpair */
WWwWWWW /* __PACKAGE__ */
WWWwwww /* endprotoent */
WWWwwwW /* getpeername */
WWWwwWw /* getpriority */
WWWwwWW /* getprotoent */
WWWwWww /* getsockname */
WWWwWwW /* setpriority */
WWWwWWw /* setprotoent */
WWWwWWW /* getnetbyaddr */
WWWWwww /* getnetbyname */
WWWWwwW /* gethostbyaddr */
WWWWwWw /* gethostbyname */
WWWWwWW /* getservbyname */
WWWWWww /* getservbyport */
WWWWWwW /* getprotobyname */
WWWWWWw /* getprotobynumber */うはｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗおｋｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗ
