diff --git a/ex-4_31-34.scm b/ex-4_31-34.scm index 5b77c21..e842e50 100644 --- a/ex-4_31-34.scm +++ b/ex-4_31-34.scm @@ -28,13 +28,14 @@ (cdr exp)) (define (eval exp env) + ;;(display "EVAL -- ") (display exp) (newline) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) - ((quoted? exp) (text-of-quotation exp)) + ((quoted? exp) (text-of-quotation exp env)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) - ((list? exp) (list->cons (list-elements exp))) + ((list? exp) (eval (list->cons (list-elements exp)) env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) @@ -147,7 +148,7 @@ (eval '(begin (define (cons (x lazy-memo) (y lazy-memo)) - (lambda (m) (m x y))) + (lambda (lazy-list-m) (lazy-list-m x y))) (define (car z) (z (lambda (p q) p))) (define (cdr z) @@ -176,24 +177,44 @@ (assert (eval-force '(list-ref fib 10) the-global-environment) 89) (assert (eval-force '(list-ref ones 100) the-global-environment) 1) -(display "\nex-4.33\n") +(display "\nex-4.33 - quoted-list\n") (define (list->cons elements) (define (make-cons elements) (if (null? elements) 'end - (cons (list 'cons (car elements)) + (list 'cons (car elements) (make-cons (cdr elements))))) (make-cons elements)) -(display (list->cons '(a b c))) +(define (text-of-quotation exp env) + (define (quote-it x) + (list 'quote x)) + (let ((q (cadr exp))) + (if (pair? q) + (eval (list->cons (map quote-it q)) env) + q))) -;(eval -; '(begin -; (car (list a b c)) -; ) -; the-global-environment) +(assert (eval '(car '(a b c)) the-global-environment) 'a) +(display "\nex-4.34 - print-lazy-cons\n") -; (display "\nex-4.34\n") +(define (user-print object) + (cond + ((and (compound-procedure? object) + (= (length (procedure-parameters object)) 1) + (eq? (car (procedure-parameters object)) 'lazy-list-m)) + (display "{...}")) + ((compound-procedure? object) + (display (list 'compound-procedure + (procedure-parameters object) + (procedure-body object) + '))) + (else + (display object)))) + +(user-print (eval 'ones the-global-environment)) +(newline) + +(display "[done]\n")