Subscribed unsubscribe Subscribe Subscribe

ダメ人間オンライン

あまり信用しないほうがいい技術メモとか備忘録とかその他雑記

Werlとwwencode

先日のYAPC::Asia Tokyo 2010でLTをしてきたWerlとwwencodeについて簡単にですが書いてみます。

YAPC::Asia 2010 dameninngenn

きっかけ

今年の夏に開催されたLLTigerにてPythonライクなRubyRubyライクな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 */

うはwwwwwwwwwwwwwwwwwwおkwwwwwwwwwwwwwwwwwwwwwww