sicp-ex-4.3



<< Previous exercise (4.2) | Index | Next exercise (4.4) >>


meteorgan

  
  
  
 (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 "Unkown expression type -- EVAL" expr)))) 

bagratte

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)))))