sicp-ex-4.5



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


Unknown

 (define (eval-cond exp env) 
   (let ((clauses (cdr exp)) 
         (predicate car) 
         (consequent cdr)) 
     (define (imply-clause? clause) (eq? (cadr clause)  '=>)) 
     (define (else-clause?  clause) (eq? (car clause) 'else)) 
     (define (rec-eval clauses) 
       (if (null? clauses) 'false; checked all, no else-clause 
           (let ((first-clause (car clauses))) 
             (cond ((else-clause? first-clause) (eval-sequence (consequent first-clause) env)) 
                   ((imply-clause? first-clause) (let ((evaluated (eval (predicate first-clause) env))) 
                                                   (if (true? evaluated) 
                                                       (apply (eval (caddr first-clause) env) 
                                                              (list evaluated)) 
                                                       'false))) 
                   (else (if (true? (eval (predicate first-clause) env)) 
                             (eval-sequence (consequent first-clause) env) 
                             'false)))))) 
     (rec-eval clauses))) 

This procedure works, but is not compatible with the SICP's definition of eval:

  
    (define (eval exp env) 
        (cond ((self-evaluating? exp) exp) 
              ((variable? exp) (lookup-variable-value exp env)) 
              ((quoted? exp) (text-of-quotation exp)) 
              ((assignment? exp) (eval-assignment exp env)) 
              ((definition? exp) (eval-definition exp env)) 
              ((if? exp) (eval-if exp env)) 
              ((lambda? exp) 
               (make-procedure (lambda-parameters exp) 
                               (lambda-body exp) 
                               env)) 
              ((begin? exp) 
               (eval-sequence (begin-actions exp) env)) 
              ((cond? exp) (eval (cond->if exp) env)) 
              ((application? exp) 
               (apply (eval (operator exp) env) 
                      (list-of-values (operands exp) env))) 
              (else 
               (error "Unknown expression type -- EVAL" exp)))) 

That is, it doesn't transform cond syntactically.

but we can change the dispatch process in eval.. it's not a big deal.

 (define (eval exp env) 
   (cond ((self-evaluating? exp) exp) 
         ((variable? exp) (lookup-variable-value exp env)) 
         ((quoted? exp) (text-of-quotation exp)) 
         ((assignment? exp) (eval-assignment exp env)) 
         ((definition? exp) (eval-definition exp env)) 
         ((if? exp) (eval-if exp env)) 
         ((lambda? exp) 
          (make-procedure (lambda-parameters exp) 
                          (lambda-body exp) 
                          env)) 
         ((begin? exp)  
          (eval-sequence (begin-actions exp) env)) 
         ;((cond? exp) (eval (cond->if exp) env)) 
         ((cond? exp) (eval-cond exp env)) 
         ((and? exp) (eval (and->if exp) env)) 
         ((or? exp) (eval (or->if exp) env)) 
         ((application? exp) 
          (apply (eval (operator exp) env) 
                 (list-of-values (operands exp) env))) 
         (else 
          (error "Unknown expression type -- EVAL" exp)))) 



aos

My approach just changes the way expand-clauses is handled. I don't do any of the evaluation and just create a separate if clause with its own expression.

 (define (expand-clauses clauses env) 
   (if (null? clauses) 
       'false ; no else clause 
       (let ((first (car clauses)) 
             (rest (cdr clauses))) 
         (if (cond-else-clause? first) 
             (if (null? rest) 
                 (sequence->exp 
                   (cond-actions first)) 
                 (error "ELSE clauses isn't 
                         last: COND->IF" 
                         clauses)) 
         (if (eq? (car (cond-actions first)) '=>) ; <---- here 
             (make-if (cond-predicate first) 
                      (list (cadr (cond-actions first)) 
                            (cond-predicate first)) 
                      (expand-clauses 
                       rest 
                       env)) 
             (make-if (cond-predicate first) 
                      (cond-actions first) 
                      (expand-clauses 
                        rest 
                        env))))))) 

This won't work, because (cond-predicate first) would be evaluated twice, and not necessarily to the same value.



davl

It's neater to just revise cond-actions into

  
 (define (cond-actions clause) 
   (if (eq? '=> (cadr clause)) 
     (list (list (caddr clause) (cond-predicate clause))) 
     (cdr clause))) 

This will also evaluate the predicate twice.



zxymike93

Here's my version of expand-cond. Since the book says the procedure after => invoke on *the value* of the <test>, I eval it before making it an expression.

  
   (define (eval-cond exp env) 
     (define (cond->if exp) 
       (expand-cond (cdr exp))) 
     (define (expand-cond clauses) 
       (cond [(null? clauses) #f] 
             [else 
              (let ([first (car clauses)] [rest (cdr clauses)]) 
                (cond [(eq? 'else (car first)) 
                       (if (null? rest) 
                           (sequence->exp (cdr first)) 
                           (error "Clauses after else"))] 
                      [else 
                       (if (eq? '=> (cadr first)) 
                           ;; action for => 
                           (make-if (car first) 
                                    (sequence->exp (cons (caddr first) 
                                                         (meta-eval (car first) env))) 
                                    (expand-cond rest)) 
                           (make-if (car first) 
                                    (sequence->exp (cdr first)) 
                                    (expand-cond rest)))]))])) 
     (meta-eval (cond->if exp) env)) 

And I test it by evaling the book example. However, quote(') it's a bit confusing...

  
 (eval '(cond ((assoc ''b '(('a 1) ('b 2))) => cadr) (else false)) global-env) 
  

PS: Sorry for the [], I'm using Racket here.


RaphyJake

This is my version of expand-clauses. It turns the special cond syntax into a lambda expression, so the condition gets evaluated only once.

 (define (cond-clauses exp) (cdr exp)) 
 (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) 
  
 (define (cond-predicate clause) (car clause)) 
 (define (cond-special-syntax? clause) (eq? (cadr clause) '=>)) 
 (define (cond-special-syntax-function clause) (caddr clause)) 
 (define (cond-actions clause) (cdr clause)) 
  
 (define (cond->if exp) 
   (expand-clauses (cond-clauses exp))) 
  
 (define (expand-clauses clauses) 
   (if (null? clauses) 
       'false     ; no else clause 
       (let ((first (car clauses)) 
             (rest (cdr clauses))) 
         (if (cond-else-clause? first) 
             (if (null? rest) 
                 (sequence->exp 
                  (cond-actions first)) 
                 (display "ELSE clause isn't last: COND->IF")) 
             (if (cond-special-syntax? first) 
                 (list (make-lambda (list 'x) 
                                    (list (make-if 'x 
                                             (list (cond-special-syntax-function first) 'x) 
                                             (expand-clauses rest)))) 
                       (cond-predicate first)) 
                 (make-if (cond-predicate first) 
                          (sequence->exp 
                           (cond-actions first)) 
                          (expand-clauses 
                           rest))))))) 
  
  

The problem with Ralphy Jake's solution is it introduces an undeclared variable x to the environment and can change the meaning of expressions that depend on the value of x in the scope outside of the cond clause. Try the following 2 tests and you will see the first gives an unexpected result because of the introduction of the hidden 'x'.

 (define x 10) 
  
 (define (test1) 
   (cond ((assoc 'a '((a 1)(b 2))) => (lambda (y) (display y)(display x))) 
   (else 'never))) 
  
 (test1)  
 (a 1)(a 1) 
 #<void> 

Here the answer is the result of the assoc list test and not the original value of x

 (define y 10) 
  
 (define (test2) 
   (cond ((assoc 'a '((a 1)(b 2))) => (lambda (z) (display z)(display y))) 
   (else 'never))) 
  
 (test2) 
 (a 1)10 
 #<void> 

Here we get 10, the correct answer. We are lucky that we didn't pick an identifier that the interpreter hides!



master

I'm not very confident in my solution.

 (define (expand-clauses clauses) 
   (if (null? clauses) 
       'false ; no else clause 
       (let ((first (car clauses)) 
             (rest (cdr clauses))) 
         (if (cond-else-clause? first) 
             (if (null? rest) 
                 (sequence->exp (cond-actions first)) 
                 (error "ELSE clause isn't last: COND->IF" 
                        clauses)) 
             (if (arrow? first) 
                 (arrow->exp first) 
                 (make-if (cond-predicate first) 
                          (sequence->exp (cond-actions first)) 
                          (expand-clauses rest))))))) 
  
 (define (arrow? clause) (eq? (cadr clause) '=>)) 
 (define (arrow->exp clause) (let ((test (cond-predicate clause)) 
                                   (recipient (caddr clause))) 
                               (make-if test 
                                        (recipient test) 
                                        'false)))