Scheme入门教程

前言

虽然目前因为scheme过时，最新的SICP已经采用python作为系列语言，但是通过前两章的学习，可以说，Scheme（lisp方言）是一门充满魅力的语言，而且在之前有过关于用C设计lisp语言的学习，都用C写出来了lisp结果不熟悉lisp未免来说过于尴尬，因此决定恶补一下scheme。

四种基本算术操作

Scheme（以及大多数Lisp方言）都可以处理分数。

函数exact->inexact 用于把分数转换为浮点数。Scheme也可以处理复数。复数是形如a+bi的数，此处a称为实部，b称为虚部。+、-、*和/分别代表加、减、乘、除。这些函数都接受任意多的参数。

例：

(- 10 3)    ;→ 7
(- 10 3 5)  ;→ 2
(* 2 3)     ;→ 6
(* 2 3 4)   ;→ 24
(/ 29 3)    ;→ 29/3
(/ 29 3 7)  ;→ 29/21
(/ 9 6)     ;→ 3/2
(exact->inexact (/ 29 3 7)) ;→ 1.380952380952381

括号可以像下面这样嵌套：

(* (+ 2 3) (- 5 3)) ;→ 10
(/ (+ 9 1) (+ 2 3)) ;→ 2

形如这些由括号、标记（token）以及分隔符组成的式子，被称为S-表达式。

其它算术操作

quotient，remainder，modulo和sqrt

• 函数quotient用于求商数（quotient）。
• 函数remainder和modulo用于求余数（remainder）。
• 函数sqrt用于求参数的平方根（square root）。

(quotient 7 3) ;→ 2
(modulo 7 3)   ;→ 1
(sqrt 8)       ;→ 2.8284271247461903

三角函数

数学上的三角函数，诸如sin，cos，tan，asin，acos和atan都可以在Scheme中使用。atan接受1个或2个参数。如果atan的参数为1/2 π，那么就要使用两个参数来计算。

(atan 1)   ;→ 0.7853981633974483
(atan 1 0) ;→ 1.5707963267948966

指数和对数

指数通过exp函数运算，对数通过log函数运算。a的b次幂可以通过(expt a b)来计算。

生成表

作为Lisp语言大家族的一员，Scheme同样擅长于处理表。表在在后面章节中的递归函数和高阶函数中扮演重要角色。在本章中会讲解基本的表操作，例如cons，car，cdr，list和quote。

Cons单元和表

Cons单元

首先，让我解释一下表的元素：Cons单元（Cons cells）。Cons单元是一个存放了两个地址的内存空间。Cons单元可用函数cons生成。

在前端输入(cons 1 2)

(cons 1 2)

系统返回(1 . 2)。如图一所示，函数cons给两个地址分配了内存空间，并把存放指向1的地址放在一个空间，把存放指向2的地址放在另一个空间。存放指向1的地址的内存空间被称作car部分，对应的，存放指向2的地址的内存空间被称作cdr部分。car和cdr分别是寄存器地址部分（Contents of the Address part of the Register）和寄存器减量部分（Contents of the Decrement part of the Register）的简称。这些名字最初来源于Lisp首次被实现所使用的硬件环境中内存空间的名字。这些名字同时也表明Cons单元的本质就是一个内存空间。cons这个名字是术语构造（construction）的简称。

Cons单元也可以被串起来。

(cons 3 (cons 1 2))

这种情况的内存空间如图2所示。

Cons单元可以存放不同类型的数据也可以嵌套。

(cons #\a (cons 3 "hello"))
;Value 17: (#\a 3 . "hello")

(cons (cons 0 1) (cons 2 3))
;Value 23: ((0 . 1) 2 . 3)

这是因为Scheme可以通过地址操作所有的数据。（#\c代表了一个字符c。例如，#\a就代表字符a）

表

表是Cons单元通过用cdr部分连接到下一个Cons单元的开头实现的。表中包含的’()被称作空表。就算数据仅由一个Cons单元组成，只要它的cdr单元是’()，那它就是一个表。图3展示了表(1 2 3)的内存结构。

事实上，表可以像下面这样递归地定义：

1. ‘()是一个表
2. 如果ls是一个表且obj是某种类型的数据，那么(cons obj ls)也是一个表 正因为表是一种被递归定义的数据结构，将它用在递归的函数中显然是合理的。

###原子

不使用Cons单元的数据结构称为原子（atom）。数字，字符，字符串，向量和空表’()都是原子。’()既是原子，又是表。

引用

所有的记号都会依据Scheme的求值规则求值：所有记号都会从最内层的括号依次向外层括号求值，且最外层括号返回的值将作为S-表达式的值。一个被称为引用（quote）的形式可以用来阻止记号被求值。它是用来将符号或者表原封不动地传递给程序，而不是求值后变成其它的东西。

例如，(+ 2 3)会被求值为5，然而(quote (+ 2 3))则向程序返回(+ 2 3)本身。因为quote的使用频率很高，他被简写为’。

比如：

• ’(+ 2 3)代表列表(+ 2 3)本身；
• ’+代表符号+本身；

实际上，’()是对空表的引用，也就是说，尽管解释器返回()代表空表，你也应该用’()来表示空表。

特殊形式

Scheme有两种不同类型的操作符：其一是函数。函数会对所有的参数求值并返回值。另一种操作符则是特殊形式。特殊形式不会对所有的参数求值。除了quote，lambda，define，if，set!，等都是特殊形式。

car函数和cdr函数

返回一个Cons单元的car部分和cdr部分的函数分别是car和cdr函数。如果cdr部分串连着Cons单元，解释器会打印出整个cdr部分。如果Cons单元的cdr部分不是’()，那么其值稍后亦会被展示。

(car '(1 2 3 4))
;Value: 1

(cdr '(1 2 3 4))
;Value 18: (2 3 4)

list函数

list函数使得我们可以构建包含数个元素的表。函数list有任意个数的参数，且返回由这些参数构成的表。

(list)
;Value: ()

(list 1)
;Value 24: (1)

(list '(1 2) '(3 4))
;Value 25: ((1 2) (3 4))

(list 0)
;Value 26: (0)

(list 1 2)
;Value 27: (1 2)

定义函数

由于Sheme是函数式编程语言，你需要通过编写小型函数来构造程序。因此，明白如何构造并组合这些函数对掌握Scheme尤为关键。

你可以使用define来将一个符号与一个值绑定。你可以通过这个操作符定义例如数、字符、表、函数等任何类型的全局参数。

; Hello world as a variable
(define vhello "Hello world")     ;1

; Hello world as a function
(define fhello (lambda ()         ;2
         "Hello world"))

操作符define用于声明变量，它接受两个参数。define运算符会使用第一个参数作为全局参数，并将其与第二个参数绑定起来。因此，代码片段1的第1行中，我们声明了一个全局参数vhello，并将其与"Hello，World"绑定起来。

紧接着，在第2行声明了一个返回“Hello World”的过程。

特殊形式lambda用于定义过程。lambda需要至少一个的参数，第一个参数是由定义的过程所需的参数组成的表。因为本例fhello没有参数，所以参数表是空表。

在解释器中输入vhello，解释器返回“Hello，World”。如果你在解释器中输入fhello，它也会返回像下面这样的值：#[compound-procedure 16 fhello]，这说明了Scheme解释器把过程和常规数据类型用同样的方式对待。正如我们在前面章节中讲解的那样，Scheme解释器通过内存空间中的数据地址操作所有的数据，因此，所有存在于内存空间中的对象都以同样的方式处理。

如果把fhello当过程对待，你应该用括号括住这些符号，比如(fhello)。

然后解释器会按照第二章讲述的规则那样对它求值，并返回“Hello World”。

定义有参数的函数

可以通过在lambda后放一个参数表来定义有参数的函数。

; hello with name
(define hello
  (lambda (name)
    (string-append "Hello " name "!")))

; sum of three numbers
(define sum3
  (lambda (a b c)
    (+ a b c)))

函数hello有一个参数(name)，并会把“Hello”、name的值、和"!"连结在一起并返回。

预定义函数string-append可以接受任意多个数的参数，并返回将这些参数连结在一起后的字符串。

sum3：此函数有三个参数并返回这三个参数的和。

一种函数定义的短形式

用lambda定义函数是一种规范的方法，但你也可以使用类似于代码片段3中展示的短形式。

; hello with name
(define (hello name)
  (string-append "Hello " name "!"))


; sum of three numbers
(define (sum3 a b c)
  (+ a b c))

在这种形式中，函数按照它们被调用的形式被定义。代码片段2和代码片段3都是相同的。有些人不喜欢这种短形式的函数定义，但是在教程中使用这种形式，因为它可以使代码更短小。

分支

简介

本章会讲解如何通过条件编写过程。这个是编写使用程序很重要的一步。

if表达式

if表达式将过程分为两个部分。if的格式如下：

(if predicate then_value else_value)

如果predicate部分为真，那么then_value部分被求值，否则else_value部分被求值，并且求得的值会返回给if语句的括号外。true是除false以外的任意值，true使用#t表示，false用#f表示。

在R5RS中，false（#f）和空表（’()）是两个不同的对象。然而，在MIT-Scheme中，这两个为同一对象。这个不同可能是历史遗留问题，在以前的标准——R4RS中，#f和’()被定义为同一对象。

因此，从兼容性角度考虑，你不应该使用表目录作为谓词。使用函数null?来判断表是否为空。

(null? '())
;Value: #t

(null? '(a b c))
;Value: ()   ;#f

函数not可用于对谓词取反。此函数只有一个参数且如果参数值为#f则返回#t，反之，参数值为#t则返回#f。if表达式是一个特殊形式，因为它不对所有的参数求值。因为如果predicate为真，则只有then_value部分被求值。另一方面，如果predicate为假，只有else_value部分被求值。

例：首项为a0，增长率r，项数为n的几何增长（geometric progression）数列之和

(define (sum-gp a0 r n)
  (* a0
     (if (= r 1)
         n
         (/ (- 1 (expt r n)) (- 1 r)))))   ; !!

通常来说，几何增长数列的求和公式如下：

a0 * (1 - r^n) / (1 - r)                      (r ≠ 1)
a0 * n                                        (r = 1)

如果if表达式对所有参数求值的话，那么有;!!注释的那行就算在r=1时也会被求值，这将导致产生一个“除数为0”的错误。

你也可以省去else_value项。这样的话，当predicate为假时，返回值就没有被指定。如果你希望当predicate为假时返回#f，那么就要明确地将它写出来。

then_value和else_value都应该是S-表达式。如果你需要副作用，那么就应该使用begin表达式。我们将在下一章讨论begin表达式。

and和or

and和or是用于组合条件的两个特殊形式。Scheme中的and和or不同于C语言中的约定。它们不返回一个布尔值（#t或#f），而是返回给定的参数之一。and和or可以使你的代码更加短小。

and

and具有任意个数的参数，并从左到右对它们求值。如果某一参数为#f，那么它就返回#f，而不对剩余参数求值。反过来说，如果所有的参数都不是#f，那么就返回最后一个参数的值。

(and #f 0)
;Value: ()

(and 1 2 3)
;Value: 3

(and 1 2 3 #f)
;Value: ()

or

or具有可变个数的参数，并从左到右对它们求值。它返回第一个不是值#f的参数，而余下的参数不会被求值。如果所有的参数的值都是#f的话，则返回最后一个参数的值。

(or #f 0)
;Value: 0

(or 1 2 3)
;Value: 1

(or #f 1 2 3)
;Value: 1

(or #f #f #f)
;Value: ()

cond表达式

尽管所有的分支都可以用if表达式表达，但当条件有更多的可能性时，你就需要使用嵌套的if表达式了，这将使代码变得复杂。处理这种情况可以使用cond表达式。cond表达式的格式如下：

(cond
  (predicate_1 clauses_1)
  (predicate_2 clauses_2)
    ......
  (predicate_n clauses_n)
  (else        clauses_else))

在cond表达式中，predicates_i是按照从上到下的顺序求值，而当predicates_i为真时，clause_i会被求值并返回。i之后的predicates和clauses不会被求值。如果所有的predicates_i都是假的话，则返回cluase_else。在一个子句中，你可以写数条S-表达式，而clause的值是最后一条S-表达式。

例：城市游泳池的收费。

Foo市的城市游泳池按照顾客的年龄收费：

如果 age ≤ 3 或者 age ≥ 65 则 免费；
如果 介于 4 ≤ age ≤ 6 则 0.5美元；
如果 介于 7 ≤ age ≤ 12 则 1.0美元；
如果 介于 13 ≤ age ≤ 15 则 1.5美元；
如果 介于 16 ≤ age ≤ 18 则 1.8美元；
其它 则 2.0美元；

那么，一个返回城市游泳池收费的函数如下：

(define (fee age)
  (cond
   ((or (<= age 3) (>= age 65)) 0)
   ((<= 4 age 6) 0.5)
   ((<= 7 age 12) 1.0)
   ((<= 13 age 15) 1.5)
   ((<= 16 age 18) 1.8)
   (else 2.0)))

做出判断的函数

将介绍一些用于做判断的函数。这些函数的名字都以'?'结尾。

eq?、eqv?和equal?

基本函数eq?、eqv?、equal?具有两个参数，用于检查这两个参数是否“一致”。这三个函数之间略微有些区别。

eq?
该函数比较两个对象的地址，如果相同的话就返回#t。例如，(eq? str str)返回#t，因为str本身的地址是一致的。与此相对的，因为字符串”hello”和”hello”被储存在了不同的地址中，函数将返回#f。不要使用eq?来比较数字，因为不仅在R5RS中，甚至在MIT-Scheme实现中，它都没有指定返回值。使用eqv?或者=替代。

(define str "hello")
;Value: str

(eq? str str)
;Value: #t

(eq? "hello" "hello")
;Value: ()             ← It should be #f in R5RS 

;;; comparing numbers depends on implementations
(eq? 1 1)
;Value: #t

(eq? 1.0 1.0)
;Value: ()

eqv?
该函数比较两个存储在内存中的对象的类型和值。如果类型和值都一致的话就返回#t。对于过程（lambda表达式）的比较依赖于具体的实现。这个函数不能用于类似于表和字符串一类的序列比较，因为尽管这些序列看起来是一致的，但它们的值是存储在不同的地址中。

(eqv? 1.0 1.0)
;Value: #t

(eqv? 1 1.0)
;Value: ()

;;; don't use it to compare sequences
(eqv? (list 1 2 3) (list 1 2 3))
;Value: ()

(eqv? "hello" "hello")
;Value: ()

;;; the following depends on implementations
(eqv? (lambda(x) x) (lambda (x) x))
;Value: ()

equal?
该函数用于比较类似于表或者字符串一类的序列。

(equal? (list 1 2 3) (list 1 2 3))
;Value: #t

(equal? "hello" "hello")
;Value: #t

用于检查数据类型的函数

下面列举了几个用于检查类型的函数。这些函数都只有一个参数。

• pair? 如果对象为序对则返回#t；
• list? 如果对象是一个表则返回#t。要小心的是空表’()是一个表但是不是一个序对。
• null? 如果对象是空表’()的话就返回#t。
• symbol? 如果对象是一个符号则返回#t。
• char? 如果对象是一个字符则返回#t。
• string? 如果对象是一个字符串则返回#t。
• number? 如果对象是一个数字则返回#t。
• complex? 如果对象是一个复数则返回#t。
• real? 如果对象是一个实数则返回#t。
• rational? 如果对象是一个有理数则返回#t。
• integer? 如果对象是一个整数则返回#t。
• exact? 如果对象不是一个浮点数的话则返回#t。
• inexact? 如果对象是一个浮点数的话则返回#t。

用于比较数的函数

=、>、<、<=、>=
这些函数都有任意个数的参数。如果参数是按照这些函数的名字排序的话，函数就返回#t。

(= 1 1 1.0)
;Value: #t

(< 1 2 3)
;Value: #t
(< 1)
;Value: #t
(<)
;Value: #t

(= 2 2 2)
;Value: #t

(< 2 3 3.1)
;Value: #t

(> 4 1 -0.2)
;Value: #t

(<= 1 1 1.1)
;Value: #t

(>= 2 1 1.0)
;Value: #t

(< 3 4 3.9)
;Value: ()

odd?、even?、positive?、negative?、zero?
这些函数仅有一个参数，如果这些参数满足函数名所指示的条件话就返回#t。

用于比较符号的函数

在比较字符的时候可以使用char=?、char<?、char>?、char<=?以及char>=?函数。具体的细节请参见R5RS。

用于比较字符串的函数

比较字符串时，可以使用string=?和string-ci=?等函数。具体细节请参见R5RS。

局部变量

let表达式

使用let表达式可以定义局部变量。格式如下：

(let binds body)

变量在binds定义的形式中被声明并初始化。body由任意多个S-表达式构成。binds的格式如下：

[binds] → ((p1 v1) (p2 v2) ...)

声明了变量p1、p2，并分别为它们赋初值v1、v2。变量的作用域（Scope）为body体，也就是说变量只在body中有效。

例1：声明局部变量i和j，将它们与1、2绑定，然后求二者的和。

(let ((i 1) (j 2))
  (+ i j))
;Value: 3

let表达式可以嵌套使用。

例2：声明局部变量i和j，并将分别将它们与1和i+2绑定，然后求它们的乘积。

(let ((i 1))
  (let ((j (+ i 2)))
    (* i j)))
;Value: 3

由于变量的作用域仅在body中，下列代码会产生错误，因为在变量j的作用域中没有变量i的定义。

(let ((i 1) (j (+ i 2)))
  (* i j))
;Error

let*表达式可以用于引用定义在同一个绑定中的变量。实际上，let*只是嵌套的let表达式的语法糖而已。

(let* ((i 1) (j (+ i 2)))
  (* i j))
;Value: 3

例3：函数quadric-equation用于计算二次方程。它需要三个代表系数的参数：a、b、c （ax^2 + bx + c = 0），返回一个存放答案的实数表。通过逐步地使用let表达式，可以避免不必要的计算。

;;;The scopes of variables d,e, and f are the regions with the same background colors.

(define (quadric-equation a b c)
  (if (zero? a)      
      'error                                      ; 1
      (let ((d (- (* b b) (* 4 a c))))            ; 2
        (if (negative? d)
            '()                                      ; 3
            (let ((e (/ b a -2)))                    ; 4
              (if (zero? d)
              (list e)
              (let ((f (/ (sqrt d) a 2)))        ; 5
                (list (+ e f) (- e f)))))))))

(quadric-equation 3 5 2)  ; solution of 3x^2+5x+2=0
;Value 12: (-2/3 -1)

实际上，let表达式只是lambda表达式的一个语法糖：

(let ((p1 v1) (p2 v2) ...) exp1 exp2 ...)
;⇒
((lambda (p1 p2 ...)
    exp1 exp2 ...) v1 v2)

这是因为lambda表达式用于定义函数，它为变量建立了一个作用域。也就是闭包的概念

重复

简介

Scheme中通常通过递归实现重复，而不是循环。

递归

在自己的定义中调用自己的函数叫做递归函数（Recursive Function）。虽然这听起来很奇怪，但是循环的常见方法。如果你把函数类比为机器的话，递归似乎毫无道理。然而，正因为函数是过程，函数调用自己是有意义的。比如说，让我们来考察一下文献调研吧。你可能需要去阅读你正在阅读的文献所引用的文献（cited-1）。进一步，你可能还需要去阅读文件（cite-1）所引用的其它文献。这样，文献调研就是一个递归的过程，你也可以重复这个调研过程直到满足了特定条件（比如说，你累了）。这样，将程序设计语言中的函数类比为人类活动（比如文献调研）将有助于理解递归函数。

我们通常使用计算阶乘来解释递归。

(define (fact n)
  (if (= n 1)
      1
      (* n (fact (- n 1)))))

(fact 5)的计算过程如下：

(fact 5)
⇒ 5 * (fact 4)
⇒ 5 * 4 * (fact 3)
⇒ 5 * 4 * 3 * (fact 2)
⇒ 5 * 4 * 3 * 2 * (fact 1)
⇒ 5 * 4 * 3 * 2 * 1
⇒ 5 * 4 * 3 * 2
⇒ 5 * 4 * 6
⇒ 5 * 24
⇒ 120

(fact 5)调用(fact 4)，(fact 4)调用(fact 3)，最后(fact 1)被调用。(fact 5)，(fact 4)……以及(fact 1)都被分配了不同的存储空间，直到(fact (- i 1))返回一个值之前，(fact i)都会保留在内存中，由于存在函数调用的开销，这通常会占用更多地内存空间和计算时间。

然而，递归函数可以以一种简单的方式表达重复。表是被递归定义的，进而表和递归函数可以很好地配合。例如，一个让表中所有元素翻倍的函数可以像下面这样写。如果参数是空表，那么函数应该停止计算并返回一个空表。

(define (list*2 ls)
  (if (null? ls)
      '()
      (cons (* 2 (car ls))
             (list*2 (cdr ls)))))

尾递归

普通的递归调用并不高效因为它既浪费存储空间又具有函数调用开销。与之相反，尾递归函数包含了计算结果，当计算结束时直接将其返回。特别地，由于Scheme规范要求尾递归调用转化为循环，因此尾递归调用就不存在函数调用开销。

[代码片段2]展示了[代码片段1]中函数fact的尾递归版本。

(define (fact-tail n)
  (fact-rec n n))

(define (fact-rec n p)
  (if (= n 1)
      p
      (let ((m (- n 1)))
    (fact-rec m (* p m)))))

fact-tail计算阶乘的过程像这样：

(fact-tail 5)
⇒ (fact-rec 5 5)
⇒ (fact-rec 4 20)
⇒ (fact-rec 3 60)
⇒ (fact-rec 2 120)
⇒ (fact-rec 1 120)
⇒ 120

因为fact-rec并不等待其它函数的计算结果，因此当它计算结束时即从内存中释放。计算通过修改fact-rec的参数来演进，这基本上等同于循环。如上文所述，Scheme将尾递归转化为循环，Scheme就无需提供循环的语法来实现重复。

命名let

命名let（named let）可以用来表达循环。[代码片段3]中的函数fact-let展示了如何使用命名let来计算阶乘。fact-let函数使用了一个命名let表达式(loop)，这与在[代码片段2]中展示的fact-rec函数是不同的。在被注释为;1的那行，代码将参数n1和p都初始化为n。再每次循环后，参数在被注释为;2的那行更新：将n1减1，而将p乘以(n1 - 1)。

在Scheme中，用命名let来表达循环是俗成的方法。

(define (fact-let n)
  (let loop((n1 n) (p n))           ; 1
    (if (= n1 1)                    
    p
    (let ((m (- n1 1)))
      (loop m (* p m))))))      ; 2

letrec

letrec类似于let，但它允许一个名字递归地调用它自己。语法letrec通常用于定义复杂的递归函数。[代码片段4]展示了fact函数的letrec版本。

(define (fact-letrec n)
  (letrec ((iter (lambda (n1 p)
           (if (= n1 1)
               p
               (let ((m (- n1 1)))
             (iter m (* p m)))))))     ; *
    (iter n n)))

正如被注释为;*的那行代码所示，局部变量iter可以在它的定义里面引用它自己。语法letrec是定义局部变量的俗成方式。

do表达式

虽然并不常见，但语法do也可用于表达重复。它的格式如下：

(do binds (predicate value)
    body)

变量在binds部分被绑定，而如果predicate被求值为真，则函数从循环中逃逸（escape）出来，并返回值value，否则循环继续进行。

binds部分的格式如下所示：

[binds] → ((p1 i1 u1) (p2 i2 u2) ... )

变量p1，p2，…被分别初始化为i1，i2，…并在循环后分别被更新为u1，u2，…。

[代码片段5]演示了fact的do表达式版本。

(define (fact-do n)
  (do ((n1 n (- n1 1)) (p n (* p (- n1 1)))) ((= n1 1) p)))

变量n1和p分别被初始化为n和n，在每次循环后分别被减去1和乘以(n1 - 1)。当n1变为1时，函数返回p。

高阶函数

简介

高阶函数（Higher Order Function）是一种以函数为参数的函数。它们都被用于映射（mapping）、过滤（filtering）、归档（folding）和排序（sorting）表。高阶函数提高了程序的模块性。编写对各种情况都适用的高阶函数与为单一情况编写递归函数相比，可以使程序更具可读性。比如说，使用一个高阶函数来实现排序可以使得我们使用不同的条件来排序，这就将排序条件和排序过程清楚地划分开来。函数sort具有两个参数，其一是一个待排序的表，其二是定序（Ordering）函数。下面展示了按照大小将一个整数表正序排序。<函数就是（本例中的）两数的定序函数。

(sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239) <)
;⇒  (2239 2644 2828 2958 4179 5340 6729 7754 7883 9099)

另一方面，按照每个数末两位的大小排序可以按下面的方式实现：

(sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239) 
      (lambda (x y) (< (modulo x 100) (modulo y 100))))
;⇒  (2828 6729 2239 5340 2644 7754 2958 4179 7883 9099)

正如这里所演示的，像快速排序（Quick Sort）、归并排序（Merge Sort）等排序过程，将定序函数完全分离开来提高了代码的复用性。

在本节中，将讲解预定义的高阶函数，然后介绍如何定义高阶函数。由于Scheme并不区别过程和其它的数据结构，因此你可以通过将函数当作参数传递轻松的定义自己的高阶函数。

实际上，Scheme中预定义函数的本质就是高阶函数，因为Scheme并没有定义块结构的语法，因此使用lambda表达式作为一个块。

映射

映射是将同样的行为应用于表所有元素的过程。R5RS定义了两个映射过程：其一为返回转化后的表的map过程，另一为注重副作用的for-each过程。

map

map过程的格式如下：

(map procedure list1 list2 ...)

procedure是个与某个过程或lambda表达式相绑定的符号。作为参数的表的个数视procedure需要的参数而定。

例：

; Adding each item of '(1 2 3) and '(4 5 6).
(map + '(1 2 3) '(4 5 6))
;⇒  (5 7 9)

; Squaring each item of '(1 2 3)
(map (lambda (x) (* x x)) '(1 2 3))
;⇒  (1 4 9)

for-each

for-each的格式与map一致。但for-each并不返回一个具体的值，只是用于副作用。

例：

(define sum 0)
(for-each (lambda (x) (set! sum (+ sum x))) '(1 2 3 4))
sum
;⇒  10

过滤

尽管过滤函数并没有在R5RS中定义，但MIT-Scheme实现提供了keep-matching-items和delete-matching-item两个函数。其它实现中应该有类似的函数。

(keep-matching-items '(1 2 -3 -4 5) positive?)
;⇒  (1 2 5)

归档

尽管在R5RS中没有定义归档函数，但MIT-Scheme提供了reduce等函数。

(reduce + 0 '(1 2 3 4))                 ;⇒  10
(reduce + 0 '(1 2))                     ;⇒  3
(reduce + 0 '(1))                       ;⇒  1
(reduce + 0 '())                        ;⇒  0
(reduce + 0 '(foo))                     ;⇒  foo
(reduce list '() '(1 2 3 4))            ;⇒  (((1 2) 3) 4)

排序

尽管R5RS中没有定义排序函数，但MIT-Scheme提供了sort（实为merge-sort实现）和quick-sort函数。

(sort '(3 5 1 4 -1) <)
;⇒  (-1 1 3 4 5)

apply函数

apply函数是将一个过程应用于一个表（译注：将表展开，作为过程的参数）。此函数具有任意多个参数，但首参数和末参数分别应该是一个过程和一个表。虽然乍看之下不然，但这个函数的确非常方便。

(apply max '(1 3 2))      ;⇒   3
(apply + 1 2 '(3 4 5))    ;⇒  15
(apply - 100 '(5 12 17))  ;⇒  66

编写高阶函数

自己编写高阶函数非常容易。这里用member-if、member演示。

member-if和member

member-if函数使用一个谓词和一个表作为参数，返回一个子表，该子表的car部分即是原列表中首个满足该谓词的元素。member-if函数可以像下面这样定义：

(define (member-if proc ls)
  (cond
   ((null? ls) #f)
   ((proc (car ls)) ls)
   (else (member-if proc (cdr ls)))))

(member-if positive? '(0 -1 -2 3 5 -7))
;⇒  (3 5 -7)

接下来，member函数检查特定元素是否在表中，该函数编写如下。函数需要三个参数，其一为用于比较的函数，其二为特定项，其三为待查找表。

(define (member proc obj ls)
  (cond
   ((null? ls) #f)
   ((proc obj (car ls)) ls)
   (else (member proc obj (cdr ls)))))

(member string=? "hello" '("hi" "guys" "bye" "hello" "see you"))
;⇒  ("hello" "see you")

输入/输出

简介

通过前面章节的学习，你已经可以在Scheme的交互式前端中编写并执行程序了。在本章中，我讲介绍如何输入和输出。使用这个特性，你可以从文件中读取数据或向文件中写入数据。

从文件输入

open-input-file，read-char和eof-object?

函数(open-input-file filename)可以用于打开一个文件。此函数返回一个用于输入的端口。函数(read-char port)用于从端口中读取一个字符。当读取到文件结尾（EOF）时，此函数返回eof-object，你可以使用eof-object?来检查。函数(close-input-port port)用于关闭输入端口。[代码片段1]展示了一个函数，该函数以字符串形式返回了文件内容。

(define (read-file file-name)
  (let ((p (open-input-file file-name)))
    (let loop((ls1 '()) (c (read-char p)))
      (if (eof-object? c)
      (begin
        (close-input-port p)
        (list->string (reverse ls1)))
      (loop (cons c ls1) (read-char p))))))

比如，在[范例1]中展示的结果就是将[代码片段1]应用于文件hello.txt。由于换行符是由'\n'表示的，这就很容易阅读。然而，像格式化输出[范例2]，我们也可使用display函数。

Hello world!
Scheme is an elegant programming language.

语法call-with-input-file和with-input-from-file

你通过使用语法call-with-input-file和with-input-from-file来打开文件以供读取输入。这些语法是非常方便的，因为它们要处理错误。

(call-with-input-file filename procedure)

该函数将名为filename的文件打开以供读取输入。函数procedure接受一个输入端口作为参数。文件有可能再次使用，因此当procedure结束时文件不会自动关闭，文件应该显式地关闭。[代码片段1]可以按照[代码片段2]那样用call-with-input-file编写。

(define (read-file file-name)
  (call-with-input-file file-name
    (lambda (p)
      (let loop((ls1 '()) (c (read-char p)))
    (if (eof-object? c)
        (begin
          (close-input-port p)
          (list->string (reverse ls1)))
        (loop (cons c ls1) (read-char p)))))))

(with-input-from-file filename procedure) 该函数将名为filename的文件作为标准输入打开。函数procedure不接受任何参数。当procedure退出时，文件自动被关闭。[代码片段3]展示了如何用with-input-from-file来重写[代码片段1]。

(define (read-file file-name)
  (with-input-from-file file-name
    (lambda ()
      (let loop((ls1 '()) (c (read-char)))
    (if (eof-object? c)
        (list->string (reverse ls1))
        (loop (cons c ls1) (read-char)))))))

read

函数(read port)从端口port中读入一个S-表达式。用它来读诸如”paren.txt”中带括号的内容就很方便。

'(Hello world!
Scheme is an elegant programming language.)

'(Lisp is a programming language ready to evolve.)
(define (s-read file-name)
  (with-input-from-file file-name
    (lambda ()
      (let loop ((ls1 '()) (s (read)))
    (if (eof-object? s)
        (reverse ls1)
        (loop (cons s ls1) (read)))))))

下面展示了用s-read读取”paren.txt”的结果。

(s-read "paren.txt")
⇒ ((quote (hello world! scheme is an elegant programming language.))
(quote (lisp is a programming language ready to evolve.)))

输出至文件

打开一个用于输出的port

输出有和输入类似的函数，比如：

(open-output-file filename)

该函数打开一个文件用作输出，放回该输出端口。

(close-output-port port)

关闭用于输出的端口。

(call-with-output-file filename procedure)

打开文件filename用于输出，并调用过程procedure。该函数以输出端口为参数。

(with-output-to-file filename procedure)

打开文件filename作为标准输出，并调用过程procedure。该过程没有参数。当控制权从过程procedure中返回时，文件被关闭。

用于输出的函数

下面的函数可用于输出。如果参数port被省略的话，则输出至标准输出。

(write obj port)

该函数将obj输出至port。字符串被双引号括起而字符具有前缀#\。

(display obj port)

该函数将obj输出至port。字符串不被双引号括起而字符不具有前缀#\。

(newline port)

向 port 输出一个换行符。

(write-char char port)

该函数向port写入一个字符。

赋值

简介

因为Scheme是函数式语言，通常来说，你可以编写不使用赋值的语句。然而，如果使用赋值的话，有些算法就可以轻易实现了。尤其是内部状态和继续（continuations ）需要赋值。

尽管赋值非常习见并且易于理解，但它有一些本质上的缺陷。参见《计算机程序的构造和解释》的第三章第一节“赋值和局部状态”以及《为什么函数式编程如此重要》。

R5RS中规定的用于赋值的特殊形式是set!、set-car!、set-cdr!、string-set!、vector-set!等。除此之外，有些实现也依赖于赋值。由于赋值改变了参数的值，因此它具有破坏性（destructive）。Scheme中，具有破坏性的方法都以!结尾，以警示程序员。

set!

set!可以为一个参数赋值。与Common Lisp不同，set!无法给一个S-表达式赋值。

赋值前参数应被定义。

(define var 1)
(set! var (* var 10))
var ⇒ 10

(let ((i 1))
    (set! i (+ i 3))
    i)
⇒ 4

赋值和内部状态

静态作用域（词法闭包）

Scheme中变量的作用域被限定在了源码中定义其的那个括号里。作用域与源代码书写方式一致的作用域称为“词法闭包（Lexical closure）”或“静态作用域（Static scope）”。采用静态作用域减轻了程序员的负担，因为它已经在代码中体现了，因此你可以很容易理解。另一方面，还有一种被称为“动态作用域（Dynamic scope）”的作用域。这种作用域仅在程序运行时确定。由于会在调试时带来种种问题，这种作用域现在已经不再使用。

特殊形式let、lambda、letrec生成闭包。lambda表达式的参数仅在函数定义内部有效。let只是lambda的语法糖，因此二者无异。

使用赋值和词法闭包来实现内部状态

你可以使用词法闭包来实现带有内部状态的过程。例如，用于模拟银行账户的过程可以按如下的方式编写：初始资金是10美元。函数接收一个整形参数。正数表示存入，负数表示取出。为了简单起见，这里允许存款为负数。

(define bank-account
  (let ((balance 10))
    (lambda (n)
      (set! balance (+ balance n))
      balance)))

该过程将存款赋值为(+ balance n)。下面是调用这个过程的结果。

(bank-account 20)     ; donating 20 dollars 
;Value: 30

(bank-account -25)     ; withdrawing 25 dollars
;Value: 5

因为在Scheme中，你可以编写返回过程的过程，因此你可以编写一个创建银行账户的函数。这个例子喻示着使用函数式程序设计语言可以很容易实现面向对象程序设计语言。实际上，只需要在这个基础上再加一点东西就可以实现一门面向对象程序设计语言了。

(define (make-bank-account balance)
  (lambda (n)
    (set! balance (+ balance n))
    balance))
(define gates-bank-account (make-bank-account 10))   ; Gates makes a bank account by donating  10 dollars
;Value: gates-bank-account

(gates-bank-account 50)                              ; donating 50 dollars
;Value: 60

(gates-bank-account -55)                             ; withdrawing 55 dollars
;Value: 5


(define torvalds-bank-account (make-bank-account 100))  ; Torvalds makes a bank account by donating 100 dollars
;Value: torvalds-bank-account

(torvalds-bank-account -70)                             ; withdrawing 70 dollars
;Value: 30

(torvalds-bank-account 300)                             ; donating 300 dollars
;Value: 330

副作用

Scheme过程的主要目的是返回一个值，而另一个目的则称为副作用（Side Effect）。赋值和IO操作就是副作用。

表的破坏性操作（set-car!，set-cdr!）

函数set-car!和set-cdr!分别为一个cons单元的car部分和cdr部分赋新值。和set!不同，这两个操作可以为S-表达式赋值。

(define tree '((1 2) (3 4 5) (6 7 8 9)))

(set-car! (car tree) 100)  ; changing 1 to 100 

tree
 ((100 2) (3 4 5) (6 7 8 9))

(set-cdr! (third tree) '(a b c)) ; changing  '(7 8 9) to '(a b c) 

tree
⇒ ((100 2) (3 4 5) (6 a b c))

队列

队列可以用set-car!和set-cdr!实现。队列是一种先进先出(First in first out, FIFO)的数据结构，表则是先进后出(First in last out，FILO)。图表1展示了队列的结构。cons-cell-top的car部分指向表（头），而（cons-cell-top的）cdr部分指向表末的cons单元（表尾）。

入队操作按如下步骤进行：

1. 将当前最末的cons单元（可以通过cons-cell-top取得）的cdr部分重定向到新的元素。
2. 将cons-cell-top的cdr部分重定向到新的元素

出队操作按如下步骤进行:

1. 将队首元素存放在一个局部变量里。
2. 将cons-cell-top的car部分重定向到表的第二个元素

[代码片段1]展示了如何实现队列。函数enqueue!返回将元素obj添加进队列queue后的队列。函数dequeue!将队列的首元素移出队列并将该元素的值作为返回值。

(define (make-queue)
  (cons '() '()))

(define (enqueue! queue obj)
  (let ((lobj (cons obj '())))
    (if (null? (car queue))
    (begin
      (set-car! queue lobj)
      (set-cdr! queue lobj))
    (begin
      (set-cdr! (cdr queue) lobj)
      (set-cdr! queue lobj)))
    (car queue)))

(define (dequeue! queue)
  (let ((obj (car (car queue))))
    (set-car! queue (cdr (car queue)))
    obj))
(define q (make-queue))
;Value: q

(enqueue! q 'a)
;Value 12: (a)

(enqueue! q 'b)
;Value 12: (a b)

(enqueue! q 'c)
;Value 12: (a b c)

(dequeue! q)
;Value: a

q
;Value 13: ((b c) c)

字符与字符串

简介

Scheme也有像字符（Character）、字符串（String）、符号（Symbol）、向量（Vector）等的其它数据类型。

字符

在某个字符前添加#\来表明该物是一个字符。例如，#\a表示字符a。字符#\Space、#\Tab、#\Linefeed和#\Return分别代表空格（Space）、制表符（Tab），Linefeed和返回（Return）。R5RS中定义了下面的与字符相关的函数。

(char? obj)

如果obj是一个字符则返回#t。

(char=? c1 c2)

如果c1和c2是同一个字符的话则返回#t。

(char->integer c)

将c转化为对应的整数（字符代码，character code）。

示例：(char->integer #\a) => 97

(integer->char n)

该函数将一个整数转化为对应的字符。

(char<? c1 c2)，

(char<= c1 c2)，

(char> c1 c2)，

(char>= c1 c2)

这些函数用于比较字符。实际上，这些函数比较的是字符代码的大小。

例如，(char<? c1 c2)等同于(< (char->integer c1) (char->integer c2))

(char-ci=? c1 c2)，

(char-ci<? c1 c2)，

(char-ci<=? c1 c2)，

(char-ci>? c1 c2)，

(char-ci>=? c1 c2)

这些比较函数对大小写不敏感。

(char-alphabetic? c)，

(char-numeric? c)，

(char-whitespace? c)，

(char-upper-case? c)，

(char-lower-case? c)

这些函数分别用于检测字符c是否为字母、数字、空白符、大写字母或小写字母。

(char-upcase c)，

(char-downcase c)

这些函数分别返回字符C对应的大写或小写。

字符串

字符串通过两个闭合的双引号表示。例如，"abc"表示字符串abc。R5RS定义了下面的函数。

(string? s)

如果s是一个字符则返回#t。

(make-string n c)

返回由n个字符c组成的字符串。参数c可选。

(string-length s)

返回字符串s的长度。

(string=? s1 s2)

如果字符串s1和s2相同的话则返回#t。

(string-ref s idx)

返回字符串s中索引为idx的字符（索引从0开始计数）。

(string-set! s idx c)

将字符串s中索引为idx的字符设置为c。

(substring s start end)

返回字符串s从start开始到end-1处的子串。例如(substring "abcdefg" 1 4) => "b c d"

(string-append s1 s2 …)

连接两个字符串s1和s2

(string->list s)

将字符串s转换为由字符构成的表。

(list->string ls)

将一个由字符构成的表转换为字符串。

(string-copy s)

复制字符串s。

符号

简介

我会在本章讲解在Lisp/Scheme程序设计语言中极具特色的数据类型——符号。符号是一种通过地址管理字符串的数据。符号可以被如eq?这样运行迅速地函数处理，而纯字符串需要被更慢的equal?处理。由于符号可以被快速比较，它们被用于做关联表和哈希表的键。

有关符号的基本函数

下列都是有关符号的基本函数。

(symbol? x)

如果x是一个符号则返回#t。

(string->symbol str)

将str转换为符号。str应该都是小写的，否则地址系统可能无法正常工作。在MIT-Scheme中，(string->symbol "Hello")和'Hello是不同的。

(eq? (string->symbol "Hello") 'Hello)
;Value: ()

(eq? (string->symbol "Hello") (string->symbol "Hello"))
;Value: #t

(symbol->string  (string->symbol "Hello"))
;Value 15: "Hello"

(symbol->string sym)

将sym转换为字符。

统计文本中的单词

下面的代码是一段统计文本中单词个数的程序，这也是被经常用作演示如何使用符号的例子。该程序使用了哈希表（Hash table）和关联表（Association list），这些都将在下一章中讲解。

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;;;   wc.scm
     ;;;   a scheme word-count program
     ;;;
     ;;;    by T.Shido
     ;;;    on August 19, 2005
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

     (define (list->symbol ls0)
       (string->symbol (list->string (reverse! ls0))))

     (define (char-in c . ls)
       (let loop((ls0 ls))
         (if (null? ls0)
             #f
           (or (char=? c (car ls0))
               (loop (cdr ls0))))))

     (define (read-words fname)
       (with-input-from-file fname
         (lambda ()
           (let loop((w '()) (wls '()))
             (let ((c (read-char)))
           (cond
            ((eof-object? c)
                 (reverse! (if (pair? w)
                               (cons (list->symbol w) wls)
                             wls)))
            ((char-in c #\Space #\Linefeed #\Tab #\, #\.  #\ #\( #\) #\= #\? #\! #\; #\:)
                 (loop '() (if (pair? w)
                               (cons (list->symbol w) wls)
                             wls)))
            (else
             (loop (cons (char-downcase c) w) wls))))))))

     (define (sort-by-frequency al)
       (sort al (lambda (x y) (> (cdr x) (cdr y)))))

     (define (wc fname)
       (let ((wh (make-eq-hash-table)))
         (let loop((ls (read-words fname)))
           (if (null? ls)
               (sort-by-frequency (hash-table->alist wh))
             (begin
             (hash-table/put! wh (car ls) (1+ (hash-table/get wh (car ls) 0)))
              (loop (cdr ls)))))))
(wc "opensource.txt")
⇒
((the . 208) (to . 142) (a . 104) (of . 103) (and . 83) (that . 75) (is . 73) (in . 65) (i . 64)
(you . 55) (it . 54) (they . 48) (for . 46) (what . 38) (work . 37) (but . 35) (have . 32) (on . 32)
(people . 32) (are . 30) (be . 29) (do . 29) (from . 27) (so . 26) (like . 25) (as . 25) (by . 24)
(source . 24) (not . 23) (open . 23) (can . 23) (we . 22) (was . 22) (one . 22) (it's . 22) (an . 21)
(this . 20) (about . 20) (business . 18) (working . 18) (most . 17) (there . 17) (at . 17) (with . 16)
(don't . 16) (just . 16) (their . 16) (something . 15) (than . 15) (has . 15) (if . 15) (when . 14)
(because . 14) (more . 14) (were . 13) (office . 13) (own . 13) (or . 12) (online . 12) (now . 12)
(blogging . 12) (how . 12) (employees . 11) (them . 11) (think . 11) (time . 11) (company . 11)
(lot . 11) (want . 11) (companies . 10) (could . 10) (know . 10) (get . 10) (learn . 10) (better . 10)
(some . 10) (who . 10) (even . 9) (thing . 9) (much . 9) (no . 9) (make . 9) (up . 9) (being . 9)
(money . 9) (relationship . 9) (that's . 9) (us . 9) (anyone . 8) (average . 8) (bad . 8) (same . 8)
..........)

说明：

(list->symbo ls0)

将一个由字符构成的列表（ls0）转换为一个符号。

(char-in c . ls)

检查字符（c）是否存在表（ls）。如果存在返回#t，不存在返回#f。

(read-words fname)

读取一个名为fname的文件，并返回一个符号列表。函数将大写转换为小写，将字符表（w）转换为一个字符，将it添加到符号表（wls）中。

(sort-by-frequency al)

以出现频率降序排序关联表（al）。

(wc fname)

读取名为fname的文件，并返回一个以出现频率降序排序关联表。因为函数使用了符号，eq-hash-table是适用的，它使用执行速度很快地eq?比较键（第40行）。函数统计由read-words创建的单词表里各单词的数量，并将其存储在一个哈希表（第44-46行）。在统计完成时（第43行），将哈希表转换为关联表。

关联表和哈希表

简介

本章中，我会讲解用于表示数据关联的关联表和哈希表。关联的数据是由键和值组成的序对，值由键唯一确定的。表1显示了书和作者构成的配对。书籍可以确定作者，反之由作者确定书籍则不可，这是因为一个作者可能会写很多本书。表1中，由于P. Graham和L.Carroll分别写了两本书，因此他们的书无法被作者的名字唯一确定。

表1：作者和书

Author	Book
P. Graham	On Lisp
P. Graham	ANSI Common Lisp
E. S. Raymond	The Cathedral and the Bazaar
K. Dybvig	The Scheme Programming Language
F. P. Brooks, Jr.	The Mythical Man-Month
L. Carroll	Alice’s Adventures in Wonderland
L. Carroll	Through the Looking-Glass, and What Alice Found There

R5RS定义了关联表，因此它在所有Scheme实现中都可用。但是使用关联表搜索速度较慢（O(n)的时间复杂度）。使用哈希表在速度方面更好一些（O(1)的时间复杂度），但是哈希表并未在R5RS中定义而是依赖于相关实现。MIT-Scheme实现了哈希表。如果你喜欢的Scheme实现没有哈希表，你可以自己实现一个（见 http://www.math.grin.edu/~stone/events/scheme-workshop/hash-tables.html）。

关联表

关联表是一个由序对组成的表，它是一个用于表达关联的基本数据类型。符号，字符，和数字常被作为键使用，因为它们可以使用诸如eq?或者eqv?的快速比较函数被比较。在作为键被使用前，字符串应该被转换为符号，从而获得更好的性能。

下面是一个关联表的例子。关联表应该要么由点序对要么由普通表组成。

'((hi . 3) (everybody . 5) (nice . 3) (to . 10) (meet . 4) (you . 8))
'((1 2 3) (4 5 6) (7 8 9))

函数assq，assv，和assoc从关联表中搜寻一个项。这些函数从开始一步步搜索关联表。如果它们找到序对的car等于给定的key，就返回该序对。如果找不到函数返回#f。这些函数分别使用eq?，eqv?，和equal?比较键，这意味着assq最快，assoc最慢。这表示作为键的话，字符串，向量和表应该转化为符号或者数字（如果可能的话）以提高性能。

一般来说，哈希表在大量数据中搜索表现得更好一些。

下面展示在关联表中进行搜索的例子。

(define wc '((hi . 3) (everybody . 5) (nice . 3) (to . 10) (meet . 4) (you . 8)))
⇒ wc

(assq 'hi wc)
⇒  (hi . 3)

(assq 'you wc)
⇒  (you . 8)

(assq 'i wc)
⇒  ()


(define n '((1 2 3) (4 5 6) (7 8 9)))
⇒  n

(assv 1 n)
⇒  (1 2 3)

(assv 8 n)
⇒  ()

哈希表

哈希表是一种数据类型，它使用哈希函数将键转化为整数，并将值存储在由该整数所指示的位置。当表足够稀疏时，搜索，插入，更新都能以O(1)完成。下面展示了MIT-Scheme里哈希表的一些基本函数。查询MIT-Scheme Manul获取更详细的信息。

(make-eq-hash-table size),

(make-eqv-hash-table size),

(make-equal-hash-table size),

(make-string-hash-table size)

这些函数创建哈希表。这些函数分别使用eq?，eqv?，equal?，和string=?比较键的值。哈希表的初始大小（size）可以选择性指定（optional）。由于只比较键的地址，所以eq-hash-table是最快的。由于键是序列，所以equal-hash-table和string-hash-table比较慢。

(hash-table/put! hash-table key datum)

将hash-table中key对应的值设为datum。

(hash-table/get hash-table key default)

返回hash-table中的key对应的值。如果key不存在于hash-table中，返回default。

(hash-table->alist hash-table)

将hash-table转换为关联表。

生成密码

让我们写一个密码创建程序作为关联表和哈希表的例子。

从字典里得到的密码很容易被破解，但另一方面，完全随机的密码又很难记忆和输入。程序使用无规则的拼写创建10个密码。密码应该尽可能频繁更改，但是我懒于自己创建密码。使用这个程序，我可以简单地改变密码。

程序由两部分构成。一部分用于创建连续字符出现频率的数据（stat-spell.scm），另一个用于基于这个数据创建密码（make-pw.scm）。

stat-spell.scm

这个程序可以阅读英语句子，数据存在哈希表里，并转换为关联表输出到一个文件（stat-spell.data）。[代码1]显示了源代码。

[代码1]

01:     ;;; make an alist of probable spelling from a given English text
02:     
03:     (define (skip-char? c)
04:       (or (not (char-graphic? c)) (memv c '(#\: #\; #\' #\" #\`))))
05:     
06:     (define (ss-make-alist c alist)
07:       (let ((p (assv c alist)))
08:         (if p
09:             (begin
10:              (set-cdr! p (1+ (cdr p)))
11:              alist)
12:           (cons (cons c 1) alist))))
13:     
14:     (define (ss-make-dat filename)
15:       (let ((char-hash (make-eqv-hash-table)))
16:         (with-input-from-file filename
17:           (lambda ()
18:         (let loop ((c #\Space))
19:           (let ((c1 (read-char)))
20:                      (if (not (eof-object? c1))
21:                          (if (skip-char? c1)
22:                              (loop c)
23:                              (let ((c1 (char-downcase c1)))
24:                    (hash-table/put! char-hash c
25:                             (ss-make-alist c1 (hash-table/get char-hash c '())))
26:                    (loop c1))))))))
27:         (with-output-to-file "stat-spell.dat"
28:           (lambda ()
29:         (display "(define *stat-spell* \'(")
30:         (newline)
31:         (let loop ((alst (sort (hash-table->alist char-hash) 
32:                        (lambda (x y) (char33:           (if (pair? alst)
34:               (begin
35:             (write (car alst))
36:             (newline)
37:             (loop (cdr alst)))))
38:             (display "))")
39:             (newline)))))

(skip-char? c)

如果c不是图像字符或者c是 #:, #;, #', or #"，就返回#t。读取文本时，这些字符会被跳过。

(ss-make-alist c alist)

有两个参数；字符的频率的关联表（alist）和字符（c）。如果c在alist中，在序对的cdr部分增加一。如果不在，返回 (cons (cons c 1) alist)。这个函数使用了set-cdr!。

(ss-make-dat filename)

从名为filename的文件中读取字符，并使用跟随字符的频率的关联表来关联这些读出的字符。结果以关联表形式存储在文件stat-spell.dat。在34和35行，它在哈希表中更新了频率的关联表。存储在stat-spell.dat的最终数据是一个关联表的关联表。例如：

(#\v (#\y . 1) (#\a . 3) (#\o . 7) (#\e . 51) (#\i . 15))

表示 #\y, #\a, #\o, #\e, 和 #\i 跟随 #\v 之后出现的次数分别是1, 3, 7, 51, 和15次。

make-pw.scm

基于 stat-spell.dat 创建十个密码。过程如下：

1. 基于频率数据创建由9到13个随机字符组成字符串表。字符 #\Space 被添加在表结尾。
2. 添加一个00到99之间的随机数在随机选取的字符串表的结尾。
3. 随机地将 #\Space 转换为 #-, #_, #/, #\Space, #., 或者 #,。
4. 随机地将30%的字母字符变为大写。

01:     ;;; make password from the alist of probable spelling
02:     
03:     (load "stat-spell.dat") ; *stat-spell* (alist for following characters) is in.
04:     
05:     (define (alist->hash al mode)
06:       (let ((h (case mode
07:                  ((eq) (make-eq-hash-table))
08:                  ((eqv) (make-eqv-hash-table))
09:                  ((equal) (make-equal-hash-table))
10:                  ((string) (make-string-hash-table)))))
11:         (for-each (lambda (p)
12:                     (hash-table/put! h (car p) (cdr p)))
13:                   al)
14:         h))
15:     
16:     (define *stat-spell-hash* (alist->hash *stat-spell* 'eqv))
17:     
18:     (define (pw-random-select vec)
19:       (vector-ref vec (random (vector-length vec))))
20:     
21:     (define (random00)
22:       (let loop ((i 0) (acc '()))
23:         (if (= i 2)
24:             (list->string acc)
25:           (loop (1+ i) (cons (pw-random-select '#(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) acc)))))
26:     
27:     (define (occasional-upcase c)
28:       (if (< (random 10) 3)
29:           (char-upcase c)
30:         c))
31:     
32:     (define (pw-enhance ls)
33:       (list->string
34:        (map (lambda (c)
35:               (cond
36:                ((char=? c #\Space)
37:                 (pw-random-select  '#(#\- #\_ #\/  #\Space  #\. #\, #\@ #\? #\( #\))))
38:                ((char-alphabetic? c)
39:                 (occasional-upcase c))
40:                (else c)))
41:             (cdr (reverse! ls)))))
42:         
43:     
44:     (define (random-following alist)
45:       (let ((n (random (apply + (map cdr alist)))))
46:         (let loop ((j 0) (alist alist))
47:           (if (pair? alist)
48:           (let* ((pair (car alist))
49:              (k (+ j (cdr pair))))
50:             (if (> k n)
51:             (car pair)
52:             (loop k (cdr alist))))))))
53:     
54:     (define (make-pw h n)
55:       (let loop ((i 0) (c #\Space) (acc '()))
56:         (if (= i n)
57:             (string-append
58:              (pw-enhance (cons #\Space (cons c acc)))
59:              (random00))
60:           (loop (1+ i)
61:             (random-following (hash-table/get h c '((#\Space . 1))))
62:             (cons c acc)))))
63:         
64:     (define (pw-candidates)
65:       (let loop ((i 0))
66:         (if (< i 10)
67:             (begin
68:              (display i)
69:              (display ": ")
70:              (write (make-pw *stat-spell-hash* (+ 9 (random 4))))
71:              (newline)
72:              (loop (1+ i)))
73:           'done)))

向量和结构体

简介

本章中，我将讲解向量和结构体。

向量是一组通过整数索引的数据。与C语言中的数组不同，一个向量可以储存不同类型的数据。与表相比，向量更加紧凑且存取时间更短。但从另外一方面来说，向量是通过副作用来操作的，这样会造成负担。

Scheme中的结构体与C语言中的结构体类似。但Scheme中的结构体比C语言中的更容易使用，因为Scheme为结构体自动创建了读取函数和写入函数，这受益于Lisp/Scheme中的宏。

向量

字面值

向量通过闭合的#(和)表示，例如#(1 2 3)。作为字面值（literals）时，它们应该被引用（be quoted），例如：

'#(1 2 3)             ; 整数向量
'#(a 0 #\a)           ; 由符号、整数和字符构成的向量

向量函数

下面的函数都是R5RS规定的函数：

(vector? obj)

如果obj是一个向量则返回#t。

(make-vector k)

(make-vector k fill)

返回有k个元素的向量。如果指定了第二个参数(fill)，那么所有的元素都会被初始化为fill。

(vector obj …)

返回由参数列表构成的向量。

(vector-length vector)

返回向量vector的长度。

(vector-ref vector k)

返回向量vector的索引为k的元素。（译注：和C语言类似，向量从0开始索引。）

(vector-set! vector k obj)

将向量vector的索引为k的元素修改为obj。

(vector->list vector)

将vector转换为表。

(list->vector list)

将list转换为向量。

(vector-fill! vector fill)

将向量vector的所有元素设置为fill。

例：一个对向量中元素求和的函数。

(define (vector-add v1 v2)
  (let ((lenv1 (vector-length v1))
          (lenv2 (vector-length v2)))
    (if (= lenv1 lenv2)
          (let ((v (make-vector lenv1)))
            (let loop ((i 0))
              (if (= i lenv1)
                    v
                    (begin
                      (vector-set! v i (+ (vector-ref v1 i) (vector-ref v2 i)))
                      (loop (+ 1 i))))))
        (error "different dimensions."))))

练习1

编写一个用于计算两向量内积的函数。

结构体

大体功能

虽然R5RS中没有定义结构体，但是在很多Scheme实现中，都实现了类似于Common Lisp中的结构体。

这些结构体本质上来说都是向量。每一个槽（slot）都通过使用一个宏来命名，我将会在下一章（十五章）中讲解这个问题。结构体通过不同的属性清楚地表示数据。定义结构体的宏自动为结构体创建取值器（accessor）和赋值器（setter）。你可以通过“程序”来写程序，这被认为是Lisp/Scheme最好之处之一。通过这个功能，你可以很快写出漂亮的程序。

MIT-Scheme中的结构体

在MIT-Scheme中，结构体通过函数define-structure来定义。为了使你更加容易理解，我会用一个实例来讲解。请考虑书籍。书籍都有下列属性：

• 标题
• 作者
• 出版商
• 出版年份
• ISBN号

因此结构体book就可以像下面这样定义：

(define-structure book title authors publisher year isbn)

下面演示了如何注册“大教堂与市集（The Cathedral and Bazaar）”。

(define bazaar 
  (make-book 
   "The Cathedral and the Bazaar"
   "Eric S. Raymond"
   "O'Reilly"
   1999
   0596001088))

然而，这样做多少有点不便，因为属性与值的关联并不清楚。参量keyword-constructor可以用于解决这个问题。下面的代码就是使用这个参量的重写版，这个版本中，属性与值的关联就非常清楚了。此外，制定这个参量后，参数的顺序就不重要了。参量copier可用于为结构体创建一个拷贝（copier）函数。

(define-structure (book keyword-constructor copier) 
  title authors publisher year isbn)

(define bazaar 
  (make-book 
   'title "The Cathedral and the Bazaar"
   'authors "Eric S. Raymond"
   'publisher "O'Reilly"
   'year 1999    
   'isbn 0596001088))

• 一个名字形如[the name of structure]?的函数用于检查某对象是否为特定结构体。例如，可使用函数book?来检查bazaar是否为book结构体的一个实例。

(book? bazaar)
;Value: #t

• 一个名字形如copy-[structure name]的函数用于拷贝结构体。例如，下面的代码演示了将bazaar拷贝到cathedral。

(define cathedral (copy-book bazaar))

• 一个名字形如[structure name]-[attribute name]的函数用于读取结构体某属性的值。例如，下面的代码演示了如何读取bazaar的title属性。

(book-title bazaar)
;Value 18: "The Cathedral and the Bazaar"

• 一个名字形如set-[结构体名称]-[属性名称]!用于将某属性设定为特定值。下面的代码演示了如何将bazaar的year字段更新到2001（《大教堂与市集》2001年再版）。

(set-book-year! bazaar 2001)
;Unspecified return value

(book-year bazaar)
;Value: 2001

请参阅MIT/GNU Scheme Reference: 2.10 Structure Definitions以获得关于结构体的跟多信息。

The Mastermind — 一个简单的密码破解游戏

作为向量的示例，我会演示一个简单的密码破解游戏。这是一个猜对手密码的游戏。密码是由0到9中四个不同的数组成的四位数。对手要通过使用bulls和cows的数量告知猜谜者猜测的准确程度。

1. bull的数量（Nbull）是指值和位置都正确的数字的数量。
2. cow的数量（Ncow）是指值正确但位置错误的数字的数量。

例如，密码是5601，猜测是1685，那么bull和cow和数分别是1和2。

计算机和用户相互猜测对方的密码。更少尝试次数的选手为胜利者。如果用户和电脑在相同的尝试次数中破解了密码就是平局。

表示四个数字

四位数字可以通过向量和计算bull以及cow的数量高效地表示。这种表达方法需要构成密码的数字都不相同。

创建长度为10的向量，每个索引（k）的值被设为k在密码中的数位。四个数位从低到高被计为1，2，3和4。如果数字没有出现，索引的值为0。例如，5601和1685可以表示如下：

5601 → #(2 1 0 0 0 4 3 0 0 0)
1685 → #(0 4 0 0 0 1 3 0 2 0)

5601这个例子中，数字0，1，5，和6分别出现在第2，第1，第4和第3位，那么在这个密码的向量表达式里索引0，1，5，6的值分别2是2，1，4和3，其他索引位都是0。

这种表达可以快速比较两个数字。如果两个向量的相同索引位的值都是正数情况下，如果值相等，就计为bull，如果值不相等，就计为cow。5601和1685这个例子的情况下，索引位6的值都为3，索引位1和索引位5的值都是正数，bull和cow的值为1和2。

程序的设计

程序的设计如下：

1. 程序生成一个表，该表包含了所有不同四位数的向量表示。
2. 程序从表中随机选取一个数字。
3. 重洗步骤（1）产生的表。
4. 程序首次猜用户的密码，用户给出bull和cow的数量。然后用户猜程序的密码，程序给出Nnull和Ncow。
5. 重复步骤（3）直到电脑或者程序的bull数量变为4为止。如果在同一次双方的数量都变为4，就是平局。

源代码

[代码1]展示了源代码。代码很长但并不十分复杂。游戏由一个递归函数mastermind-rec执行。

[代码1]

 01:     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 02:     ;;;
 03:     ;;; mastermind.scm
 04:     ;;; by T.Shido
 05:     ;;;
 06:     ;;; User and computer try to locate the four-digit integer set by the opponents each other.
 07:     ;;; One who locates the integer with fewer question is the winner.
 08:     ;;; The four-digit integer contains four of numerals 0--9, like 0123, 3749 etc.
 09:     ;;; The opponents should tell the guesser
 10:     ;;; (1) number of numerals that are shared by the guessed and set numbers
 11:     ;;; at wrong position (cows)
 12:     ;;; and (2) number of numerals at collect position (bulls).
 13:     ;;; 
 14:     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 15:     ;;;
 16:     ;;; The four-digit integers are represented by 10-cell vectors in the program
 17:     ;;; The value of n-th cell is the number of column that n appears in the integer.
 18:     ;;; in n is not appears the value is 0.
 19:     ;;; for example, 1234 is represented as #(0 4 3 2 1 0 0 0 0 0) and
 20:     ;;; 3916 as #(0 2 0 4 0 0 1 0 0 3).
 21:     ;;; With this inner representation, the score of the guess can be calculated faster.
 22:     ;;;
 23:     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 24:     
 25:     
 26:     ;;;
 27:     (define (1- x) (- x 1))
 28:     
 29:     ;;;
 30:     (define (char2int c)
 31:       (- (char->integer c) (char->integer #\0)))
 32:     
 33:     ;;; converting a list of 4 numbers to the vector notation
 34:     (define (ls2nvec ls)
 35:       (let ((vec (make-vector 10 0)))
 36:         (let loop ((i (length ls)) (ls ls))
 37:           (if (> i 0)
 38:           (begin
 39:                (vector-set! vec (car ls) i)
 40:                (loop (1- i) (cdr ls)))
 41:             vec))))
 42:     
 43:     ;;; converting the vector notation to string
 44:     (define (nvec2int vec)
 45:       (let loop ((i 0) (n 0))
 46:         (if (= i 10)
 47:             n
 48:         (let ((j (vector-ref vec i)))
 49:           (loop (1+ i) (+ n (if (> j 0)
 50:                                     (* i (expt 10 (1- j)))
 51:                                   0)))))))
 52:     
 53:     ;;;
 54:     (define (int2str i)
 55:       (string-append
 56:        (if (< i 1000) "0" "")
 57:        (number->string i)))
 58:     
 59:     ;;; reading integer from stdin
 60:     (define (read-integer str)
 61:       (string->number (read-from-stdin str)))
 62:     
 63:     ;;;
 64:     (define (read-from-stdin str)
 65:       (display str)
 66:       (newline)
 67:       (read-line))
 68:     
 69:     ;;;
 70:     (define (write-to-stdout . ls)
 71:       (for-each (lambda (obj) (display obj)) ls)
 72:       (newline))
 73:     
 74:     ;;; convert numeral string to the vector representation.
 75:     (define (str2nvec str)
 76:       (let ((vec (make-vector 10 0)))
 77:         (let loop ((i (string-length str)) (ls (string->list str)))
 78:           (if (pair? ls)
 79:           (begin
 80:                (vector-set! vec (char2int (car ls)) i)
 81:                (loop (1- i) (cdr ls)))
 82:             vec))))
 83:     
 84:     ;;; calculating the score of guess
 85:     (define (scoring vec0 vec1)
 86:       (let ((n (vector-length vec0)))
 87:         (let loop ((i 0) (score 0))
 88:           (if (< i n)
 89:           (let ((d0 (vector-ref vec0 i))
 90:                    (d1 (vector-ref vec1 i)))
 91:                 (loop (1+ i)
 92:               (+ score (if (and (< 0 d0) (< 0 d1))
 93:                                    (if (= d0 d1) 5 1)
 94:                                    0))))
 95:             score))))
 96:     
 97:     ;;; show bulls and cows calculated from the score of user's guess
 98:     (define (show-user-score score)
 99:       (write-to-stdout "Number of bulls and cows in your guess:" )
100:       (write-to-stdout "bulls: " (quotient score 5))
101:       (write-to-stdout "cows: " (modulo score 5))
102:       (newline))
103:     
104:     ;;; calculating the score of computer's guess from bulls and cows
105:     (define (read-my-score gu0)
106:       (write-to-stdout "My guess is: " (int2str (nvec2int gu0)))
107:       (write-to-stdout "Give number of bulls and cows in my guess." )
108:       (let ((na5 (* 5 (read-integer "bulls: "))))
109:         (+ na5 (read-integer "cows: ")))) ; the score is calculated by (5 * bull + cow)
110:     
111:     ;;; reading the user guess
112:     (define (read-user-guess)
113:       (newline)
114:       (str2nvec (read-from-stdin "Give your guess.")))
115:     
116:     ;;; shuffling the list of four-digit numbers
117:     (define (shuffle-numbers ls0)
118:       (let ((vec (list->vector ls0)))
119:         (let loop ((n (vector-length vec)) (ls1 '()))
120:           (if (= n 0)
121:               ls1
122:           (let* ((r (random n))
123:              (v (vector-ref vec r)))
124:             (vector-set! vec r (vector-ref vec (1- n)))
125:             (loop (1- n) (cons v ls1)))))))
126:     
127:     ;;; making a list of four-digit numbers in which numeral 0--9 appear once
128:     (define (make-numbers)
129:       (let ((ls1 '()))
130:         (letrec ((rec (lambda (i num ls)
131:                 (if (= i 4)
132:                 (set! ls1 (cons (ls2nvec ls) ls1))
133:                 (for-each 
134:                  (lambda (n)
135:                    (rec (1+ i) (delv n num) (cons n ls)))
136:                  num)))))
137:           (rec 0 '(0 1 2 3 4 5 6 7 8 9) '()))
138:         ls1))
139:     
140:     ;;;
141:     (define (game-over sc0 sc1)
142:       (write-to-stdout
143:        (cond
144:         ((= sc0 sc1) "Draw")
145:         ((> sc0 sc1) "I won.")
146:         (else "You won.")))
147:       'game-over)
148:     
149:     (define (scoring-user-guess an0 gu1)
150:       (let ((sc1 (scoring an0 gu1)))
151:         (show-user-score sc1)
152:         sc1))
153:     
154:     ;;; Practical main function. tail recursive.
155:     (define (mastermind-rec an0 candidates)
156:       (if (null? candidates)
157:           (error "Error. You gave wrong score for my guess, probably.")
158:           (let ((gu0 (car candidates)))
159:         (let ((sc1 (scoring-user-guess an0 (read-user-guess)))
160:               (sc0 (read-my-score gu0)))
161:           (if (or (= sc0 20) (= sc1 20))
162:               (game-over sc0 sc1)
163:               (mastermind-rec an0 
164:                    (keep-matching-items 
165:                     (cdr candidates)
166:                     (lambda (x) (= (scoring gu0 x) sc0)))))))))
167:     
168:     ;;; The main function called from the top-level
169:     (define (mastermind)
170:       (let ((ls0 (make-numbers)))
171:         (mastermind-rec (list-ref ls0 (random (length ls0))) (shuffle-numbers ls0))))

行数	函数	说明
27	(1- x)	x减一
30	(char2int c)	将字符c(#\0 – #\9)转换为整数（0 – 9）。
34	(ls2nvec ls)	将四个数字的表（ls）转换为向量表达式。'(5 3 6 0)->#(1 0 0 3 0 4 2 0 0 0)
44	(nvec2int vec)	将向量表达式vec转换为普通整数。
54	(int2str i)	将一个四位数i转换为字符串。如果i小于1000，’0’被置于高位。
64	(read-from-stdin str)	将str显示于标准输出，并返回用户从标准输入输入的字符串。
70	(write-to-stdout . ls)	将ls的每个元素都输出到标准输出，并在行尾插入行结束符。
75	(str2nvec str)	将用户输入的表示四位数的字符串str转换为向量表达式。
86	(scoring vec0 vec1)	以（5*Nnull + Ncow）计算两个整数（向量表达式）vec0和vec1的相似程度。
98	(show-user-score score)	通过相似度score计算Nbull和Ncow，并将它们显示在标准输出。
105	(read-my-score gu0)	显示计算机的猜测（gu0），让用户输入Nnull和Ncow，返回相似度score。
112	(read-user-guess)	返回用户猜测的向量表达式。
116	(shuffle-numbers ls0)	随机排序ls0。由于有随机读取的需求，将ls0转换为向量，然后随机读取向量的元素，以创建一个重排过的表。
128	(make-numbers)	返回由所有不同四位数构成的表。
141	(game-over sc0 sc1)	通过比较计算机的得分（sc0）和用户的得分(sc1)确定胜利者。
149	(scoring-user-guess an0 gu1)	计算计算机的密码（an0）和用户的猜测（gu1）的相似度，使用show-uuser-score输出Nbull和Ncow。
155	(mastermind-rec an0 candidates)	实际的主程序，它有两个参数；计算机密码（an0）和 猜测的表（candidate）。它计算计算机的得分（sc0）和用户的得分（sc1），如果sc0或者sc1为20，调用 (game-over sc0 sc1)。如果没有值为20，它根据sc0过滤猜测的表（candidate），并继续游戏。
169	(mastermind)	在控制台调用该函数以开始游戏。

如何玩

输入如下代码启动游戏。最好在玩之前编译（你需要编译一次）。即使程序很简单，也很难取胜。

(compile-file "mastermind.scm")
(load "mastermind")
(mastermind)

小结

这一章，我通过玩mastermind游戏讲解了向量和结构体。附上mastermind的源代码。

我将在下一章讲自定义语法。自定义语法是Lisp/Scheme的一个优点。

定义语法

简介

本章中，我会讲解如何自定义语法。用户定义语法称作宏（Macro）。Lisp/Scheme中的宏比C语言中的宏更加强大。宏可以使你的程序优美而紧凑。

宏是代码的变换。代码在被求值或编译前进行变换，程序会继续执行就像变换后的代码一开始就写好了一样。

你可以在Scheme中通过用符合R5RS规范的syntax-rules轻易地定义简单宏，相比之下，在Common Lisp中自定义语法就复杂多了。使用syntax-rules可以直接定义宏而不用担心变量捕获（Variable Capture）。另一方面，Scheme中定义那些无法用syntax-rules定义的复杂的宏就比Common Lisp要困难。

简单宏的实例

我将以一个简单的宏作为例子。

[代码1]一个将变量赋值为'()的宏。

[代码1]

(define-syntax nil!
  (syntax-rules ()
    ((_ x)
     (set! x '()))))

syntax-reuls的第二个参数是变换前和变化后的表达式的序对所构成的表。_代表宏的名字。简言之，[代码1]表示表达式(nil! x)会变换为(set! x '()).

这类程序不能通过函数来实现，这是因为由于闭包性，函数不能影响外部变量。让我们来用函数版本来实现[代码1]，并观察效果。

[代码’1]

(define (f-nil! x)
   (set! x '()))
(define a 1)
;Value: a

(f-nil! a)
;Value: 1

a
;Value: 1           ; the value of a dose not change

(nil! a)
;Value: 1

a
;Value: ()          ; a becomes '()

我会演示另外一个例子。我们编写宏when，其语义为：当谓词求值为真时，求值相应语句。

[代码2]

(define-syntax when
  (syntax-rules ()
    ((_ pred b1 ...)
     (if pred (begin b1 ...)))))

[代码2]中的...代表了任意多个数的表达式（包括0个表达式）。[代码2]揭示了表达式(when pred b1 ...)变换为(if pred (begin b1 ...))。

由于这个宏是将表达式变换为if特殊形式，因此它不能使用函数来实现。下面的例子演示了如何使用when。

(let ((i 0))
  (when (= i 0)
    (display "i == 0")
    (newline)))
i == 0
;Unspecified return value

我会演示两个实际的宏：while和for（已在Scheme中实现）。只要谓词部分求值为真，while就会对语句体求值。而数字在指定的范围中，for就会对语句体求值。

(define-syntax while
  (syntax-rules ()
    ((_ pred b1 ...)
     (let loop () (when pred b1 ... (loop))))))


(define-syntax for
  (syntax-rules ()
    ((_ (i from to) b1 ...)
     (let loop((i from))
       (when (< i to)
      b1 ...
      (loop (1+ i)))))))

下面演示了如何使用它们：

(let ((i 0))
  (while (< i 10)
    (display i)
    (display #\Space)
    (set! i (+ i 1))))
0 1 2 3 4 5 6 7 8 9 
;Unspecified return value

(for (i 0 10)
  (display i)
  (display #\Space))
0 1 2 3 4 5 6 7 8 9 
;Unspecified return value

syntax-rule的更多细节

多个定义模式

syntax-rule可以定义一系列模式。比如，一个让变量增加的宏，如果给定了变量名，那么宏incf使该变量增加1。可以通过编写如[代码4]这样的模式转换来实现宏incf。

[代码4]

(define-syntax incf
  (syntax-rules ()
    ((_ x) (begin (set! x (+ x 1)) x))
    ((_ x i) (begin (set! x (+ x i)) x))))
(let ((i 0) (j 0))
  (incf i)
  (incf j 3)
  (display (list 'i '= i))
  (newline)
  (display (list 'j '= j)))
(i = 1)
(j = 3)
;Unspecified return value

宏的递归定义

代码形式or和and是通过像下面这样递归定义的宏：

[代码5]

(define-syntax my-and
  (syntax-rules ()
    ((_) #t)
    ((_ e) e)
    ((_ e1 e2 ...)
     (if e1
     (my-and e2 ...)
     #f))))

(define-syntax my-or
  (syntax-rules ()
    ((_) #f)
    ((_ e) e)
    ((_ e1 e2 ...)
     (let ((t e1))
       (if t t (my-or e2 ...))))))

可以使用递归定义来编写复杂的宏。

使用保留字

syntax-rule的第一个参数是保留字的表。比如，cond的定义如[代码6]所示，其中，else是保留字。

(define-syntax my-cond
  (syntax-rules (else)
    ((_ (else e1 ...))
     (begin e1 ...))
    ((_ (e1 e2 ...))
     (when e1 e2 ...))
    ((_ (e1 e2 ...) c1 ...)
     (if e1 
     (begin e2 ...)
     (cond c1 ...)))))

局部语法

在Scheme中，可以使用let-syntax和letrec-syntax来定义局部语法（Local Syntax）。这种形式的用法和define-syntax是相似的。

取决于宏定义的实现

有些宏无法使用syntax-rules来定义。定义这些宏的实现方法已经在Scheme实现中准备好了。由于这种行为严重依赖于实现，因此你可以跳过此节。

在MIT-Scheme中，sc-macro-transformer就可用于这种情况，它允许用户用与Common Lisp中相似的方式来编写宏。关于,、,@的介绍，请参见The Common Lisp HyperSpec。关于sc-macro-transformer和make-syntactic-closuer请参见MIT-Scheme手册。[代码7]演示了一个简单的例子。

[代码 7]

(define-syntax show-vars
  (sc-macro-transformer
    (lambda (exp env)
      (let ((vars (cdr exp)))
           `(begin
              (display
                (list
                  ,@(map (lambda (v)
                            (let ((w (make-syntactic-closure env '() v)))
                                 `(list ',w ,w)))
                          vars)))
      (newline))))))

(define-syntax random-choice
  (sc-macro-transformer
   (lambda (exp env)
     (let ((i -1))
       `(case (random ,(length (cdr exp)))
      ,@(map (lambda (x)
           `((,(incf i)) ,(make-syntactic-closure env '() x)))
         (cdr exp)))))))

(define-syntax aif
  (sc-macro-transformer
   (lambda (exp env)
     (let ((test (make-syntactic-closure env '(it) (second exp)))
       (cthen (make-syntactic-closure env '(it) (third exp)))
       (celse (if (pair? (cdddr exp))
              (make-syntactic-closure env '(it) (fourth exp))
              #f)))
       `(let ((it ,test))
      (if it ,cthen ,celse))))))

第一个宏show-vars用于显示变量的值。

(let ((i 1) (j 3) (k 7))
  (show-vars i j k))
((i 1) (j 3) (k 7))
;Unspecified return value

代码形式(show-vars i j k)被展开成下面这样。因为宏只能返回一个表达式，所以需要用begin返回表达式的集合。

(begin
  (display
   (list
    (list 'i i) (list 'j j) (list 'k k)))
  (newline))

第二个宏random-choice被用于从参数中随机选择一个值或者过程。

(define (turn-right) 'right)
(define (turn-left) 'left)
(define (go-ahead) 'straight)
(define (stop) 'stop)

(random-choice (turn-right) (turn-left) (go-ahead) (stop))
;Value: right

代码形式被展开如下：

(case (random 4)
  ((0) (turn-right))
  ((1) (turn-left))
  ((2) (go-ahead))
  ((3) (stop)))

第三个宏aif是一个回指宏（ anaphoric macro）。谓词的结果可以被指为it。变量it被捕获，以使得第二个参数make-syntactic-closure变为'(it)。

(let ((i 4))
  (aif (memv i '(2 4 6 8))
       (car it)))
;Value: 4

下面显示了扩展结果。

````scheme
(let ((it (memv i ‘(2 4 6 8))))
(if it
(car it)
#f))

### 结构体的原始实现

结构体（structure）可以通过[代码8]中的简单宏实现。这里定义的结构体的本质是一个向量（vector）和由宏自动创建的取值以及赋值函数。如果你喜欢的Scheme版本没有结构体的实现，你可以自己实现它们。

[代码8]

```scheme
01:     ;;; simple structure definition
02:     
03:     ;;; lists of symbols -> string
04:     (define (append-symbol . ls)
05:       (let loop ((ls (cdr ls)) (str (symbol->string (car ls))))
06:         (if (null? ls)
07:         str
08:         (loop (cdr ls) (string-append str "-" (symbol->string (car ls)))))))
09:     
10:     ;;; obj -> ls -> integer
11:     ;;; returns position of obj in ls
12:     (define (position obj ls)
13:       (letrec ((iter (lambda (i ls)
14:                (cond
15:                 ((null? ls) #f)
16:                 ((eq? obj (car ls)) i)
17:                 (else (iter (1+ i) (cdr ls)))))))
18:         (iter 0 ls)))
19:                          
20:     
21:     ;;; list -> integer -> list
22:     ;;; enumerate list items
23:     (define (slot-enumerate ls i)
24:       (if (null? ls)
25:           '()
26:         (cons `((,(car ls)) ,i) (slot-enumerate (cdr ls) (1+ i)))))
27:     
28:     ;;; define simple structure 
29:     (define-syntax defstruct
30:       (sc-macro-transformer
31:        (lambda (exp env)
32:          (let ((struct (second exp))
33:                (slots  (map (lambda (x) (if (pair? x) (car x) x)) (cddr exp)))
34:            (veclen (- (length exp) 1)))
35:            
36:            `(begin   
37:           (define ,(string->symbol (append-symbol 'make struct))   ; making instance
38:             (lambda ls
39:                   (let ((vec (vector ',struct ,@(map (lambda (x) (if (pair? x) (second x) #f)) (cddr exp)))))
40:             (let loop ((ls ls))
41:               (if (null? ls)
42:                   vec
43:                   (begin
44:                            (vector-set! vec (case (first ls) ,@(slot-enumerate slots 1)) (second ls))
45:                 (loop (cddr ls))))))))
46:     
47:           (define ,(string->symbol (string-append (symbol->string struct) "?"))  ; predicate
48:             (lambda (obj)
49:               (and
50:                (vector? obj)
51:                (eq? (vector-ref obj 0) ',struct))))
52:     
53:           ,@(map
54:              (lambda (slot)
55:                (let ((p (1+ (position slot slots))))
56:              `(begin
57:                 (define ,(string->symbol (append-symbol struct slot))    ; accessors
58:                   (lambda (vec)
59:                 (vector-ref vec ,p)))
60:     
61:                 (define-syntax ,(string->symbol                           ; modifier
62:                          (string-append
63:                           (append-symbol 'set struct slot) "!"))
64:                   (syntax-rules ()
65:                 ((_ s v) (vector-set! s ,p v)))))))
66:              slots)
67:     
68:           (define ,(string->symbol (append-symbol 'copy struct))      ; copier
69:             (lambda (vec)
70:               (let ((vec1 (make-vector ,veclen)))
71:             (let loop ((i 0))
72:               (if (= i ,veclen)
73:                   vec1
74:                   (begin
75:                 (vector-set! vec1 i (vector-ref vec i))
76:                 (loop (1+ i)))))))))))))

下面演示了如何使用：

你可以定义一个结构体，要么只给出槽（slot）的名字，要么给出槽（slot）的名字和缺省值。

;;; Defining a structure point having 3 slots whose defaults are 0.0.
(defstruct point (x 0.0) (y 0.0) (z 0.0))
;Unspecified return value

(define p1 (make-point 'x 10 'y 20 'z 30))
;Value: p1

(point? p1)
;Value: #t

(point-x p1)
;Value: 10

;;; Default values are used for unspecified values when an instance is made.
(define p2 (make-point 'z 20))
;Value: p2

(point-x p2)
;Value: 0.

(point-z p2)
;Value: 20

;;; Changing a slot value
(set-point-y! p2 12)
;Unspecified return value

;;; The reality of the structure definde by [code 8] is a vector
p2
;Value 14: #(point 0. 12 20)

;;; Defining a structure 'book' with no default values.
(defstruct book title authors publisher year isbn)
;Unspecified return value

(define mon-month 
  (make-book 'title  
         "The Mythical Man-Month: Essays on Software Engineering"
         'authors
         "F.Brooks"
         'publisher
         "Addison-Wesley"
         'year
         1995
         'isbn
         0201835959))
;Value: mon-month

mon-month
;Value 15: #(book 
"The Mythical Man-Month: Essays on Software Engineering" 
"F.Brooks" 
"Addison-Wesley" 
1995 
201835959)

(book-title mon-month)
;Value 13: "The Mythical Man-Month: Essays on Software Engineering"

小结

我简要介绍了Scheme里的宏。宏可以使你的代码更优雅。

syntax-rules使得编写宏很容易。另一方面，编写Common Lisp的宏，则要求特点的技巧。

继续

简介

本章介绍的是Scheme中特有的数据类型——继续（Continuation）。由于其他程序设计语言并没有这种数据类型，因此它难于理解。当下，你并不需要彻底理解清楚，只需要大致了解。

我会讲解广义的继续和简短地介绍Continuation-Passing-Style(CPS)，然后再讲解Scheme中的继续。我认为通过这种方式理解继续会比较容易。

广义继续

继续是在返回到顶层（Top level）之前所需要执行的计算。实际上，继续存在于计算的每时每刻。以(* 3 (+ 1 2))为例，在求值完(+ 1 2)后，应该计算{ (* 3 []) }乘以3。然而，大多数语言都不显式地这么做，程序员对此并不熟悉。

Continuation-Passing-Style(CPS)

简单的CPS

CPS是一种编程风格，在这种风格中，把依赖于当前函数结果的后续函数作为参数传递给当前函数。[代码1]展示了以CPS编写的加法和乘法。在k+和k*中，k是后续函数。

[代码1]

(define (return x)
  x)

(define (k+ a b k)
  (k (+ a b)))

(define (k* a b k)
  (k (* a b)))

[例1]演示了如何使用CPS计算(* 3 (+ 1 2))。

[例1]

(k+ 1 2 (lambda (x) (k* x 3 return)))

Scheme的普通形式中，值在括号内被计算并向括号外传递。与此相反，CPS中，值向括号内传递。如[例1]中，k+把(+ 1 2)的值传递给(lambda (x) (k* x 3 return))，而k*把(* (+ 1 2) 3)的结果传给return。

以CPS编写递归函数

递归函数同样可以以CPS编写。[代码2]展示了计算阶乘的函数如何用普通方式编写（fact）和以CPS编写(kfact)。

[代码2]

;;; normal factorial
(define (fact n)
  (if (= n 1) 
      1
      (* n (fact (- n 1)))))

;;; CPS factorial
(define (kfact n k)
  (if (= n 1) 
      (k 1)
      (kfact (- n 1) (lambda (x) (k (* n x))))))

[例2]将3与4的阶乘相加。

[例2]

;;; normal
(+ 3 (fact 4))

;;; CPS
(kfact 4 (lambda (x) (k+ x 3 return)))

[代码3]演示了如何分别用普通方式和CPS编写计算表中元素之积的函数。在CPS函数中，后继函数存储在局部变量break中，因此当元素乘以0时，可以立即退出。

[代码3]

;;; normal
(define (product ls)
  (let loop ((ls ls) (acc 1))
    (cond
     ((null? ls) acc)
     ((zero? (car ls)) 0)
     (else (loop (cdr ls) (* (car ls) acc))))))

;;; CPS
(define (kproduct ls k)
  (let ((break k))
    (let loop ((ls ls) (k k))
      (cond
       ((null? ls) (k 1))
       ((zero? (car ls)) (break 0))
       (else (loop (cdr ls) (lambda (x) (k (* (car ls) x)))))))))

[例3]将100与'(2 4 7)的积相加。

[例3]

;;; normal
(+ 100 (product '(2 4 7)))

;;; CPS
(kproduct '(2 4 7) (lambda (x) (k+ x 100 return)))

尽管CPS在这样简单的情况中并不实用，但在一些像是自然语言解析和逻辑编程等复杂程序中非常有用，因为与通常的编程风格相比，CPS可以更灵活地改变后续过程。

异常处理（Exception handling）就是这种情况的简单例子。[代码4]演示了kproduct的错误处理版本，程序中当非数字值出现在输入表中，在其被打印时，计算就会终止。

(define (non-number-value-error x)
  (display "Value error: ")
  (display  x)
  (display " is not number.")
  (newline)
  'error)

(define (kproduct ls k k-value-error)
  (let ((break k))
    (let loop ((ls ls) (k k))
      (cond
       ((null? ls) (k 1))
       ((not (number? (car ls))) (k-value-error (car ls)))
       ((zero? (car ls)) (break 0))
       (else (loop (cdr ls) (lambda (x) (k (* (car ls) x)))))))))
;;; valid
(kproduct '(2 4 7) 
      (lambda (x) (k+ x 100 return)) 
      non-number-value-error)
;Value: 156

;;; invalid
(kproduct '(2 4 7 hoge) 
      (lambda (x) (k+ x 100 return)) 
      non-number-value-error)
Value error: hoge is not number.
;Value: error

Scheme中的继续

通过上面的讲解，你应该掌握了继续（continuation）。继续有下面的性质：

1. 存在于整个计算过程中；
2. 函数式程序设计语言和CPS可以显式地处理它。

另外，上面例子展示的是闭包链（Chain of closure）。

然而，阅读和编写CPS程序是痛苦的，以常规方式来处理继续会更方便一点。

因此，Scheme中将继续实现为一级对象（first class object）（这意味这Scheme中的继续是个普通数据类型），任何时候都可以通过名为call-with-current-continuation来调用。由于继续是普通数据类型，你可以随心所欲地重用。考虑到call-with-current-continuation名字过长，通常使用其缩略名call/cc。

(define call/cc call-with-current-continuation)

函数call-with-current-continuation (call/cc)接受一个参数。该参数是一个函数，函数的参数接收当前继续。

下面是例子：

(* 3 (call/cc (lambda (k) (+ 1 2))))     ;⇒ 9      ; [1]
(* 3 (call/cc (lambda (k) (+ 1 (k 2))))) ;⇒ 6      ; [2]

在情况[1]中，继续并没有被调用，语句的行为与普通S-表达式相同。另一方面，在情况[2]中，继续以2作为参数被调用。在这种情况中，继续的参数跳过了call/cc的处理，并逃逸至call/cc的外部。这种情况中，k是一个一元函数，等价于(lambda (x) (* 3 x))。

大体来说，当前继续存储了从call/cc调用点到顶层的处理过程。当前继续可以像其它数据类型那样被存储起来，并随心所欲地重用。

(define cc)
  (* 3 (call/cc (lambda (k)
                  (set! cc k)
                  (+ 1 2))))

由于当前继续是回到顶层的处理过程，它的返回会忽略周围的S-表达式。

(+ 100 (cc 3))  ;⇒ 9 
(+ 100 (cc 10)) ;⇒ 30

使用call/cc抛出值

从一个计算过程中逃逸出来，是使用当前继续的最容易的方法。[代码5]演示了搜索树（嵌套表）的函数。如果函数在树中找到obj，那么它返回该对象，否则返回#f。一旦找到obj，函数直接将其抛出至最外部。

(define (find-leaf obj tree)
  (call/cc
    (lambda (cc)
       (letrec ((iter
                   (lambda (tree)
                      (cond
                        ((null?  tree) #f)
                        ((pair? tree)
                           (iter (car tree))
                           (iter (cdr tree)))
                        (else
                          (if (eqv? obj tree)
                            (cc obj)))))))
         (iter tree)))))
(find-leaf 7 '(1 (2 3) 4 (5 (6 7))))
;⇒ 7

(find-leaf 8 '(1 (2 3) 4 (5 (6 7))))
;⇒ ()

[例6]演示了一个支持抛出的语法block。

(define-syntax block
  (syntax-rules ()
    ((_ tag e1 ...)
     (call-with-current-continuation
       (lambda (tag)
          e1 ...)))))

[例7]演示了如何使用它。

(block break
   (map (lambda (x)
           (if (positive? x)
           (sqrt x)
           (break x)))
    '(1 2 3)))
;⇒ (1 1.4142135623730951 1.7320508075688772)

(block break
   (map (lambda (x)
           (if (positive? x)
           (sqrt x)
           (break x)))
    '(1 -2 3)))
;⇒ -2

生成器

我会讲解如何用call/cc实现一个树匹配的生成器。生成器以一个树为参数返回一个函数，每次调用这个返回的函数时，它会返回后续的叶子。你可以在Teach Yourself Scheme in Fixnum Days的第13.3节中找到这个函数的原始版本。生成器的使用方法如下：

(define tr '((1 2) (3 (4 5))))
(define p (leaf-generator tr))

(p) ;=> 1
(p) ;=> 2
(p) ;=> 3
(p) ;=> 4
(p) ;=> 5
(p) ;=> ()  ; finally it returns '()

[代码6]给出了生成器的定义。这个和原始版本基本上相同，但有略微的修改。

[代码6]

(define (leaf-generator tree)
  (let ((return '()))                                               ; 1
    (letrec ((continue                                              ; 2
      (lambda ()
        (let rec ((tree tree))                                      ; 3
          (cond                                                     ; 4
           ((null? tree) 'skip)                                     ; 5
           ((pair? tree) (rec (car tree)) (rec (cdr tree)))         ; 6
           (else                                                    ; 7
            (call/cc (lambda (lap-to-go)                            ; 8
                   (set! continue (lambda () (lap-to-go 'restart))) ; 9
                   (return tree))))))                               ;10
        (return '()))))                                             ;11
    (lambda ()                                                  ;12
      (call/cc (lambda (where-to-go)                            ;13
                 (set! return where-to-go)                      ;14
                 (continue)))))))

(译者注：原文中05，08行中命名let中的rec被写为loop，结合上下文，改为rec)

注释解释

编号 解释

• 1.定义本地变量return。
• 2.使用letrec定义continue。continue将当前叶子返回到前面，将当前继续赋给continue，并停止。
• 3.用rec定义命名let。
• 4.使用cond实现分支
• 5.如果是空表，什么也不做
• 6.如果是序对，递归地将序对的car和cdr应用于rec。
• 7.如果是叶子，
• 8.调用call/cc以获取当前状态(lap-to-go)
• 9.接着将当前状态赋给continue。所以除了原有的continue，lap-to-go也包含了当前状态。简而言之，它可以被如下的S-表达式中的[ ]表示。

(lambda ()
   (let rec ((tree tree0))  
      (cond                  
        ((null? tree) '())     
        ((pair? tree) (rec (car tree)) (rec (cdr tree)))  
        (else                                            
           [ ]
    (return '()))))

调用lap-to-go意味着(car tree)是叶子，且过程结束了，(rec (cdr tree))在下一次函数调用时开始运行。如果过程在[ ]之后结束，继续的参数将不起作用。

• 10.接着函数将找到的叶子返回到函数的调用处。(return tree)应该在call/cc中以重启过程。
• 11.在搜索了全部叶子之后返回空表。
• 12.这是一个返回叶子生成器的生成器。
• 13.首次调用call/cc
• 14.将表示返回值的当前状态赋给return。
• 15.然后调用continue。

由leaf-generator生成的函数的行为可以通过函数tree-traverse的行为来估计。过程停止在轨迹的’*’的注释处，并使得过程存储在continue。

一个常规的遍历函数：

(define tree-traverse
  (lambda (tree)
    (cond
     ((null? tree) '_)
     ((pair? tree) (tree-traverse (car tree)) (tree-traverse (cdr tree)))
     (else
      (write tree)))))

当树为'((1 2) 3)时，tree-traverse的轨迹。

> (tree-traverse '((1 2) 3))
|(tree-traverse ((1 2) 3))
| (tree-traverse (1 2))
| |(tree-traverse 1)           
1| |#< void>               ; *
| (tree-traverse (2))
| |(tree-traverse 2)           
2| |< void>                ; *
| (tree-traverse '())
| _
|(tree-traverse (3))
| (tree-traverse 3)            
3| #< void>                ; *
|(tree-traverse '())
|_
_

协程

因为继续记录了后续计算过程，因此，用于多任务同时执行的协程（Coroutine）可以使用继续来实现。

代码片段7展示了一段交替打印数字和字母的程序。5 - 22行是队列的实现。(enqueue! queue obj)将一个obj添加在队列的末尾。(dequeue! queue)返回队列第一个元素并将它删除。

26 - 38行是协程的实现。

process-queue

过程的队列。

(coroutine thunk)

在process-queue末尾添加thunk。

(start)

取得process-queue的第一个过程并执行它。

(pause)

将当前继续添加到process-queue的末尾并执行队列里的第一个过程。这个函数将控制权交给另外一个协程。

42 - 61行显示如何使用它。一个显示数字例程和一个显示字母例程相互调用对方，结果显示在例7

01:     ;;; abbreviation
02:     (define call/cc call-with-current-continuation)
03:     
04:     ;;; queue
05:     (define (make-queue)
06:       (cons '() '()))
07:     
08:     (define (enqueue! queue obj)
09:       (let ((lobj (list obj)))
10:         (if (null? (car queue))
11:         (begin
12:           (set-car! queue lobj)
13:           (set-cdr! queue lobj))
14:         (begin
15:           (set-cdr! (cdr queue) lobj)
16:           (set-cdr! queue lobj)))
17:         (car queue)))
18:     
19:     (define (dequeue! queue)
20:       (let ((obj (car (car queue))))
21:         (set-car! queue (cdr (car queue)))
22:         obj))
23:     
24:     
25:     ;;; coroutine   
26:     (define process-queue (make-queue))
27:     
28:     (define (coroutine thunk)
29:       (enqueue! process-queue thunk))
30:     
31:     (define (start)
32:        ((dequeue! process-queue)))
33:        
34:     (define (pause)
35:       (call/cc
36:        (lambda (k)
37:          (coroutine (lambda () (k #f)))
38:          (start))))
39:     
40:     
41:     ;;; example
42:     (coroutine (lambda ()
43:              (let loop ((i 0)) 
44:                (if (< i 10)
45:                (begin
46:                  (display (1+ i)) 
47:                  (display " ") 
48:                  (pause) 
49:                  (loop (1+ i)))))))
50:                
51:     (coroutine (lambda ()
52:              (let loop ((i 0)) 
53:                (if (< i 10)
54:                (begin
55:                  (display (integer->char (+ i 97)))
56:                  (display " ")
57:                  (pause) 
58:                  (loop (1+ i)))))))
59:     
60:     (newline)
61:     (start)
(load "cor2.scm")
;Loading "cor2.scm"
1 a 2 b 3 c 4 d 5 e 6 f 7 g 8 h 9 i 10 j  -- done
;Unspecified return value

小结

本章中，我讲解了继续。

理解这些概念可能比较困难。但不要担心，有朝一日你终会明白。

下一章中，我将介绍惰性求值。

惰性求值

简介

惰性求值（Lazy evaluation）是在需要时才进行求值的计算方式。惰性求值自然地在数据结构中包含递归，可以以简单的方式表示无限的概念，这种方式有利于程序的模块化。

你可以从《Why Functional Programming Matters》中知晓惰性计算可以带来哪些好处。

Haskell语言以采用惰性求值而广为人熟知。Scheme也部分采用了惰性求值。

用于惰性求值的函数

下面这些用于处理惰性求值的函数是在R5RS中定义的。中间状态被称为延时对象（promise），它表示求值方法已经定义好了，但求值还未执行。最终的值通过对延时对象（promise）调用force被计算出来。

(delay proc)

以proc创建一个延时对象（promise）。

(promise? obj)

如果obj是一个延时对象就返回 #t。

(force promise)

对延时对象求值，执行求值操作。

惰性求值的简单例子

[例1]展示一个惰性求值的简单例子。在这个例子中，延时对象（promise）通过对(1 + 2)调用delay产生，然后通过函数force对延时对象求值。

[例1]

(define laz (delay (+ 1 2)))
;Value: laz

laz
;Value 11: #[promise 11]

(promise? laz)
;Value: #t

(force laz)
;Value: 3

(* 10 (force laz))
;Value: 30

注意延时对象并没有被force消费掉，这意味着函数force没有副作用。因此，你可以重复使用延时对象。

使用惰性求值表示无限序列

现在，让我们使用惰性求值创建无限序列。首先，我将定义一些用于处理无限序列的基本函数。然后，我会使用这些函数创建无限序列，并将无限序列用于数值计算。

无限序列可以用如表达式（1）的cons单元（cons cell）的嵌套结构表示。cons单元的car和cdr分别是最终值和延时对象（promise）。另一个表达式（1）结构的cons单元通过强制求值cdr部分产生，你可以无限重复这个过程，就像图 1。这个和cons单元的嵌套结构和普通表类似，只是使用延时对象作为cdr部分使其可以表示无限序列。

    (<val> . <promise>)    (1)

图 1. 无限序列的实现，使用了car和cdr分别为最终值和延时对象的cons单元。

无限序列的基本函数和宏

[代码 1]展示了无限序列的基本函数和宏。其中最重要的是lazy-map，被用于操作无限序列。

由于lazy-map包含一个特殊delay构造用于延迟求值，所以它需要被定义为宏。

[代码 1]

01:     ;;;;; basic functions and a macro
02:     
03:     ;;; car for lazy evaluation
04:     (define lazy-car car)
05:     
06:     ;;; cdr for lazy evaluation
07:     (define (lazy-cdr ls)
08:       (force (cdr ls)))
09:     
10:     ;;; lazy cons
11:     (define-syntax lazy-cons
12:        (syntax-rules ()
13:           ((_ a b) (cons a (delay b)))))
14:     
15:     ;;; lazy map
16:     (define (lazy-map fn . lss)
17:       (if (memq '() lss)
18:           '()
19:         (lazy-cons (apply fn (map lazy-car lss))
20:                    (apply lazy-map fn (map lazy-cdr lss)))))
21:     
22:     ;;; lazy filter
23:     (define (lazy-filter pred ls)
24:       (if (null? ls)
25:           '()
26:         (let ((obj (lazy-car ls)))
27:           (if (pred obj)
28:               (lazy-cons obj  (lazy-filter pred (lazy-cdr ls)))
29:             (lazy-filter pred (lazy-cdr ls))))))
30:     
31:     ;;; returns n-th item of the lazy list
32:     (define (lazy-ref ls n)
33:       (if (= n 0)
34:           (lazy-car ls)
35:         (lazy-ref (lazy-cdr ls) (- n 1))))
36:     
37:     ;;; returns first n items of the ls
38:     (define (head ls n)
39:       (if (= n 0)
40:           '()
41:          (cons (lazy-car ls) (head (lazy-cdr ls) (- n 1)))))

(lazy-car ls)

和(car ls)一样，因为car部分是最终值。

(lazy-cdr ls)

计算ls的cdr部分（延时对象）的‘最终’值。

(lazy-cons a b)

这是一个扩展了(cons a (delay b))的宏。如果这个操作被定义为一个函数，b将立刻求值，这样delay就没有任何意义了。

(lazy-map fn . lss)

这是一个惰性求值的map函数，是在[代码 1]中最重要的函数。注意它返回一个包含最终值（car部分）和延时对象（cdr部分）的cons单元。

(lazy-filter pred ls)

这是一个惰性求值的filter函数。它过滤ls并返回一个由包含满足pred条件的元素组成的‘无限序列’。

(lazy-ref ls n)

返回‘无限序列’ls的第n个元素。

(head ls n)

返回ls（惰性求值表）的前n个元素。

无限序列

无限序列可以简洁地用lazy-cons和lazy-map表示。我会展示两个例子：

• 下一项由前一项定义的序列，如等差数列和等比数列。
• 菲波那契数列。

下一个项由前一项定义的序列

下一个项由前一项定义的序列可以有如下形式的函数（f）定义：

[{a}_{i+1} = f({a}_i) ]

可以表示为[代码2]里的(inf-seq a0 f)，a0和f分别是初始项和用于计算随后项的函数。

(inf-seq a0 f)是递归定义的，它的定义清晰表明初始项是a0，第二项是(f a0)，(n+1)项由(f an)表示。

等差和等比数列分别被定义为(ari a0 d)和(geo a0 r)，其中a0，d和r分别是初始值，公差，公比。这些函数使用函数inf-seq定义。

[代码2]

01:     ;;;;  sequences
02:     
03:     ;;; infinite sequences represented by a_(n+1) = f(a_n)
04:     (define (inf-seq a0 f)
05:       (lazy-cons a0 (inf-seq (f a0) f)))
06:     
07:     ;;; arithmetic sequence
08:     (define (ari a0 d)
09:       (inf-seq a0 (lambda (x) (+ x d))))
10:     
11:     ;;; geometric sequence
12:     (define (geo a0 r)
13:       (inf-seq a0 (lambda (x) (* x r))))

让我们检查一下inf-seq所产生的无限序列（例2）。创建两个等比数列：

1. g1，初始值1，公比为2。
2. g2，初始值1，公比为1/2。

然后使用head求值前10项。你将看到正确产生了两个等比数列。

接下来，使用lazy-map计算g1和g2的乘积，并使用head求值前10项。你将看到一个全是1的序列，这表明计算被正确地执行了。

现在，让我们用等差数列和lazy-filter娱乐一番。首先，用(ari 1 1)创建一个等比数列ar1。(head ar1 10)的结果显示等比数列 (1 2 3 ....) 是由 (ari 1 1) 产生的。然后使用lazy-filter取出ar1里的偶数，并使用head求值前10项。你将看到(2 4 6 8 10 12 14 16 18 20)，这表明lazy-filter正常工作。

[例2]

(define g1 (geo 1 2))
;Value: g1

(define g2 (geo 1 (/ 1 2)))
;Value: g2

(head g1 10)
;Value 12: (1 2 4 8 16 32 64 128 256 512)

(head g2 10)
;Value 13: (1 1/2 1/4 1/8 1/16 1/32 1/64 1/128 1/256 1/512)

(head (lazy-map * g1 g2) 10)
;Value 14: (1 1 1 1 1 1 1 1 1 1)

(define ar1 (ari 1 1))
;;Value: ar1

(head ar1 10)
;;Value 15: (1 2 3 4 5 6 7 8 9 10)

(head (lazy-filter even? ar1) 10)
;;Value 16: (2 4 6 8 10 12 14 16 18 20)

菲波那切数列

菲波那切数列定义如下：

fib(1) = 1
fib(2) = 1
fib(n+1) = fib(n) + fib(n-1)

代码3展示了Scheme实现的菲波那切数列，用到了lazy-cons和lazy-map。如代码所示，Scheme里的定义和数学上的定义很相似。此外，各个项的计算的复杂度为O(n)。

[例3]中，值被立刻计算出来了。

[代码 3]

01:     (define fib
02:       (lazy-cons 1
03:                  (lazy-cons 1
04:                             (lazy-map + fib (lazy-cdr fib)))))

[例 3]

(head fib 20)
;Value 12: (1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765)

(lazy-ref fib 100)
;Value: 573147844013817084101

将惰性求值用于数值计算

下面是《Why Functional Programming Matters》里相关代码的Schme版本。也可以查看SICP 3.5. Stream惰性计算在数值计算中的应用。

牛顿-拉夫逊法求平方根

牛顿-拉夫逊法可以使用初始值a0和等式（2）计算N的平方根。

     a(n+1) =  (a(n) + N/a(n)) / 2                   (2)

如果等式（2）收敛到最终值 a，

      a =  (a +  N/a) / 2
⇒
      2a = a +  N/a
      a =  N/a
      a*a = N
      a =  √N

，这表明最终值a是N的平方根。序列的下一项是前一项的函数（如等式（2）所示），这些序列可用inf-seq表示。

代码4展示了一个计算平方根的程序。在代码4中，初始值被定为1，由于序列收敛很快，所以这没问题。

[代码4]

01:     ;;; Newton-Raphson method
02:     (define (newton-raphson n)
03:       (inf-seq 1 (lambda (x) (/ (+ x (/ n x)) 2))))
04:     
05:     ;;; returning a reasonable answer.
06:     ;;; If the ratio of successive terms is in (1 - eps) and (1 + eps),
07:     ;;; or the following term is zero,
08:     ;;; the function returns it.
09:     (define (lazylist->answer ls eps)
10:       (let ((e1 (- 1.0 eps))
11:             (e2 (+ 1.0 eps)))
12:         (let loop ((val (lazy-car ls))
13:                    (ls1 (lazy-cdr ls)))
14:           (let ((val2 (lazy-car ls1)))
15:             (if  (or (zero? val2) (< e1 (/ val val2) e2))
16:                 (exact->inexact val2)
17:               (loop val2 (lazy-cdr ls1)))))))
18:     
19:     ;;;
20:     (define (my-sqrt n eps)
21:       (lazylist->answer (newton-raphson n) eps))

(newton-raphson n)

一个函数，创建平方根近似值的表。

(lazylist->answer ls eps)

检查收敛是否满足条件了。如果是的，返回数值计算的结果。

如果(1 - eps) < t2/t1 < (1 + eps) 或者 t2 = 0，函数返回 ls 的后续项（即 t1 和 t2）的第二项。

(my-sqrt n eps)

在相对误差eps下，计算n的平方根。

(my-sqrt 9 0.0000001)
;Value: 3.

数值微分

[代码5]中的easydiff是一种计算数字积分的简单方式，其中f，x，和h分别是被积分的函数，x值，和Δx。理论上，如果h越趋于0，获得的近似值越好。但在实践中，由于数值在计算机里的精度是有限的，微小的h值会导致错误。

为了解决这个问题，我们用lazylist-diff创建h的惰性表。这个惰性表是初始值为h0，公比为0.5的等比数列。然后我们创建一个对应于h的惰性表的近似值的惰性表。

可以通过如下代码加快收敛速度，更快得到答案：

(lazylist->answer (lazylist-diff h0 f x) eps)

函数super是收敛加速函数。可以查看《Why Functional Programming Matters》的关于加速技术部分。如果你使用了传统编程语言，加速计算会相当复杂。相反，使用惰性求值可以以简单的方式实现。此外，因为高度的模块化，你可以在其他问题中复用代码，例如数值积分（4.3.3节）。代码6复用了代码5中的加速函数。

[代码5]

01:     ;;; differentiation
02:     
03:     ;;; primitive function for differentiation
04:     (define (easydiff f x h)
05:       (/ (- (f (+ x h)) (f x)) h))
06:     
07:     ;;; create a lazy list of approximation for differentiation
08:     (define (lazylist-diff h0 f x)
09:       (lazy-map (lambda (h) (easydiff f x h)) (geo h0 0.5)))
10:     
11:     ;;; eliminate error from the approximation
12:     (define (elimerror n ls)
13:       (let ((a (lazy-car ls))
14:             (b (lazy-second ls))
15:             (c (fix:lsh 1 n)))   ; (expt 2 n)
16:         (lazy-cons
17:          (/ (- (* b c) a) (- c 1))
18:          (elimerror n (lazy-cdr ls)))))
19:     
20:     ;;; estimate `n' in elimerror
21:     (define (order ls)
22:       (let* ((a (lazy-car ls))
23:              (b (lazy-second ls))
24:              (c (lazy-ref ls 2))
25:              (d (- (/ (- a c) (- b c)) 1.0)))
26:         (cond
27:          ((< d 2) 1)
28:          ((<= 2 d 16) (inexact->exact (round (log2 d))))
29:          (else 4))))
30:     
31:     ;;;
32:     (define (log2 x)
33:       (/ (log x) (log 2)))
34:     
35:     ;;; improve convergence of the lazy list of the approximation
36:     (define (improve ls)
37:       (elimerror (order ls) ls))
38:     
39:     ;;; return the second value of the lazy list
40:     (define (lazy-second ls)
41:       (lazy-car (lazy-cdr ls)))
42:     
43:     ;;; further improve the convergence of the list
44:     (define (super ls)
45:       (lazy-map lazy-second (inf-seq ls improve)))
46:                 
47:     
48:     ;;; calculate the differentiation of function `f' at x within error eps
49:     ;;; h0 is initial window width
50:     (define (diff f x h0 eps)
51:       (lazylist->answer (super (lazylist-diff h0 f x)) eps))
(diff sin 0.0 0.1 0.0000001)
;Value: .9999999999999516

(diff exp 0.0 0.1 0.000001)
;Value: .9999999991733471

数值积分

收敛加速函数无需任何修改即可被用于数值积分。最开始，我们使用easyintegrate创建一个粗略的近似。函数lazylist-integrate使用惰性表，通过递归地调用easyintegrate在中间点切分区间，来改进近似值。函数可以用lazy-map以简单的方式定义。最终，收敛被加速，收敛值由函数integrate返回。

[代码6]

01:     ;;; integration
02:     
03:     ;;; primitive integration
04:     (define (easyintegrate f a b)
05:       (* (/ (+ (f a) (f b)) 2) (- b a)))
06:     
07:     ;;; create the lazy list of approximation for integration
08:     (define (lazylist-integrate f a b)
09:       (let ((mid (/ (+ a b) 2)))
10:         (lazy-cons (easyintegrate f a b)
11:                    (lazy-map + (lazylist-integrate f a mid)
12:                                (lazylist-integrate f mid b)))))
13:     
14:     ;;; integrate function `f' in a range of `a' and `b' within error `eps'
15:     (define (integrate f a b eps)
16:       (lazylist->answer (super (lazylist-integrate f a b)) eps))
(define pi (* 4 (atan 1)))
;Value: pi

(integrate sin 0 pi 0.0000001)
;Value: 2.000000002272428

(integrate exp 0 1 0.0000001)
;Value: 1.7182818277724858

(- (exp 1) 1)
;Value: 1.718281828459045

小结

惰性求值允许我们以简洁的方式将重复包含在数据结构中。这个功能有利于程序的模块化，可使代码更为紧凑。

查看网页Haskell可以了解更多关于惰性求值的内容。

你可以在这儿下载本页中出现代码。

非确定性

介绍

非确定性是一种通过仅定义问题来解决问题的算法。非确定性程序自动选择符合条件的选项。这项技术很适合逻辑编程。

例如，以下代码返回一对数，其和是一个质数。其中一个数从'(4 6 7)选取，另一个从'(5 8 11)选取。

(let ((i (amb 4 6 7))
      (j (amb 5 8 11)))
  (if (prime? (+ i j))
      (list i j)
      (amb)))
;Value 23: (6 5)

(amb 4 6 7) 从4，6和7中返回一个合适的数，(amb 5 8 11)从5，8和11中返回一个合适的数。如果没有选出合适的值，(amb)返回假。

实际上，amb做了深度优先搜索。(amb c1 c2 c3 ...)创建了搜索路径依次检查c1，c2，c3，…并回溯。因此，非确定性是一种帮程序隐藏搜索的抽象。一旦我们有了amb，我们可以很容易地编写程序而无需思考计算机做了什么。

非确定性的实现

使用在非确定性中的回溯被实现为连接到继续（continuation）的闭包链。这个链被一个全局参数fail表示，该参数是一个复写自己的函数。

函数实现

第一步，我使用函数（名为choose）实现非确定性，演示于[代码1]。我首先定义一个全局参数fail，它的初始值是一个将返回no-choice到顶层的函数（22-26行）。然后通过在函数choose中重新定义fail实现闭包链。回溯通过调用之前的fail实现。

函数choose有如下行为：

1. 如果没有选项，调用(fail)。
2. 如果有任何选项，
   1. 将fail储存为fail0，并调用当前继续（continuation）。
   2. 在继续（continuation）中重新定义fail。fail重新被赋值回存在fail0里的原值，并对余下的选项应用（apply）choose。
   3. 返回第一个选项到继续（continuation）外面。

[代码1]

;;; abbreviation for call-with-current-continuation
(define call/cc call-with-current-continuation)

;;; This function is re-assigned in `choose` and `fail` itself.
(define fail #f)

;;; function for nondeterminism
(define (choose . ls)
  (if (null? ls) 
    (fail)
    (let ((fail0 fail))
      (call/cc
        (lambda (cc)
          (set! fail (lambda ()
                       (set! fail fail0)
                       (cc (apply choose (cdr ls)))))
          (cc (car ls)))))))

;;; write following at the end of file
;;; initial value for fail
(call/cc 
  (lambda (cc)
    (set! fail (lambda ()
                 (cc 'no-choice)))))

让我们看看choose是否可以找到毕达哥拉斯三元组。函数pythag用于寻找三元组。如果找到了，它返回一个表。如果没有找到，调用无参数的choose，以回溯。

[例1]

(define (sq x)
  (* x x))
;Value: sq

;;; Pythagorean triples
(define (pythag a b c)
  (if (= (+ (sq a) (sq b)) (sq c))
      (list a b c)
      (choose)))
;Value: pythag

(pythag (choose 1 2 3) (choose 3 4 5) (choose  4 5 6))
;Value 16: (3 4 5)

宏实现

为了对S-表达式使用非确定性操作，必须把操作定义为宏。例如，[例2]中所示函数an-integer-starting-from应该返回一个大于或等于n的整数，但是如果choose被以函数形式定义，它将不能正常工作，因为参数会立即求值。

[例2]

(define (an-integer-starting-from n)
  (choose n (an-integer-starting-from (1+ n))))
;Value: an-integer-starting-from

(an-integer-starting-from 1)
;Aborting!: maximum recursion depth exceeded

为了解决这一点，我们定义了一个和[代码1]中定义一致但使用非确定性宏amb实现的choose。这个宏amb有和choose一样的递归调用自己的结构。

[代码1]中的1-5行和20-26行在下面的代码中得以重用。

[代码2]使用MIT-Scheme编译时，编译器给出如下警告：

;Warning: Possible inapplicable operator ()

但是代码可以正常工作。这些代码在Petite Chez Scheme下也可以运行。即使我没有试过其他Scheme实现，我认为amb的定义可以工作，只要它们遵守R5RS。你可以在这里下载一个为MIT-Scheme做的专门实现。MIT-Scheme编译器不会对这个专门实现提出警告。

[代码2]

;;; nondeterminism macro operator
(define-syntax amb
  (syntax-rules ()
    ((_) (fail))
    ((_ a) a)
    ((_ a b ...)
     (let ((fail0 fail))
       (call/cc
    (lambda (cc)
      (set! fail
        (lambda ()
          (set! fail fail0)
          (cc (amb b ...))))
      (cc a)))))))

宏定义，amb，在参数为S-表达式时也和其他值一样正常工作。

[例3]

(define (an-integer-starting-from n)
  (amb n (an-integer-starting-from (1+ n))))
;Value: an-integer-starting-from

(an-integer-starting-from 1)
;Value: 1

(amb)
;Value: 2

(amb)
;Value: 3

在Teach Yourself Scheme in Fixnum Days 和Dave Hername Code中的amb实现使用',@(map ...)'展开参数。即使它们是直截了当的定义，但由于使用了两次call/cc，它们某种程度上仍很复杂。[代码2]所示的递归定义更简单，即使展开的S-表达式会很复杂。

应用于逻辑编程，使程序更简洁

[代码3]演示了非确定性应用逻辑编程，使得程序更简洁

[代码3]

01:     ;;; returning all possibilities
02:     (define-syntax set-of
03:       (syntax-rules () 
04:         ((_ s) 
05:           (let ((acc '())) 
06:             (amb (let ((v s)) 
07:                    (set! acc (cons v acc)) 
08:                    (fail)) 
09:                  (reverse! acc))))))
10:     
11:     ;;; if not pred backtrack
12:     (define (assert pred)
13:       (or pred (amb)))
14:     
15:     ;;; returns arbitrary number larger or equal to n
16:     (define (an-integer-starting-from n)
17:       (amb n (an-integer-starting-from (1+ n))))
18:     
19:     ;;; returns arbitrary number between a and b
20:     (define (number-between a b)
21:       (let loop ((i a))
22:         (if (> i b)
23:             (amb)
24:           (amb i (loop (1+ i))))))

(set-of s)

返回满足s的所有可能性。宏的行为如下：

1. （第5行）一个表（acc）被定义，它有所欲哦满足s的结果。
2. （第6行）s的结果被赋给v，并加入到acc。如果结果没有带上v而直接被加入（如 (set! acc (cons s acc))），则会因为s使用了继续（continuation）而只在acc中存储了最后一个值。s改了了fail的值。
3. （第7，8行）在这之后，调用fail回溯。因为使用了继续（continuation），函数fail行为就像在第6行被调用。
4. （第9行）当所有可能的选项被找到时，调用(reverse! acc)并返回所有的可能选项。

定义假设amb从最左边参数开始搜索。

(assert pred)

如果谓词为假,就回溯。

(an-integer-starting-from n)

非确定性地返回从n开始的整数。

(number-between a b)

非确定性地返回a和b之间的整数

[例4]演示了如何使用set-of。得到了所有小于20的质数。

[例4]

(define (prime? n)
  (let ((m (sqrt n)))
    (let loop ((i 2))
      (or (< m i)
          (and (not (zero? (modulo n i)))
               (loop (+ i (if (= i 2) 1 2))))))))

(define (gen-prime n)
  (let ((i (number-between  2 n)))
    (assert (prime? i))
    i))

(set-of (gen-prime 20))
;Value 12: (2 3 5 7 11 13 17 19)

逻辑编程的例子

让我们来解决SICP中的习题4.42作为例子。问题如下：

五位女同学参加一场考试。她们的家长对考试结果过分关心。为此她们约定，在给家里写信谈到考试时，每个姑娘都要写一句真话和一句假话。下面是从她们的信中摘出的句子：

贝蒂：“凯迪考第二，我只考了第三。” 艾赛尔：“你们应该高兴地听到我考了第一，琼第二。” 琼：“我考第三，可怜的艾赛尔考得最差。” 凯蒂：“我第二，玛丽只考了第四。” 玛丽：“我是第四，贝蒂的成绩最高。”

这五位姑娘的实际排名是什么？

[代码4]给出了这个问题的解法。

[代码4]

01:     (define (xor a b)
02:       (if a (not b) b))
03:     
04:     (define (all-different? . ls)
05:       (let loop ((obj (car ls)) (ls (cdr ls)))
06:         (or (null? ls)
07:             (and (not (memv obj ls))
08:                  (loop (car ls) (cdr ls))))))
09:     
10:     ;;; SICP Exercise 4.42
11:     (define (girls-exam)
12:       (let ((kitty (number-between 1 5))
13:             (betty (number-between 1 5)))
14:         (assert (xor (= kitty 2) (= betty 3)))
15:         (let ((mary (number-between 1 5)))
16:           (assert (xor (= kitty 2) (= mary 4)))
17:           (assert (xor (= mary 4) (= betty 1)))
18:           (let ((ethel (number-between 1 5))
19:                 (joan (number-between 1 5)))
20:             (assert (xor (= ethel 1) (= joan 2)))
21:             (assert (xor (= joan 3) (= ethel 5)))
22:             (assert (all-different? kitty betty ethel joan mary))
23:             (map list '(kitty betty ethel joan mary) (list kitty betty ethel joan mary))))))
24:     
25:     ;;; Bad answer for ex 4.42
26:     (define (girls-exam-x)
27:       (let ((kitty (number-between 1 5))
28:             (betty (number-between 1 5))
29:             (mary (number-between 1 5))
30:             (ethel (number-between 1 5))
31:             (joan (number-between 1 5)))
32:         (assert (xor (= kitty 2) (= betty 3)))
33:         (assert (xor (= kitty 2) (= mary 4)))
34:         (assert (xor (= mary 4) (= betty 1)))
35:         (assert (xor (= ethel 1) (= joan 2)))
36:         (assert (xor (= joan 3) (= ethel 5)))
37:         (assert (all-different? kitty betty ethel joan mary))
38:         (map list '(kitty betty ethel joan mary) (list kitty betty ethel joan mary))))

(xor a b)以下条件满足，返回#t:

• a是#t，b是#f，或者
• a是#f，b是#t。

(all-different? , ls)

当ls的所有元素都不相同时，返回#t。

(girls-exam)

是解决谜题的主要函数。它返回名字和排名的表。每次参数赋值后都调用了assert是为了有效地减少死分支的运行时间。(girls-exam-x)则是一个坏例子。它在为所有参数赋值之后调用assert。这种情况下，无谓地搜索了大量的死分支。[例5]显示(girl-exam-x)的运行时间是(girl-exam)的10倍。

[例5]

(define-syntax cpu-time/sec
  (syntax-rules ()
    ((_ s)
     (with-timings
     (lambda () s)
       (lambda (run-time gc-time real-time)
     (write (internal-time/ticks->seconds run-time))
     (write-char #\space)
     (write (internal-time/ticks->seconds gc-time))
     (write-char #\space)
     (write (internal-time/ticks->seconds real-time))
     (newline))))))
;Value: cpu-time/sec

(cpu-time/sec (girls-exam))
.03 0. .03
;Value 14: ((kitty 1) (betty 3) (ethel 5) (joan 2) (mary 4))

(cpu-time/sec (girls-exam-x))
.341 .29 .631
;Value 15: ((kitty 1) (betty 3) (ethel 5) (joan 2) (mary 4))

小结

当你使用了非确定性和用于逻辑编程分析技术时，你就可以写出看起来具有先见之明的程序。注意如果搜索路径里有循环我们就不能使用本章的代码。关于这一点，查看SICP 4.3以获取更多信息。

写这一章时，我参考了Teach Yourself Scheme in Fixnum Days。

你可以在这儿下载本章代码。