第十章 What Is the Value of All of This?

一个entry是一对list，这对list的第一项是一个set，并且这两个list具有相同的节点数。一个例子：

((appetizer entree beverage) (pate boeuf vin))

前面介绍过，build可以用来构建一个列表。但这里可以给build取一个新的名字： (define new-entry build)。

(lookup-in-entry name entry)在第一个list中找name指代的节点的位置，然后返回第二个list中该位置的节点。但是如果name指代的元素在第一个list中不存在怎么办？可以让lookup-in-entry的调用者提供一个额外的函数，在出现这种情况时调用。

lookup-in-entry定义如下：

(define lookup-in-entry
    (lambda (name entry entry-f)
      (lookup-in-entry-help name
        (first entry)
        (second entry)
        entry-f)))

lookup-in-entry-help的定义如下：

(define lookup-in-entry-help
    (lambda (name names values entry-f)
      (cond
        ((null? names) (entry-f name))
        ((eq? (car names) name) (car values))
        (else (lookup-in-entry-help name (cdr names) (cdr values) entry-f)))))

一个table是一个entry的列表，可以为空。下面是非空的例子：

(((appetizer entree beverage) (pate boeuf vin))
((beverage dessert) ((food is) (number one with us))))

可以用cons把一个entry拼接到一个table中，这里可以给cons定义一个新的名字：(define extend-table cons)。

跟lookup-in-entry相似，我们可以有lookup-in-table。(lookup-in-table name table table-f)从table中的entry查找名为name的值。如果有多个匹配，则只返回第一个值。

lookup-in-table定义如下：

 (define look-in-table
    (lambda (name table table-f)
      (cond
        ((null? table) (table-f name))
        (else (lookup-in-entry name (car table)
                (lambda (name)
                  (look-in-table name (cdr table) table-f)))))))

假设有一个value函数可以用来求值，那么下面的片段：

(cons rep-a
  (cons rep-b
    (cons rep-c
      (quote ()))))

产生的值就是(car (quote (a b c)))，进一步对(car (quote (a b c)))求值，得到的结果就是a。

类型是值的集合。用一个类型标识来替代一系列值，本质上是减少需要处理的信息量。

接下来，因为要对表达式进行类型标识，所以定义了以下几种类型：

  • *const
  • *identifier
  • *quote
  • *cond
  • *lambda
  • *application

类型是通过函数来表示的，这些函数叫做actions。

下面定义一个expression-to-action，可以确定expression的类型，并将其转为action：

 (define expression-to-action
    (lambda (e)
      (cond
        ((atom? e) (atom-to-action e))
        (else (list-to-action e)))))

病态构造的S-expression，比如(quote a b), (), (lambda (t) #t), (lambda (5) 5), (lambda (car) car), (lambda a), (cond (3 c) (else b) (6 a ), and (1 2) 不在考虑之列。可以在求值之前通过特定的函数去检测表达式的构造是否病态。

下面是atom-to-action的定义：

 (define atom-to-action
      (lambda (e)
        (cond
          ((number? e) *const)
          ((eq? e #t) *const)
          ((eq? e #f) *const)
          ((eq? e 'cons) *const)
          ((eq? e 'car) *const)
          ((eq? e 'cdr) *const)
          ((eq? e 'null?) *const)
          ((eq? e 'eq?) *const)
          ((eq? e 'atom?) *const)
          ((eq? e 'zero?) *const)
          ((eq? e 'add1) *const)
          ((eq? e 'sub1) *const)
          ((eq? e 'number?) *const)
          (else *identifier))))

下面是list-to-action的定义：

 (define list-to-action
    (lambda (e)
      (cond
        ((atom? (car e))
         (cond
           ((eq? (car e) 'quote) *quote)
           ((eq? (car e) 'lambda) *lambda)
           ((eq? (car e) 'cond) *cond)
           (else *application)))
        (else *application))))

下面可以定义value函数，以及辅助用的meaning函数：

 (define value
    (lambda (e)
      (meaning e '())))
(define meaning
    (lambda (e table)
      ((expression-to-action e) e table)))

上面的value以及它使用到的各种函数，可以合起来称作一个interpreter。

下面来定义*const：

 (define *const
    (lambda (e table)
      (cond
        ((number? e) e)
        ((eq? e #t) #t)
        ((eq? e #f) #f)
        (else (build 'primitive e)))))

也就是说*const对于数字以及#t和#f而言，返回其本身。对于primitive，比如car，返回(primitive car)。

下面定义*quote：

 (define *quote
    (lambda (e table)
      (text-of e)))
 (define text-of second)

下面来定义*identifier:

> (define *identifier
    (lambda (e table)
      (lookup-in-table e table initial-table)))
> (define initial-table
    (lambda (name)
      (car '())))

注意到上述的initial-table函数是用来报告错误的。

下面定义*lambda

(define *lambda
    (lambda (e table)
      (build 'non-primitive (cons table (cdr e)))))

primitive是内建的，而non-primitive是根据参数和函数体定义出来的。

下面定义几个辅助函数

(define table-of first)
(define formals-of second)
(define body-of third)

下面是书中对(cond ...)语句功能的阐述：

It is a special form that takes any number of cond-lines. It considers each line in turn.If the question part on the left is false, it looks at the rest fo the lines. Otherwise it proceeds to answer the right part.If it sees an else-line, it treats that cond-line as if its question part were true.

下面定义的evcon，用来执行上述关于cond的操作：

 (define evcon
    (lambda (lines table)
      (cond
        ((else? (question-of (car lines)))
         (meaning (answer-of (car lines)) table))
        ((meaning (question-of (car lines)) table)
         (meaning (answer-of (car lines)) table))
        (else (evcon (cdr lines) table)))))
 (define else?
    (lambda (x)
      (cond
        ((atom? x) (eq? x 'else))
        (else #f))))
(define question-of first)
(define answer-of second)

上述evcon的定义要求lines中有一行的求值要为正值，才能保证计算的正常进行。然后*cond就可以用evcon表示了：

(define *cond
    (lambda (e table)
      (evcon (cond-lines-of e) table)))
(define cond-lines-of cdr)

我们还有一个*application没有定义。

An application is a list of expressions whose car position contains an expression whose value is a function. An application must always determine the meaning of all its arguments.

首先定义一个辅助用的evlis:

(define evlis
    (lambda (args table)
      (cond
        ((null? args) '())
        (else
          (cons (meaning (car args) table)
            (evlis (cdr args) table))))))

然后定义*application：

 (define *application
    (lambda (e table)
      (apply
        (meaning (function-of e) table)
        (evlis (arguments-of e) table))))
(define function-of car)
(define arguments-of cdr)

We apply the meaning of the function to the meaning of the arguments.

只有*application可以往table中写入定义。

function有两种，一是primitive，二是non-primitive。对于car、cdr这种原语操作，其表示形式是(primitive primitive-name)。对于lambda定义的非原语操作，其表示形式为(non-primitive (table formals body))，其中(table formals body)叫做一个closure record。

可以定义两个函数来判断是否是primitive：

(define primitive?
    (lambda (l)
      (eq? (first l) 'primitive)))
(define non-primitive?
    (lambda (l)
      (eq? (first l) 'non-primitive)))

然后可以定义一个apply函数：

(define apply
    (lambda (fun vals)
      (cond
        ((primitive? fun)
         (apply-primitive
           (second fun) vals))
        ((non-primitive? fun)
         (apply-closure
           (second fun) vals)))))

上述的apply模拟了scheme和lisp内置的apply。如果fun既不是primitive，也不是non-primitive，程序无法给出运行结果。

下面定义apply-primitive:

 (define apply-primitive
    (lambda (name vals)
      (cond
        ((eq? name 'cons)
         (cons (first vals) (second vals)))
        ((eq? name 'car)
         (car (first vals)))
        ((eq? name 'cdr)
         (cdr (first vals)))
        ((eq? name 'null?)
         (null? (first vals)))
        ((eq? name 'eq?)
         (eq? (first vals) (second vals)))
        ((eq? name 'atom?)
         (:atom? (first vals)))
        ((eq? name 'zero?)
         (zero? (first vals)))
        ((eq? name 'add1)
         (add1 (first vals)))
        ((eq? name 'sub1)
         (sub1 (first vals)))
        ((eq? name 'number?)
         (number? (first vals))))))
(define :atom?
    (lambda (x)
      (cond
        ((atom? x) #t)
        ((null? x) #f)
        ((eq? (car x) 'primitive) #t)
        ((eq? (car x) 'non-primitive) #t)
        (else #f))))

下面定义closure：

(define apply-closure
    (lambda (closure vals)
      (meaning (body-of closure)
        (extend-table
          (new-entry
            (formals-of closure)
            vals)
          (table-of closure)))))

求值之前把formals加入到table。

下面来看apply-closure的一个例子，假设closure是

((((u v w)
   (1 2 3)
  ((x y z)
   (4 5 6)))
  (x y)
  (cons z x))

然后vals是((a b c ) (d e f))。

第一步是将实参代入形参，所以table变为：

(((x y)
  ((a b c) (d e f))
  ((u v w)
   (1 2 3)
  ((x y z)
   (4 5 6)))

然后依次在cons, z, x上应用meaning函数。cons的meaning结果是(primitive cons)，z的meaning结果是6，x的meaning结果是(a b c)。所以整体上转化为：(apply (primitive cons) (6 (a b c)))。最后的结果是(6 a b c)。

（本篇完）