SICP Exercise 4.3

来源:互联网 发布:传奇db数据库参数 编辑:程序博客网 时间:2024/05/23 14:20

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)




原创粉丝点击