Pixel Pedals of Tomakomai

北海道苫小牧市出身の初老の日常

Perlでちえんひょうか

Perlは正格評価なので、無限リストにheadをかけても停止してくれない。

use strict;
use warnings;

sub nil() { 'Nil' }
sub concat($$) {
    my ($x, $xs) = @_;
    [$x, $xs];
}

sub repeat($);
sub repeat($) {
    my $x = shift;
    concat $x, (repeat $x);
}

sub head($) {
    my $xs = shift;
    $xs->[0];
}

print head(concat 1, concat 2, nil), "\n";
print +(head repeat 1), "\n";  # ←無限ループ

ちえんひょうかさせるために、単純に以下のルールで書き換えると、headが止まってくれるようになる。

  • 値はsub {}で包む
  • 値を使う場合は ->() で呼ぶ
use strict;
use warnings;

sub nil() { sub { 'Nil' } }
sub concat($$) {
    my ($x, $xs) = @_;
    sub { [sub { $x->() }, sub { $xs->() }] };
}

sub repeat($);
sub repeat($) {
    my $x = shift;
    sub { (concat sub { $x->() }, sub { repeat sub { $x->() } })->() };
}

sub head($) {
    my $xs = shift;
    sub { $xs->() }->()->[0];
}

print head(sub { (concat sub { 1 }, sub { (concat sub { 2 }, sub { nil->() } )->() })->() })->(), "\n";
print +(head sub { (repeat sub { 1 })->() })->(), "\n";

コードの実行(≒評価)を伴わない、sub { $x->() } のような冗長部分は展開しても大丈夫。

use strict;
use warnings;

sub nil() { sub { 'NIL' } }
sub concat($$) {
    my ($x, $xs) = @_;
    sub { [$x, $xs] };
}

sub repeat($);
sub repeat($) {
    my $x = shift;
    sub { concat($x, sub { (repeat $x)->() })->() };
}

sub head($) {
    my $xs = shift;
    $xs->()->[0];
}

print head(sub { (concat sub { 1 }, sub { (concat sub { 2 }, sub { nil->() } )->() })->() })->(), "\n";
print +(head sub { (repeat sub { 1 })->() })->(), "\n";

無限リストに対するtakeとかも書いてみる。

sub take($$);
sub take($$) {
    my ($xs, $n) = @_;
    return sub { nil->() } if $n->() == 0;
    sub { concat($xs->()->[0], sub { (take $xs->()->[1], sub { $n->() - 1 })->() })->() };
}

sub dump_list($) {
    my $xs = shift;
    if ($xs->()->[1]->() eq nil->()) {
        print $xs->()->[0]->(), "\n";
        return sub {};
    } else {
        print $xs->()->[0]->(), ", ";
        return sub { (dump_list ($xs->()->[1]))->() };
    }
}

(dump_list sub { (take sub { (repeat sub { 1 })->() }, sub { 3 })->() })->();