sicp-ex-4.3

  
  
 (define operation-table make-table) 
 (define get (operation-table 'lookup-proc)) 
 (define put (operation-table 'insert-proc)) 
  
 (put 'op 'quote text-of-quotation) 
 (put 'op 'set! eval-assignment) 
 (put 'op 'define eval-definition) 
 (put 'op 'if eval-if) 
 (put 'op 'lambda (lambda (x y) 
                    (make-procedure (lambda-parameters x) (lambda-body x) y))) 
 (put 'op 'begin (lambda (x y) 
                   (eval-sequence (begin-sequence x) y))) 
 (put 'op 'cond (lambda (x y) 
                  (evaln (cond->if x) y))) 
  
 (define (evaln expr env) 
   (cond ((self-evaluating? expr) expr) 
         ((variable? expr) (lookup-variable-value expr env)) 
         ((get 'op (car expr)) (applyn (get 'op (car expr) expr env))) 
         ((application? expr) 
          (applyn (evaln (operator expr) env) 
                  (list-of-values (operands expr) env))) 
         (else (error "Unknown expression type -- EVAL" expr))))   

One fix to the solution by meteorgan: applyn is not necessary.

  
 (define (evaln expr env) 
   (cond ((self-evaluating? expr) expr) 
         ((variable? expr) (lookup-variable-value expr env)) 
         ((get 'op (car expr)) (get 'op (car expr) expr env)) 
         ((application? expr) 
          (applyn (evaln (operator expr) env) 
                  (list-of-values (operands expr) env))) 
         (else (error "Unknown expression type -- EVAL" expr))))   

Fix to BE fix of meteorgan. Missing parens on line 4. Using BE fix as shown caused: ;The procedure #[compound-procedure 13 lookup] has been called with 4 arguments; it requires exactly 2 arguments.

 (define (eval expr env) 
   (cond ((self-evaluating? expr) expr) 
         ((variable? expr) (lookup-variable-value expr env)) 
         ((get 'op (operator expr)) ((get 'op (operator expr)) expr env)) 
         ((application? expr) 
          (apply (eval (operator expr) env) 
                 (list-of-values (operands expr) env))) 
         (else (error "Unknown expression type -- EVAL" expr)))) 

a solution using association list (one-dimensional table)

  
 (define (eval exp env) 
   (cond ((self-evaluating? exp) exp) 
         ((variable? exp) (lookup-variable-value exp env)) 
         ;; eval-rules is an association list (1d table) of 
         ;; 'expression type'-'evaluation rule' pairs. 
         ;; expression type is a symbol ('quote, 'define, 'lambda etc.) 
         ;; evaluation rule must be a procedure of two arguments, exp and env. 
         ;; defined at the end of file. 
         ((assq (car exp) eval-rules) => (lambda (type-rule-pair) 
                                           ((cdr type-rule-pair) exp env))) 
         ((application? exp) 
          (apply (eval (operator exp) env) 
                 (list-of-values (operands exp) env))) 
         (else 
          (error "Unknown expression type -- EVAL" exp)))) 
  
 (define eval-rules 
   (list (cons 'quote (lambda (exp env) (text-of-quotation exp))) 
         (cons 'set! eval-assignment) 
         (cons 'define eval-definition) 
         (cons 'if eval-if) 
         (cons 'lambda (lambda (exp env) 
                         (make-procedure (lambda-parameters exp) 
                                         (lambda-body exp) 
                                         env))) 
         (cons 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env))) 
         (cons 'cond (lambda (exp env) (eval (cond->if exp) env))))) 

  
  
 (define (install-syntax) 
   (put 'eval 'quote (lambda (exp- env) 
                       (text-of-quotation exp-))) 
   (put 'eval 'set!- eval-assignment) 
   (put 'eval 'lambda- (lambda (exp- env) 
                         (make-procedure (lambda-parameters exp-) 
                                         (lambda-body exp-) 
                                         env))) 
   (put 'eval 'define- eval-definition) 
   (put 'eval 'if- eval-if) 
   (put 'eval 'begin- (lambda (exp- env) 
                        (eval-sequence (begin-actions exp-) env))) 
   (put 'eval 'call (lambda (exp- env) 
                      (apply- (eval- (operator exp-) env) 
                              (list-of-values (operands exp-) env)))) 
   (put 'eval 'cond- (lambda (exp- env) 
                       (eval- (cond->if exp-) env))) 
   'ok) 
  
 (install-syntax) 
  
 (define (eval- exp- env) 
   (cond ((self-evaluating? exp-) exp-) 
         ((variable? exp-) (lookup-variable-value exp- env)) 
         (else 
          (let ((op (get 'eval (car exp-)))) 
            (if op 
                (op exp- env) 
                (error "Unknown expression type -- EVAL" exp-))))))