<< Previous exercise (4.4) | Index | Next exercise (4.6) >>
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.
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)))
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.
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!
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)))
Environment for testing: user-initial-environment.
I ended up writing an eval-cond procedure, added extra env arg to cond-if, expand-clauses, and make-if, such that double evaluation of the predicate expression can be avoided. Main change is in the make-if procedure.
(define (eval-cond exp env) (eval (cond->if exp env) env)) (define (cond? exp) (tagged-list? exp 'cond)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp env) ;; added env arg (expand-clauses (cond-clauses exp) env)) (define (expand-clauses clauses env) ;; added env arg (if (null? clauses) 'false (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)) (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest env) env))))) ;; main change is here (define (make-if predicate consequent alternative env) (if (eq? (cadr consequent) '=>) (let ((value (eval predicate env))) (list 'if value (lambda () ((caddr consequent) value)) alternative)) (list 'if predicate consequent alternative))) (eval '(cond ((assoc 'b '((a 1) (b 2))) => cadr) (else false)) test-env) ;; 2
I believe that with this solution, every single cond recipient clause will have its predicate evaluated, since expand-clauses will construct the entire cond expression. So, if any of these predicate expressions have side effects, the program is likely to behave incorrectly (and probably in a way that is very perplexing to debug); the proper behavior would be to only evaluate a predicate if every earlier predicate had already failed. For that reason, I suspect that sneaking an eval into cond->if or any of its dependencies is probably never going to be the right approach.
My solution requires the implementation of a `make-let` procedure, which basically creates the application (created by a new `make-application` procedure) of a lambda (created by the existing `make-lambda` procedure) to a given value.
Using `make-let` there's no need to pass the environment to `expand-clauses` as a new argument.
(define make-application (lambda (operator operands) (cons operator operands))) (define make-let (lambda (var val body) (make-application (make-lambda (list var) body) val))) (define cond-recipient-clause? (lambda (clause) (eq? (car (cond-actions clause)) '=>))) (define cond-recipient (lambda (clause) (cadr (cond-actions clause)))) (define expand-clauses (lambda (clauses) (if (null? clauses) 'false ; no else clause (let ((first (car clauses)) (rest (cdr clauses))) (cond ((cond-else-clause? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "ELSE clause isn't last -- COND->IF" clauses))) ((cond-recipient-clause? first) (make-let 'result (cond-predicate first) (make-if 'result (make-application (cond-recipient first) (list 'result)) (expand-clauses rest)))) (else (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest))))))))
evaluated only once no naming conflicts
((cond-apply-clause? clause)
(make-application
(make-lambda '(pred consequence alternetive)
(list (make-if 'pred
(list (make-application 'consequence nil) 'pred)
(make-application 'alternetive nil))))
(list (clause-predicate clause)
(make-lambda '()
(list (clause-procedure clause)))
(make-lambda '()
(list (clauses->if (rest-clauses clauses)))))))
(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)))lockywolf
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.
dzy
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))))mazj
Unknown's answer may missing the part of recursively calling rec-eval.
(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 (cdr clauses))))) (rec-eval clauses)))