diff --git a/ex-4_01-xx.scm b/ex-4_01-xx.scm index b7832ca..b6b00c4 100644 --- a/ex-4_01-xx.scm +++ b/ex-4_01-xx.scm @@ -52,6 +52,7 @@ (put 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env))) (put 'cond (lambda (exp env) (eval (cond->if exp) env))) (put 'let (lambda (exp env) (eval (let->lambda exp) env))) + (put 'let* (lambda (exp env) (eval (let*->nested-lets exp) env))) (put 'and (lambda (exp env) (eval-and (clauses exp) env))) (put 'or (lambda (exp env) (eval-or (clauses exp) env))) (display "[install-eval-package]\n") @@ -103,18 +104,6 @@ (display "\nex-4.5 - modified-cond\n") -; Exercise 4.5. Scheme allows an additional syntax for cond clauses, ( => -; ). -; If evaluates to a true value, then is evaluated. Its value -; must be a procedure of one argument; this procedure is then invoked on the -; value of the , and the result is returned as the value of the cond -; expression. For example - -; (cond ((assoc 'b '((a 1) (b 2))) => cadr) -; (else false)) - -; returns 2. Modify the handling of cond so that it supports this extended syntax. - (define (cond-test exp) (car exp)) (define (cond-recipient exp) (caddr exp)) (define (cond-test-recipient-clause? exp) @@ -143,23 +132,49 @@ (display "[done]\n") -(display "\nex-4.6 - let-expression\n") +(display "\nex-4.6 - let\n") -(define (let->lambda exp) 0) +(define (let? exp) (tagged-list exp 'let)) +(define (let-init exp) (cadr exp)) +(define (let-body exp) (cddr exp)) +(define (let-init-var init) (car init)) +(define (let-init-exp init) (cadr init)) +(define (let-init-vars exp) (map let-init-var (let-init exp))) +(define (let-init-exps exp) (map let-init-exp (let-init exp))) -; (let (( ) ... ( )) -; ) -; -; ((lambda ( ... ) -; ) -; -; -; ) +(define (let->lambda exp) + (let ((let-variables (let-init-vars exp)) + (let-expressions (let-init-exps exp))) + (cons (make-lambda let-variables (let-body exp)) + let-expressions))) -; Implement a syntactic transformation let->combination that reduces evaluating -; let expressions to evaluating combinations of the type shown above, and add the -; appropriate clause to eval to handle let expressions +(assert (let->lambda '(let ((a 3) (b 4)) (* 3 a b))) + '((lambda (a b) (* 3 a b)) 3 4)) + +(display "\nex-4.7 - let*\n") + +(define (let*? exp) (tagged-list exp 'let*)) +(define (let*-inits exp) (cadr exp)) +(define (let*-body exp) (cddr exp)) +(define (let*-inits-empty? inits) (null? inits)) +(define (let*-first-init inits) (car inits)) +(define (let*-rest-init inits) (cdr inits)) + +(define (let*->nested-lets exp) + (define (nest-lets inits) + (if (let*-inits-empty? inits) + (sequence->exp (let*-body exp)) + (list + 'let + (list (let*-first-init inits)) + (nest-lets (let*-rest-init inits))))) + (nest-lets (let*-inits exp))) + +(assert (let*->nested-lets '(let* ((x 1) (y 2)) (* x y) (+ x y))) + '(let ((x 1)) (let ((y 2)) (begin (* x y) (+ x y))))) + +(display "\nex-4.8 - named-let\n") -(display "\nex-4.7") +(display "\nex-4.9\n")