Implement 5.23

ex-5_23-xx.scm

@@ -3,15 +3,32 @@
 (load "misc/sicp-eceval.scm")
 
 (define the-global-environment (setup-environment))
-(set-register-contents! eceval 'exp '(+ 1 2))
+(set-register-contents! eceval 'exp '(if false 1 2))
 (start eceval)
-(assert (get-register-contents eceval 'val) 3)
+(assert (get-register-contents eceval 'val) 2)
 
 (display "\nex-5.23 - derived-expressions\n")
 
+(set-register-contents! eceval 'exp
+  '(cond
+     ((= 1 2) 0)
+     ((= 2 3) 1)
+     ((= 0 4) 2)
+     (else 3)))
+(start eceval)
+(assert (get-register-contents eceval 'val) 3)
 
-(display "\nex-5.24\n")
+(set-register-contents! eceval 'exp
+  '(begin
+     (define (square x) (* x x))
+     (let ((y (square 3)))
+       y)))
+(start eceval)
+(assert (get-register-contents eceval 'val) 9)
 
 
-;(display "\nex-5.25\n")
+(display "\nex-5.24 \n")
+
+
+(display "\nex-5.25\n")
 

misc/sicp-eceval-support.scm

@@ -95,6 +95,49 @@
     (scan (frame-variables frame)
           (frame-values frame))))
 
+;;; cond-support
+(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)
+  (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))
+                (error "ELSE clause isn't last -- COND->IF"
+                       clauses))
+            (make-if (cond-predicate first)
+                     (sequence->exp (cond-actions first))
+                     (expand-clauses rest))))))
+
+;;; lambda-support
+
+;;; let-support
+(define (let? exp) (tagged-list? exp 'let))
+(define (let-bindings exp) (cadr exp))
+(define (let-body exp) (cddr exp))
+(define (let-binding-var binding) (car binding))
+(define (let-binding-exp binding) (cadr binding))
+(define (let-vars exp) (map let-binding-var (let-bindings exp)))
+(define (let-exps exp) (map let-binding-exp (let-bindings exp)))
+
+(define (make-lambda parameters body)
+  (cons 'lambda (cons parameters body)))
+
+(define (let->combination exp)
+  (let ((let-variables (let-vars exp))
+        (let-expressions (let-exps exp)))
+    (cons (make-lambda let-variables (let-body exp))
+          let-expressions)))
 
 ;;;SECTION 4.1.4
 

misc/sicp-eceval.scm

@@ -68,6 +68,11 @@
    (list 'extend-environment extend-environment)
    (list 'lookup-variable-value lookup-variable-value)
    (list 'set-variable-value! set-variable-value!)
+   ;;5.23
+   (list 'cond? cond?)
+   (list 'cond->if cond->if)
+   (list 'let? let?)
+   (list 'let->combination let->combination)
    (list 'define-variable! define-variable!)
    (list 'primitive-procedure? primitive-procedure?)
    (list 'apply-primitive-procedure apply-primitive-procedure)
@@ -119,6 +124,10 @@ eval-dispatch
   (branch (label ev-definition))
   (test (op if?) (reg exp))
   (branch (label ev-if))
+  (test (op cond?) (reg exp))
+  (branch (label ev-cond))
+  (test (op let?) (reg exp))
+  (branch (label ev-let))
   (test (op lambda?) (reg exp))
   (branch (label ev-lambda))
   (test (op begin?) (reg exp))
@@ -228,8 +237,16 @@ ev-sequence-last-exp
   (restore continue)
   (goto (label eval-dispatch))
 
-;;;SECTION 5.4.3
+;;; ex-5.23
+ev-cond
+  (assign exp (op cond->if) (reg exp))
+  (goto (label eval-dispatch))
 
+ev-let
+  (assign exp (op let->combination) (reg exp))
+  (goto (label eval-dispatch))
+
+;;;SECTION 5.4.3
 ev-if
   (save exp)
   (save env)