Implement 4.32

ex-4_31-34.scm

@@ -21,6 +21,12 @@
             (list-of-arg-values (rest-operands exps)
                                 env))))
 
+(define (list? exp)
+  (tagged-list? exp 'list))
+
+(define (list-elements exp)
+  (cdr exp))
+
 (define (eval exp env)
   (cond ((self-evaluating? exp) exp)
         ((variable? exp) (lookup-variable-value exp env))
@@ -28,6 +34,7 @@
         ((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)))
         ((lambda? exp)
          (make-procedure (lambda-parameters exp)
                          (lambda-body exp)
@@ -135,8 +142,58 @@
   (assert (eval '(square (id 10)) the-global-environment) 100)
   (assert (eval 'count the-global-environment) 1))
 
-(display "\nex-4.32\n")
+(display "\nex-4.32 - lazy-streams\n")
+
+(eval
+  '(begin
+    (define (cons (x lazy-memo) (y lazy-memo))
+      (lambda (m) (m x y)))
+    (define (car z)
+      (z (lambda (p q) p)))
+    (define (cdr z)
+      (z (lambda (p q) q)))
+    (define (list-ref items n)
+      (if (= n 0)
+          (car items)
+          (list-ref (cdr items) (- n 1))))
+    (define (map proc items)
+      (if (null? items)
+          '()
+          (cons (proc (car items))
+                (map proc (cdr items)))))
+    (define (scale-list items factor)
+      (map (lambda (x) (* x factor))
+           items))
+    (define (add-lists list1 list2)
+      (cons (+ (car list1) (car list2))
+            (add-lists (cdr list1) (cdr list2))))
+    (define ones (cons 1 ones))
+    (define integers (cons 1 (add-lists ones integers)))
+    (define fib (cons 1 (cons 1 (add-lists fib (cdr fib)))))
+    )
+  the-global-environment)
+
+(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")
+
+(define (list->cons elements)
+  (define (make-cons elements)
+    (if (null? elements)
+      'end
+      (cons (list 'cons (car elements))
+            (make-cons (cdr elements)))))
+  (make-cons elements))
+
+(display (list->cons '(a b c)))
+
+;(eval
+;  '(begin
+;     (car (list a b c))
+;     )
+;  the-global-environment)
+
 
-; (display "\nex-4.33\n")
 ; (display "\nex-4.34\n")
 

misc/evaluator.scm

@@ -105,7 +105,6 @@
 (define (lambda-parameters exp) (cadr exp))
 (define (lambda-body exp) (cddr exp))
 
-
 (define (make-lambda parameters body)
   (cons 'lambda (cons parameters body)))