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 })->() })->();