Perl 的 Lisp 风格

一些编程语言（例如 C）只有命名函数，而另一些（例如 Lisp、Java 和 Perl）则既有命名函数也有匿名函数。lambda 表达式是一个匿名函数，Lisp 是推广这个术语的语言。Lambda 表达式有多种用途，但它们特别适合数据丰富的应用程序。考虑一下这种数据管道的描述，其中显示了两个处理阶段

Lambda 表达式和高阶函数

过滤器和转换阶段可以实现为高阶函数——也就是说，可以接受函数作为参数的函数。假设所描述的管道是应收账款应用程序的一部分。过滤器阶段可能由一个名为 filter_data 的函数组成，该函数的单个参数是另一个函数——例如，一个 high_buyers 函数，用于过滤掉低于阈值的金额。转换阶段可能会将美元金额转换为等值的欧元或其他货币，具体取决于作为高阶 transform_data 函数的参数插入的函数。更改过滤器或转换行为只需要将不同的函数参数插入到高阶 filter_data 或 transform_data 函数中即可。

Lambda 表达式非常适合作为高阶函数的参数，原因有二。首先，lambda 表达式可以即时创建，甚至可以作为参数就地编写。其次，lambda 表达式鼓励编写纯函数，纯函数的行为完全取决于传入的参数；此类函数没有副作用，因此可以促进安全的并发程序。

Perl 对 lambda 表达式和高阶函数具有直接的语法和语义，如下例所示

初识 Perl 中的 lambda 表达式

#!/usr/bin/perl

use strict;
use warnings;

## References to lambdas that increment, decrement, and do nothing.
## $_[0] is the argument passed to each lambda.
my $inc = sub { $_[0] + 1 };  ## could use 'return $_[0] + 1' for clarity
my $dec = sub { $_[0] - 1 };  ## ditto
my $nop = sub { $_[0] };      ## ditto

sub trace {
    my ($val, $func, @rest) = @_;
    print $val, " ", $func, " ", @rest, "\nHit RETURN to continue...\n";
    <STDIN>;
}

## Apply an operation to a value. The base case occurs when there are
## no further operations in the list named @rest.
sub apply {
    my ($val, $first, @rest) = @_;
    trace($val, $first, @rest) if 1;  ## 0 to stop tracing

    return ($val, apply($first->($val), @rest)) if @rest; ## recursive case
    return ($val, $first->($val));                        ## base case
}

my $init_val = 0;
my @ops = (                        ## list of lambda references
    $inc, $dec, $dec, $inc,
    $inc, $inc, $inc, $dec,
    $nop, $dec, $dec, $nop,
    $nop, $inc, $inc, $nop
    );

## Execute.
print join(' ', apply($init_val, @ops)), "\n";
## Final line of output: 0 1 0 -1 0 1 2 3 2 2 1 0 0 0 1 2 2

上面显示的 lispy 程序突出了 Perl lambda 表达式和高阶函数的基础知识。Perl 中的命名函数以关键字 sub 开头，后跟名称

sub increment { ... }   # named function

未命名或匿名函数省略名称

sub {...}               # lambda, or unnamed function

在 lispy 示例中，有三个 lambda 表达式，为了方便起见，每个表达式都有一个引用指向它。这里，为了回顾，是 $inc 引用和引用的 lambda 表达式

my $inc = sub { $_[0] + 1 };

lambda 表达式本身，即赋值运算符 = 右侧的代码块，将其参数 $_[0] 递增 1。lambda 表达式的主体以 Lisp 风格编写；也就是说，在递增表达式之后既没有显式的 return 也没有分号。在 Perl 中，与 Lisp 中一样，如果不存在显式的 return 语句，则函数主体中最后一个表达式的值将成为返回值。在本例中，每个 lambda 表达式的主体中只有一个表达式——这种简化符合 lambda 编程的精神。

lispy 程序中的 trace 函数有助于阐明程序的工作原理（我将在下面说明）。高阶函数 apply，是对同名 Lisp 函数的致敬，它接受一个数值作为其第一个参数，一个 lambda 表达式引用列表作为其第二个参数。apply 函数最初在程序的底部被调用，第一个参数为零，第二个参数为名为 @ops 的列表。此列表包含来自 $inc（递增值）、$dec（递减值）和 $nop（不执行任何操作）的 16 个 lambda 表达式引用。该列表可以包含 lambda 表达式本身，但使用更简洁的 lambda 表达式引用，代码更容易编写和理解。

高阶 apply 函数的逻辑可以阐明如下

1. 传递给 apply 的参数列表以典型的 Perl 方式分为三部分

   my ($val, $first, @rest) = @_; ## break the argument list into three elements

   第一个元素 $val 是一个数值，最初为 0。第二个元素 $first 是一个 lambda 表达式引用，即 $inc $dec 或 $nop 之一。第三个元素 @rest 是在第一个此类引用被提取为 $first 之后剩余的 lambda 表达式引用列表。

2. 如果列表 @rest 在移除其第一个元素后不为空，则递归调用 apply。递归调用的 apply 的两个参数是

   • 通过将 lambda 表达式操作 $first 应用于数值 $val 生成的值。例如，如果 $first 是 $inc 引用的递增 lambda 表达式，并且 $val 为 2，则 apply 的新第一个参数将为 3。
   • 剩余 lambda 表达式引用的列表。最终，此列表将变为空，因为每次调用 apply 都会通过提取其第一个元素来缩短列表。

以下是 lispy 程序的示例运行的一些输出，其中 % 是命令行提示符

% ./lispy.pl

0 CODE(0x8f6820) CODE(0x8f68c8)CODE(0x8f68c8)CODE(0x8f6820)CODE(0x8f6820)CODE(0x8f6820)...
Hit RETURN to continue...

1 CODE(0x8f68c8) CODE(0x8f68c8)CODE(0x8f6820)CODE(0x8f6820)CODE(0x8f6820)CODE(0x8f6820)...
Hit RETURN to continue

第一个输出行可以阐明如下

• 0 是作为参数传递给函数 apply 的初始（因此是非递归的）调用的数值。参数名称是 apply 中的 $val。
• CODE(0x8f6820) 是对 lambda 表达式之一的引用，在本例中是对 $inc 引用的 lambda 表达式的引用。因此，第二个参数是某些 lambda 代码的地址。参数名称是 apply 中的 $first
• 第三部分，即 CODE 引用系列，是超出第一个的 lambda 表达式引用列表。参数名称是 apply 中的 @rest。

上面显示的第二行输出也值得一看。数值现在是 1，即递增 0 的结果：初始 lambda 表达式是 $inc，初始值是 0。提取的引用 CODE(0x8f68c8) 现在是 $first，因为此引用是 @rest 列表中在 $inc 之前提取的第一个元素。

最终，@rest 列表变为空，这结束了对 apply 的递归调用。在这种情况下，函数 apply 只返回一个包含两个元素的列表

1. 作为参数传入的数值（在示例运行中为 2）。
2. 此参数由 lambda 表达式转换（也为 2，因为最后一个 lambda 表达式引用恰好是 $nop，表示不执行任何操作）。

lispy 示例强调，Perl 支持 lambda 表达式，而无需任何特殊的繁琐语法：lambda 表达式只是一个未命名的代码块，可能有一个引用指向它以方便使用。lambda 表达式本身，或对其的引用，可以直接作为参数传递给高阶函数，例如 lispy 示例中的 apply。通过引用调用 lambda 表达式同样直接。在 apply 函数中，调用是

$first->($val)    ## $first is a lambda reference, $val a numeric argument passed to the lambda

更丰富的代码示例

下一个代码示例将 lambda 表达式和高阶函数用于实际用途。该示例实现了康威生命游戏，这是一种可以表示为细胞矩阵的细胞自动机。这样的矩阵会经历各种转换，每次转换都会产生新一代的细胞。生命游戏非常有趣，因为即使是相对简单的初始配置也可能导致非常复杂的行为。快速了解一下控制细胞出生、存活和死亡的规则是有序的。

考虑这个 5x5 矩阵，星号表示活细胞，短划线表示死细胞

 -----              ## initial configuration
 --*--
 --*--
 --*--
 -----

下一代变为

 -----              ## next generation
 -----
 -***-
 ----
 -----

随着生命的延续，世代在两种配置之间振荡。

以下是确定细胞出生、死亡和存活的规则。给定细胞的邻居数量介于三个（角细胞）到八个（内部细胞）之间

• 一个死亡细胞，如果恰好有三个活邻居，就会复活。
• 一个活细胞，如果活邻居超过三个，就会因过度拥挤而死亡。
• 一个活细胞，如果有两个或三个活邻居，就会存活；因此，一个活细胞，如果活邻居少于两个，就会因孤独而死亡。

在上面显示的初始配置中，顶部和底部的活细胞死亡，因为它们都没有两个或三个活邻居。相比之下，初始配置中的中间活细胞在下一代中获得了两个活邻居，左右各一个。

康威生命游戏

#!/usr/bin/perl

## A simple implementation of Conway's game of life.
# Usage: ./gol.pl [input file]  ;; If no file name given, DefaultInfile is used.

use constant Dead  => "-";
use constant Alive => "*";
use constant DefaultInfile => 'conway.in';

use strict;
use warnings;

my $dimension = undef;
my @matrix = ();
my $generation = 1;

sub read_data {
    my $datafile = DefaultInfile;
    $datafile = shift @ARGV if @ARGV;
    die "File $datafile does not exist.\n" if !-f $datafile;
    open(INFILE, "<$datafile");

    ## Check 1st line for dimension;
    $dimension = <INFILE>;
    die "1st line of input file $datafile not an integer.\n" if $dimension !~ /\d+/;

    my $record_count = 0;
    while (<INFILE>) {
        chomp($_);
        last if $record_count++ == $dimension;
        die "$_: bad input record -- incorrect length\n" if length($_) != $dimension;
        my @cells = split(//, $_);
        push @matrix, @cells;
    }
    close(INFILE);
    draw_matrix();
}

sub draw_matrix {
    my $n = $dimension * $dimension;
    print "\n\tGeneration $generation\n";
    for (my $i = 0; $i < $n; $i++) {
        print "\n\t" if ($i % $dimension) == 0;
        print $matrix[$i];
    }
    print "\n\n";
    $generation++;
}

sub has_left_neighbor {
    my ($ind) = @_;
    return ($ind % $dimension) != 0;
}

sub has_right_neighbor {
    my ($ind) = @_;
    return (($ind + 1) % $dimension) != 0;
}

sub has_up_neighbor {
    my ($ind) = @_;
    return (int($ind / $dimension)) != 0;
}

sub has_down_neighbor {
    my ($ind) = @_;
    return (int($ind / $dimension) + 1) != $dimension;
}

sub has_left_up_neighbor {
    my ($ind) = @_;
    return has_left_neighbor($ind) && has_up_neighbor($ind);
}

sub has_right_up_neighbor {
    my ($ind) = @_;
    return has_right_neighbor($ind) && has_up_neighbor($ind);
}

sub has_left_down_neighbor {
    my ($ind) = @_;
    return has_left_neighbor($ind) && has_down_neighbor($ind);
}

sub has_right_down_neighbor {
    my ($ind) = @_;
    return has_right_neighbor($ind) && has_down_neighbor($ind);
}

sub compute_cell {
    my ($ind) = @_;
    my @neighbors;

    # 8 possible neighbors
    push(@neighbors, $ind - 1) if has_left_neighbor($ind);
    push(@neighbors, $ind + 1) if has_right_neighbor($ind);
    push(@neighbors, $ind - $dimension) if has_up_neighbor($ind);
    push(@neighbors, $ind + $dimension) if has_down_neighbor($ind);
    push(@neighbors, $ind - $dimension - 1) if has_left_up_neighbor($ind);
    push(@neighbors, $ind - $dimension + 1) if has_right_up_neighbor($ind);
    push(@neighbors, $ind + $dimension - 1) if has_left_down_neighbor($ind);
    push(@neighbors, $ind + $dimension + 1) if has_right_down_neighbor($ind);

    my $count = 0;
    foreach my $n (@neighbors) {
        $count++ if $matrix[$n] eq Alive;
    }

    return Alive if ($matrix[$ind] eq Alive) && (($count == 2) || ($count == 3)); ## survival
    return Alive if ($matrix[$ind] eq Dead)  && ($count == 3);                    ## birth
    return Dead;                                                                  ## death
}

sub again_or_quit {
    print "RETURN to continue, 'q' to quit.\n";
    my $flag = <STDIN>;
    chomp($flag);
    return ($flag eq 'q') ? 1 : 0;
}

sub animate {
    my @new_matrix;
    my $n = $dimension * $dimension - 1;

    while (1) {                                       ## loop until user signals stop
        @new_matrix = map {compute_cell($_)} (0..$n); ## generate next matrix

        splice @matrix;                               ## empty current matrix
        push @matrix, @new_matrix;                    ## repopulate matrix
        draw_matrix();                                ## display the current matrix

        last if again_or_quit();                      ## continue?
        splice @new_matrix;                           ## empty temp matrix
    }
}

## Execute
read_data();  ## read initial configuration from input file
animate();    ## display and recompute the matrix until user tires

gol 程序（参见 康威生命游戏）有近 140 行代码，但其中大部分涉及读取输入文件、显示矩阵以及簿记任务，例如确定给定细胞的活邻居数量。输入文件应配置如下

 5
 -----
 --*--
 --*--
 --*--
 -----

第一个记录给出矩阵边长，在本例中为 5，表示 5x5 矩阵。其余行是内容，星号表示活细胞，空格表示死细胞。

主要感兴趣的代码驻留在两个函数 animate 和 compute_cell 中。animate 函数构造下一代，并且此函数需要对每个细胞调用 compute_cell，以确定细胞的新状态是活着还是死亡。animate 函数应该如何构造？

animate 函数有一个 while 循环，该循环迭代直到用户决定终止程序。在此 while 循环中，高级逻辑很简单

1. 通过迭代矩阵细胞来创建下一代，对每个细胞调用函数 compute_cell 以确定其新状态。问题是如何最好地进行迭代。当然，嵌套在 while 循环内的循环可以做到这一点，但嵌套循环可能很笨拙。另一种方法是使用高阶函数，稍后会阐明。
2. 用新矩阵替换当前矩阵。
3. 显示下一代。
4. 检查用户是否想要继续：如果是，则继续；否则，终止。

这里，为了回顾，是对 Perl 的高阶 map 函数的调用，该函数的名称再次是对 Lisp 的致敬。此调用作为 animate 中 while 循环内的第一个语句出现

while (1) {
    @new_matrix = map {compute_cell($_)} (0..$n); ## generate next matrix

map 函数接受两个参数：一个未命名的代码块（lambda 表达式！），以及一个值列表，这些值一次传递给此代码块一个。在本例中，代码块使用矩阵索引（0 到矩阵大小 - 1）之一调用 compute_cell 函数。虽然矩阵显示为二维，但它实现为一维列表。

高阶函数（如 map）鼓励 Perl 以代码简洁而闻名。我的观点是，此类函数也使代码更易于编写和理解，因为它们省去了循环的必需但混乱的细节。无论如何，lambda 表达式和高阶函数构成了 Perl 的 Lisp 风格。

如果您对更多细节感兴趣，我推荐 Mark Jason Dominus 的书《高阶 Perl》。