Write Yourself a Scheme in 48 Ho

原文。
https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/Towards_a_Standard_Library

现在我们的Scheme基本是完成了，但目前它还有点难以使用。至少，我们希望能够有一个标准的列表处理的函数库供我们使用来进行一些基本的计算操作。

与其使用一个传统的递归方式来实现Scheme中的列表函数，我们会首先定义两个基本的递归操作符（fold和unfold）然后在它们的基础上定义出我们的整个函数库。这是Haskell中Prelude库的风格：更加简洁的定义，更少出错的可能，使用fold在控制循环是很好的习惯。

我们从定义一些简单有用的辅助函数开始，我们将no和null函数通过if语句定义出来：

(define (not x)            (if x #f #t))
(define (null? obj)        (if (eqv? obj '()) #t #f))

我们可以通过可变参数的功能来定义list函数，它会将输入参数作为一个列表返回：

(define (list . objs)       objs)

我们还需要一个id函数，仅仅将输入参数完全不变的返回给我们。这虽然看起来好像完全没用-如果你已经持有这个值了，为什么还需要一个函数来将它再次返回给你呢？然而，我们需要的算法都会读取一个对给定值进行转换的函数作为参数。而通过定义id函数，我们能在调用那些高阶函数的时候达到不对值进行任何改变的效果。

(define (id obj)           obj)

类似的我们也同样需要flip函数来在传入参数顺序不对的时候允许我们进行调整：

(define (flip func)        (lambda (arg1 arg2) (func arg2 arg1)))

最后，我们添加curry和compose函数，它们会我们在Haskell里已经熟悉的概念完全一样（分别对应部分应用以及dot操作符的概念）。

(define (curry func arg1)  (lambda (arg) (apply func (cons arg1 (list arg)))))
(define (compose f g)      (lambda (arg) (f (apply g arg))))

再来一些Scheme标准库中应该包含的简单函数：

(define zero?              (curry = 0))
(define positive?          (curry < 0))
(define negative?          (curry > 0))
(define (odd? num)         (= (mod num 2) 1))
(define (even? num)        (= (mod num 2) 0))

这些定义基本上和想象中的一样。注意我们是怎么使用curry来定义zero?，positive?和negative?的。我们将curry返回的函数绑定给zero?，从而得到一个如果参数等于0就返回True的一元函数。

接下来，我们要定义一个能够捕获列表的基本递归形式的fold函数。最好的想象这个fold函数的方法就是以中缀构造的方式来思考整个列表：Haskell中是[1, 2, 3, 4] = 1:2:3:4:[]而Scheme中则是(1 . (2 . (3 . (4 . NIL))))。我们的fold函数会把每一个构造器都替换成一个二元操作符，然后把Nil替代成一个累计值。举例来说(fold + 0 '(1 2 3 4)) = (1 + (2 + (3 + (4 + 0))))。

有了以上的定义，我们就可以写出我们的fold函数了。首先通过右结合的方式来模拟上面的例子：

(define (foldr func end lst)
  (if (null? lst)
      end
      (func (car lst) (foldr func end (cdr lst)))))

这个函数基本上就完全模拟我们之前对它的定义。如果列表是空的，就用一个终止符取代它。如果不是，我们对列表的car部分以及剩余部分和一个end值一起被fold之后的结果应用这个函数。因为列表右侧的部分会首先被fold，因此这里你首先得到了一个右结合的fold函数。

同样我们也想要一个左结合的版本。对于大部分像+或是*这样的操作符，这两者是完全一样的。然而，我们至少有一个重要的二元操作符是没法这样结合的：cons。因此对于列表操作函数，我们需要在左右两种方式结合的fold中有所选择.

(define (foldl func accum lst)
  (if (null? lst)
      accum
      (foldl func (func accum (car lst)) (cdr lst))))

开头的部分和我们在右结合的时候一样，通过判断来决定是否直接将累计值返回。不过接下来有点不同，我们首先对累计值和列表的头元素应用我们的函数，而不是像之前那样分别对头元素和剩下元素fold的结果进行应用。这意味着我们这次会首先处理列表的头部部分，提供给了我们左结合的功能。当到达列表的结尾'()的时候，我们就将之前一路处理得到累计值作为结果返回。

注意传入两个fold的函数func读入参数的顺序是相反的。foldr中，累计值代表的是当前位置右边递归计算直到列表结束的结果。而在foldl中，它代表了列表左边部分已经完成了的计算。因此为了保证我们队操作符交换性能够有一个直观的认识，在foldl中累计值会作为函数的前一个参数，而在foldr中会作为后一个。

定义好了基本的fold函数，我们再根据它们在Scheme中的典型用途为它们定义一些别名：

(define fold foldl)
(define reduce foldr)

这里没有定义新函数，只是把定义过的函数绑定到了新的变量上。大部分Scheme会把fold称作reduce或是传统的fold，并且不对foldl和foldr进行区分。我们这里把它和foldl绑定，这里foldl是一个尾递归的函数因此它会比foldr的运行效率更高（它不需要在开始计算之前将整个列表递归展开）。但是不是所有操作都支持结合律的。我们接下来会看到几个需要使用foldr才能正确运行的例子。

接下来，我们来定义一个与fold相反的函数。读入一个一元函数，一个初始值和一个一元断言，它会不断将函数应用于之前的计算结果直到断言为真，然后将所有得到的计算值组成一个列表。

(define (unfold func init pred)
  (if (pred init)
      (cons init '())
      (cons init (unfold func (func init) pred))))

我们的函数一如既往的和上面给出的定义一致。如果断言得到True，那就将一个'()和最后的值cons起来，将列表终止。否则的话，将当前值和接下来的unfold结果值组合起来。

在学院派的函数式编程著作当中，folds一般会被称作catamorphisms，unfold则是anamorphisms，而它们两者的组合被叫做hylomorphisms。有趣的地方就是事实上所有for-each循环都可以以catamorphisms的形式表达。如果我们想要将一个循环转换成一个foldl形式，我们只需要把所有循环中会操作的变量组成一个数据结构就可以了（例如Record类型，或者你也可以自己专门定义一个代数类型）。我们把初始状态作为累计值；循环体作为传入fold的func参数，循环体中的变量是一个参数而被遍历的变量是第二个；最后，列表参数当然就是我们需要遍历的列表。fold函数最后计算的结果就是所有变量被更新后的状态。

相似的，所有for循环（没有事先存在的遍历对象）也都可以用hylomorphism来表示。初始值，终止值以及for循环中的每一步判断条件定义了一个产生数据列表的anamorphism来供我们遍历。接下来，你只需要把它当做一个for-each循环然后使用catamorphism 来将它分解并按照需要做你自己的计算并对状态进行更新就可以了。

先来看点例子。我们会从典型的sum，product，and和or函数开始：

(define (sum . lst)         (fold + 0 lst))
(define (product . lst)     (fold * 1 lst))
(define (and . lst)         (fold && #t lst))
(define (or . lst)          (fold || #f lst))

这里是它们的定义：

• (sum 1 2 3 4) = 1 + 2 + 3 + 4 + 0 = (fold + 0 '(1 . (2 . (3 . (4 . NIL)))))
• (product 1 2 3 4) = 1 * 2 * 3 * 4 * 1 = (fold * 1 '(1 . (2 . (3 . (4 . NIL)))))
• (and #t #t #f) = #t && #t && #f && #t = (fold && #t '(#t . (#t . (#f . NIL))))
• (or #t #t #f) = #t || #t || #f || #f = (fold || #f '(#t . (#t . (#f . NIL))))

因为所有操作符都满足结合律，因此它不在乎我们是使用foldr还是foldl。我们将cons替换为操作符，将Nil替换为操作符的幺元。

接下来，试试看一些更加复杂的操作符。max和min会分别将它们传入参数中的最大和最小值找出来：

(define (max first . rest) (fold (lambda (old new) (if (> old new) old new)) first rest))
(define (min first . rest) (fold (lambda (old new) (if (< old new) old new)) first rest))

这里似乎没办法一眼看清楚到底我们对整个列表fold了什么操作，因为似乎并没有任何比较合适的内置函数。这里我们将fold想象成foreach循环的一种形式。累计值可以代表我们在循环的上一次迭代中的任意状态，因此我们这里把它当做目前为止发现的最大值。它的初始值就应该是整个列表的最左边的元素（因为我们使用的是foldl）。注意我们的操作的结果是会变成下一步的累计值的，所以我们就这样定义传入的函数。如果前一个值更大那就保留它，而如果后一个值更大或是它们是相等的，那就返回新的值。min函数则是与之相反的过程。

length函数怎么样？我们知道我们可以通过累加的方式来求出一个列表的长度，那么我们怎么用fold的形式来表达它呢：

(define (length lst)        (fold (lambda (x y) (+ x 1)) 0 lst))

同样我们把这个定义想象成一个循环。累计从0开始，然后没迭代一次就增加1。因此我们得到了初始值0以及需要传入fold的函数(lambda (x y) (+ x 1))。另一种思考的方式就是“列表的的长度就是1加上它当前位置以左部分的子串的长度”。

让我们来看点有趣的：reverse函数：

(define (reverse lst)       (fold (flip cons) '() lst))

这个函数这里就非常明显了：如果你想要翻转两个cons单元，你只需要使用flip函数，这样它们就会将参数调换到相反的位置。然而，实际这里有一个很巧妙的地方。普通列表都是右结合的：(1 2 3 4) = (1 . (2 . (3 . (4 . NIL))))。如果你想要将它翻转，你需要让你的fold能够支持左结合(reverse '(1 2 3 4)) = (4 . (3 . (2 . (1 . NIL))))。用foldr代替foldl试试看你会得到什么。

接下来是一大堆member和assoc函数，它们都可以用fold的形式来定义。虽然它们需要的lambda表达式都有点复杂，让我们来提取它们中的规律：

(define (mem-helper pred op) (lambda (acc next) (if (and (not acc) (pred (op next))) next acc)))
(define (memq obj lst)       (fold (mem-helper (curry eq? obj) id) #f lst))
(define (memv obj lst)       (fold (mem-helper (curry eqv? obj) id) #f lst))
(define (member obj lst)     (fold (mem-helper (curry equal? obj) id) #f lst))
(define (assq obj alist)     (fold (mem-helper (curry eq? obj) car) #f alist))
(define (assv obj alist)     (fold (mem-helper (curry eqv? obj) car) #f alist))
(define (assoc obj alist)    (fold (mem-helper (curry equal? obj) car) #f alist))

这里我们让辅助函数能够读取一个断言和一个会对结果进行操作的函数作为参数。它的累计值代表着当前第一个被找到的匹配值：它的初始值是#f并且会变成列表中第一个满足断言的值。我们通过一个非#f的判断来避免找到后续的值从而让它在累计值已经被设置之后直接将当前值返回。我们还提供了一个在断言检测时每次都会应用到next值的操作：这让我们可以自定义我们的mem-helper函数来选择是检查值本身（member函数）or是只是检查键（assoc函数）。

剩下的部分就只是各种eq?，eqv?，equal？，id和car的组合将整个列表从#f开始fold起来的过程了。

接下来我们来定义map和filter函数。map会将函数应用到列表里的每一个元素，然后返回一个由被转换后的元素组成的列表：

(define (map func lst)      (foldr (lambda (x y) (cons (func x) y)) '() lst))

需要记住foldr的函数首先读取的参数是当前的迭代值，这是和fold不同的。Map函数中的lambda表达式会首先将函数应用于当前值，然后再讲它的结果和剩下部分的map之后的列表组合起来。这本质上来说就是将所有的中缀cons构造器都替代成一个，然后再将函数对cons左边的参数进行应用。

filter函数会将列表里满足条件的元素留下来，然后丢弃掉其它的：

(define (filter pred lst)   (foldr (lambda (x y) (if (pred x) (cons x y) y)) '() lst))

它会将每个值代入断言里计算然后如果结果为True，用cons代替cons，即什么也不做。如果是False，将cons丢弃掉，仅仅将列表剩下的部分返回。这样我们就删除掉了列表中所有不满足断言的元素，然后用cons将剩下满足的元素组成一个新的列表。

我们可以在Lisp解释器启动以后通过(load "stdlib.scm")来加载我们的标准库：

$ ./lisp
Lisp>>> (load "stdlib.scm")
(lambda ("pred" . lst) ...)
Lisp>>> (map (curry + 2) '(1 2 3 4))
(3 4 5 6)
Lisp>>> (filter even? '(1 2 3 4))
(2 4)
Lisp>>> quit

标准库里还有很多其他有用的函数，例如list-tail，list-ref，append以及其他字符串操作函数。尝试着通过folds来实现它们。记住，基于fold的编程成功的关键就是以迭代为单位进行思考。我们通过fold来捕捉列表中的递归的模式，然后一次一步的解决这个递归。