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)