前の記事│このブログのトップへ│次の記事

2009年01月29日

巷で話題のニクイ奴をPerlで実装してみた

巷では空前のBrainf*ckブームっぽい。
で、その派生言語であるところの、「てってってー言語」というのが話題っぽかったのでPerlで実装してみました。
いろいろ突っ込みお待ちしてます。
あと、(俺｜私)もこんな言語で実装したよ！とかいうのあったら教えてくれるとうれしいです。たぶん。

プログラム言語「てってってー」 - H.Hiroのチラシの裏の裏

404 Blog Not Found:javascript - てってってー言語を移植してみた

実装は小飼弾氏のJavaScript版を大いにパクり参考にしました。 ありがとうございます。

出来ること

  • てってってーをコンパイルして実行
  • てってってーをファイルからコンパイルして実行
  • 文字コード指定してごにょごにょ
  • Perlコード吐き出し

使い方

ちょお簡単です。
下記をご覧いただければ一目瞭然ですね！ 

#!/usr/bin/perl

use strict;
use warnings;
use Language::Tettettee;
use utf8;
binmode STDOUT, ':utf8';

# とりあえずインスタンス生成して
my $tee = Language::Tettettee->new;

# てってってーをコンパイル
$tee->compile('
{「てってってーてってっててー」と出力するプログラム}

ーてってってー　{「てってっ」をメモリに書き込む}
てっててーてっててーてっててーてっててー　{ポインタを4つ戻す}
てってっーてってっーてってっーてってっー　{標準出力へ4文字出力する}
ーててーてっててーてってっー　{「て」をメモリに書き込み、ポインタを戻してから標準出力へ出力する}

ーーてってっててー　{「ーてってって」をメモリに書き込む}
てっててーてっててーてっててーてっててーてっててーてっててー　{ポインタを6つ戻す}
てってっーてってっーてってっーてってっーてってっーてってっー　{標準出力へ6文字出力する}
ーててーてっててーてってっー　{「て」をメモリに書き込み、ポインタを戻してから標準出力へ出力する}
ーーてーてっててーてってっー　{「ー」をメモリに書き込み、ポインタを戻してから標準出力へ出力する}
');

# 実行してみる
$tee->run;

# 実行結果表示をutf8 falg付きで出力
print $tee->output;

てってってーてってっててー

こんな感じですね。

ファイルからの場合はnewの代りにreadを使って

#my $tee = Language::Tettettee->new;
my $tee = Language::Tettettee->read('てってってーソースファイル');
$tee->run;
print $tee->output;

とすればいいです。
readでcompileまでやっちゃいます。

文字コード指定しる

通常であればutf8として頑張りますが、文字コードすればごにょごにょしてくれます。
newで指定すればあとはずっとそのエンコードとして扱います。
また、すべてのメソッドに対して毎回指定することもできます。
それから、utf8flag付き文字で返してほしくない場合は明示的に指定する必要があります。 

#!/usr/bin/perl

use strict;
use warnings;
use Language::Tettettee;
#use utf8;
#binmode STDOUT, ':utf8';

# 文字コード指定してやる
my $tee = Language::Tettettee->new('sjis');

# コンパイル
$tee->compile('
{"なのはなのなの"をメモリに書き込んで}
ーなのはなのなのてー
{標準入力から3文字受け取って}
てってってーてってってーてってってー
{ポインタ10個戻して}
てっててーてっててーてっててーてっててーてっててー
てっててーてっててーてっててーてっててーてっててー
{10文字標準出力するお！}
てってっーてってっーてってっーてってっーてってっー
てってっーてってっーてってっーてってっーてってっー
');

# 標準入力に文字入れる
$tee->input('なの？');

# 実行してみる
$tee->run;

# 実行結果表示をutf8 falgなしにしたい！
$tee->out_utf8_flag = 0;

# sjisになって出力される！
print $tee->output;

なのはなのなのなの？

sjisでかかれた「てってってー」を読み込んでコンパイルして実行します。
inputメソッドは標準入力の代わりです。

通常だとutf8 flag付きで出力されるので、明示的に「$tee->out_utf8_flag = 0;」でutf8 flagなしにしています。
モテたいがためにlvalueを使った。いまは反省している。

Perlコード出力

as_sourceメソッドでPerlの実行出来そうなコードを出力しますぜ

#!/usr/bin/perl

use strict;
use warnings;
use Language::Tettettee;
use utf8;
binmode STDOUT, ':utf8';

my $tee = Language::Tettettee->new;
$tee->compile('
{"なのはなのなの"をメモリに書き込んで}
ーなのはなのなのてー
{標準入力から3文字受け取って}
てってってーてってってーてってってー
{ポインタ10個戻して}
てっててーてっててーてっててーてっててーてっててー
てっててーてっててーてっててーてっててーてっててー
{10文字標準出力するお！}
てってっーてってっーてってっーてってっーてってっー
てってっーてってっーてってっーてってっーてってっー
');

# 標準入力に文字入れる
$tee->input('なの？');

# perlコードに変換
print $tee->as_source;

do {
    my $input = [];
    push @$input, 'な';
    push @$input, 'の';
    push @$input, '？';

    my $data = [];
    my $output = [];
    my $sp = 0;
    push @$data, 0 for (1..65535);

    for (my $j = 1; $j < length('ーなのはなのなのてー') - 2; $j++) {
        $data->[$sp++] = substr('ーなのはなのなのてー', $j, 1)
    }

    $data->[$sp++] = shift @{$self->{input}};
    $data->[$sp++] = shift @{$self->{input}};
    $data->[$sp++] = shift @{$self->{input}};

    $sp--;
    $sp--;
    $sp--;
    $sp--;
    $sp--;

    $sp--;
    $sp--;
    $sp--;
    $sp--;
    $sp--;

    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];

    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];
    push @$output, $data->[$sp++];

    $output;
}

inputされた文字も復元されます。まぁ微妙だけど。

続きにコード晒しておきます。

ちょお汚いし、リファレンスとか使いまくってる理由がよくわからないけど気にしないでね！

Language::Tettettee

package Language::Tettettee;
 
use strict;
use warnings;
use utf8;
use Encode;
use Carp;
 
our $VERSION = 0.01;
 
my $utf8 = find_encoding 'utf8';
 
sub new($;$$) {
    my $class = shift;
    my $enc = shift || $utf8;
    
    $enc = find_encoding $enc unless ref $enc;
    
    bless {
        input     => my $input = [],
        output    => my $output = [],
        code      => my $code = "",
        enc       => $enc,
        utf8_flag => 1,
        @_,
    }, $class;
}
 
sub read($;$$) {
    my $class = shift;
    my $tee_file = shift or croak __PACKAGE__, "->read(filename)";
    my $tee = $class->new(@_);
    open my $fh, "<", $tee_file or croak "$tee_file $!";
    my $src = do { local $/; <$fh> };
    close $fh;
    $tee->compile($src);
    return $tee;
}
 
my $parser = sub {
    my $str = shift;
    $str eq 'てってー'       ? return '$sp++;' . "\n" :
    $str eq 'てっててー'     ? return '$sp--;' . "\n" :
    $str eq 'ててー'         ? return '$data->[$sp]++;' . "\n" :
    $str eq 'てっー'         ? return '$data->[$sp]--;' . "\n" :
    $str eq 'てってっー'     ? return 'push @$output, $data->[$sp++];' . "\n" :
    $str eq 'てってってー'   ? return '$data->[$sp++] = shift @{$self->{input}};' . "\n" :
    $str eq 'てってっててー' ? return 'whiile ($data->[$sp]) {' . "\n" :
    $str eq 'てってってっー' ? return '}' . "\n" :
    return 'for (my $j = 1; $j < length('. qq{'$str'} .') - 2; $j++) {' ."\n" .
        "\t" . '$data->[$sp++] = substr(' . qq{'$str'} . ', $j, 1)' . "\n" .
        '}' . "\n";
};
 
my $convert = sub {
    my $str = shift;
    $str =~ s/\s*{[^}]+}//g;
    $str =~ s/(
        ー.*?てー
        |ててー
        |てっー
        |てってー
        |てっててー
        |てってっー
        |てってってー
        |てってっててー
        |てってってっー
    )/$parser->($1)/egx;
    
    $str = 
        'my $data = [];' . "\n" . 
        'my $output = [];' . "\n" . 
        'my $sp = 0;' . "\n" .
        'push @$data, 0 for (1..65535);' . "\n" .
        $str .
        '$output;' . "\n";
    
    return $str;
};
 
my $decoder = sub {
    my $str = shift;
    my $enc = shift;
    return decode $enc, $str unless Encode::is_utf8 $str;
    return $str;
};
 
my $encoder = sub {
    my $str = shift;
    my $enc = shift;
    return encode $enc, $str if Encode::is_utf8 $str;
    return $str;
};
 
sub run($;$$) {
    my $self = shift;
    my $str = shift;
    my $enc = shift || $self->{enc};
    $str = $decoder->($str, $enc);
    
    unless ($self->{code}) {
        croak __PACKAGE__, "->run(code)" unless $str;
        $self->compile($str)
    }
    
    my $result = $self->{code}();
    
    delete $self->{input};
    delete $self->{code};
    
    $self->{output} = $result;
}
 
sub compile($;$$) {
    my $self = shift;
    my $str = shift;
    my $enc = shift || $self->{enc};
    $str = $decoder->($str, $enc);
    
    $self->{src} = $convert->($str);
    $self->{code} = eval 'sub {' . $self->{src} . '}';
    croak "$@\n", $encoder->($self->{src}, $enc) if $@;
    return 1;
}
 
sub input($;$$) {
    my $self = shift;
    my $str = shift;
    my $enc = shift || $self->{enc};
    $str = $decoder->($str, $enc);
    
    for (my $i = 0; $i < length $str; $i++) {
        push @{$self->{input}}, substr($str, $i, 1);
    }
}
 
sub output($;$) {
    my $self = shift;
    my $enc = shift || $self->{enc};
    my $str = join '', @{$self->{output}};
    return $encoder->($str, $enc) unless $self->{utf8_flag};
    return $str;
}
 
sub as_source($;$) {
    my $self = shift;
    my $enc = shift || $self->{enc};
    
    my $input =
        'my $input = [];' . "\n" .
        do {
            my $str;
            for (my $i = 0; $i < @{$self->{input}}; $i++) {
                $str .= sprintf "push \@\$input, '%s';\n", $self->{input}[$i];
            }
            $str;
        } .
        "\n";
    my $src = $input . $self->{src};
    $src =~ s/^/    /gm;
    $src = sprintf "do {\n%s}\n", $src;
    return $encoder->($src, $enc) unless $self->{utf8_flag};
    return $src;
}
 
sub out_utf8_flag : lvalue {
    shift->{utf8_flag};
}
 
1;

Enjoy Esoteric Language !

タグ:     
xaicron at 19:51│コメント(6)│Perl | てってってー  このエントリーをはてなブックマークに追加
編集

トラックバック一覧

1. てってってーをちょっと改良  [ にひりずむ::しんぷる ]   2009年01月29日 23:29
早速テコ入れしました。 変更点 as_sourceをas_perlに変更 as_perlで本当に実行可能なコードを生成 Perl内部表現で出力するオプション搭載 outputのutf8 flag云々ぬ実装を変更 大まかにはこんな感じ。 あとは「@$&quot;」のエスケープ処理追加した。 ...

コメント一覧

1. Posted by dp bbm lucu   2014年11月27日 01:08
」というのが話題っぽかったのでPerlで実装してみました。
いろいろ突っ込みお待ちしてます。
2. Posted by Cetak Murah Rawamangun Jakarta Timur   2016年10月31日 05:02
非常に興味深い記事、ありがとうございました
3. Posted by Cetak Murah Rawamangun Jakarta Timur   2016年12月07日 02:11
非常に興味深い記事、ありがとうございました
4. Posted by Cetak Murah Rawamangun Jakarta Timur   2016年12月28日 04:06
非常に興味深い記事、ありがとうございました
5. Posted by Percetakan murah di Jakarta   2017年03月30日 05:56
」というのが話題っぽかったのでPerlで実装してみました。
いろいろ突っ込みお待ちしてます。
6. Posted by MURNI JAYA Printing   2017年09月27日 08:54
早速テコ入れしました。 変更点 as_sourceをas_perlに変更 as_perlで本当に実行可能なコードを生成 Perl内部表現で出力するオプション搭載 outputのutf8 flag云々ぬ実装を変更 大まかにはこんな感じ。 あとは「@$&quot;」のエスケープ処理追加

コメントする

名前:
URL:
  情報を記憶： 評価：  顔   星
  絵文字
 
 
プロフィール

Perlが少しだけ出来る気になってます。
JavaScriptはよくわかりません。
Rubyもちんぷんかんぷんです。
Pythonは難しいです。
ActionScript勘弁してください。
Javaあばばばばば。
低級言語できません。

github

xaicron's Profile - GitHub

Public Gists by xaicron

記事検索
最新記事
「tail -f」を使うのは情弱、情強は「tail -F」を使う
perlcasual#06でちょこっと話ました
perl で復数のプロセスからログを吐くときは syswrite または flock すべし
Web::Query 0.26 に prev() と next() を追加
Minilla で tag だげ打って CPAN には上げたくない時の設定
JSON::XS 3.0 あたりから Boolean のクラスが変わってたの巻
超実用的な内容盛りだくさんの "Perl徹底攻略" という本がでました！
勝手に YAPC::NA 2013 に行ってきた！！
OS X の tcpdump で localhost 間の通信を見たい
Ginger API を試してみた
  • ライブドアブログ