Implement till 4.34

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
+(assert (eval '(car '(a b c)) the-global-environment) 'a)
-;  '(begin
-;     (car (list a b c))
-;     )
-;  the-global-environment)
 
+(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)
+                     '<procedure-env>)))
+    (else
+      (display object))))
+
+(user-print (eval 'ones the-global-environment))
+(newline)
+
+(display "[done]\n")