diff --git a/ex-5_23-xx.scm b/ex-5_23-xx.scm index d7eeea9..e3d12b0 100644 --- a/ex-5_23-xx.scm +++ b/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") diff --git a/misc/sicp-eceval-support.scm b/misc/sicp-eceval-support.scm index 06677bc..be92775 100644 --- a/misc/sicp-eceval-support.scm +++ b/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 diff --git a/misc/sicp-eceval.scm b/misc/sicp-eceval.scm index 2f2dd09..68aac9c 100644 --- a/misc/sicp-eceval.scm +++ b/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)