SICP Exercise 4.3

Exercise 4.3

在这个练习中，我需要一些对表的操作，下面就是关于表的操作：

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (assoc key records)
      (cond ((null? records) nil)
            ((equal? key (caar records)) (car records))
            (else (assoc key (cdr records)))))
    (define (lookup key)
      (assoc key (cdr local-table)))
    (define (insert! key value)
      (let ((record (assoc key (cdr local-table))))
        (if (not (null? record))
            (set-cdr! record value)
            (set-cdr! local-table 
                      (cons (cons key value) 
                            (cdr local-table))))))
    (define (dispatch m)
      (cond ((eq? m 'lookup) lookup)
            ((eq? m 'insert!) insert!)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

(define (table-get table symbol)
  ((table 'lookup) symbol))

(define (table-put! table symbol value)
  ((table 'insert!) symbol value))

(define (binding-value binding)
  (cdr binding))

与练习2.73一样，有一些特殊情况不能应用数据导向的分派（sefl-evaluating ，variable，application），因为这些表达式的car部分没有显式的表示它们的类型，所以需要单独处理。对于其他情况，我们可以用分派方式简单处理：

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((get (car exp))
         ((get (car exp)) exp env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unkown expressioin type -- EVAL" exp))))

正如代码所示，用分派方式处理的情况中，这些操作都需要两个参数（exp和env），然后，我们之前的eval并不满足这个条件所以，我们需要自己添加一些包装函数：

(define (eval-quote exp env)
  (text-of-quotation exp))
(define (eval-lambda exp env)
  (make-procedure (lambda-parameters exp)
                  (lambda-body exp)
                  env))
(define (eval-begin exp env)
  (eval-sequence (begin-actions exp) env))
(define (eval-cond exp env)
  (eval (cond-if exp) env))

接下来，就是定义表，以及把过程添加到表中：

(define eval-table (make-table))
(define (get type) 
  (let ((binding (table-get eval-table type)))
    (if (null? binding)
        #f
        (binding-value binding))))
(define (put type item) (table-put! eval-table type item))

(put 'quote eval-quote)
(put 'set! eval-assignment)
(put 'define eval-definition)
(put 'if eval-if)
(put 'lambda eval-lambda)
(put 'begin eval-begin)
(put 'cond eval-cond)