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

BE

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

}}}


eric4brs

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

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

Sphinxsky

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