(load "shared/util.scm") (load "shared/sicp-regsim.scm") (load "shared/sicp-eceval.scm") (load "shared/sicp-eceval-lazy.scm") (define the-global-environment (setup-environment)) (set-register-contents! eceval 'exp '(if false 1 2)) (start eceval) (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) (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.24 - cond-special-form\n") (set-register-contents! eceval 'exp '(cond ((= 2 1) 0) ((= 2 3) 1) ((= 0 4) 2) (else (* 2 5)))) (start eceval) (assert (get-register-contents eceval 'val) 10) (display "\nex-5.25 - lazy-evaluation\n") (set-register-contents! eceval-lazy 'exp '(begin (define (try a b) (if (= a 0) 1 b)) (try 0 (/ 1 0)))) (start eceval-lazy) (assert (get-register-contents eceval-lazy 'val) 1) (display "\nex-5.26 - fact-iter-stack-analysis\n") (set-register-contents! eceval 'exp '(begin (define (factorial n) (define (iter product counter) (if (> counter n) product (iter (* product counter) (+ counter 1)))) (iter 1 1)) (factorial 5))) (start eceval) (assert (get-register-contents eceval 'val) 120) ; | 1 | 2 | 3 | 4 | 5 | n ; |----|----|----|----|----| ; | 10| 10| 10| 10| 10| depth ; | 70| 105| 140| 175| 210| push count ; depth = 10 ; push-count = 35 * (n + 1) (display "\nex-5.27 - fact-rec-stack-analysis\n") (set-register-contents! eceval 'exp '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) (start eceval) (assert (get-register-contents eceval 'val) 120) ; | 1 | 2 | 3 | 4 | 5 | n ; |----|----|----|----|----| ; | 8| 11| 14| 17| 20| depth ; | 22| 54| 86| 118| 150| push count ; depth = 5 + n * 3 ; push-count = 22 + (n - 1) * 32 (display "\nex-5.28 - fact-lazy-stack-analysis\n") (set-register-contents! eceval-lazy 'exp '(begin (define (factorial n) (define (iter product counter) (if (> counter n) product (iter (* product counter) (+ counter 1)))) (iter 1 1)) (factorial 5))) (start eceval-lazy) (assert (get-register-contents eceval-lazy 'val) 120) (set-register-contents! eceval-lazy 'exp '(begin (define (factorial n) (if (= n 1) 1 (* n (factorial (- n 1))))) (factorial 5))) (start eceval-lazy) (assert (get-register-contents eceval-lazy 'val) 120) ; | 1 | 2 | 3 | 4 | 5 | n ; |----|----|----|----|----| ; lazy-iter | 13| 18| 23| 28| 33| depth ; | 61| 108| 171| 250| 345| push count ; |----|----|----|----|----| ; lazy-rec | 8| 16| 24| 32| 40| depth ; | 21| 52| 99| 162| 241| push count (display "\nex-5.29 - fib-stack-analysis\n") (set-register-contents! eceval 'exp '(begin (define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 7))) (start eceval) (assert (get-register-contents eceval 'val) 13) ; | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | ; |----|----|----|----|----|----|----|----|----|----| ; | 8| 13| 18| 23| 28| 33| 38| 43| 48| 53| depth ; | 22| 78| 134| 246| 414| 694|1142|1870|3046|4950| push count ; a. ; depth = 3 + 5 * n ; push-count = ; b. ; S(n) := push-count for n ; S(n) = S(n - 2) + S(n - 1) + k ; k = 34 ; calculated from table ; S(n) = a * Fib(n + 1) + b ; a = 56, b = -34 ; calculated on paper ; S(7) = a * Fib(8) + b ; = 56 * 21 - 34 ; = 1142 (display "\nex-5.30 - error-handling\n") ; a (set-register-contents! eceval 'exp '(begin (define (foo x) x) (foo a))) (start eceval) (newline) (assert (get-register-contents eceval 'val) 'error-unbound-variable)) ; b (define (check-apply-division args) (cond ((not (= (length args) 2)) 'error-div-wrong-number-of-args) ((= (cadr args) 0) 'error-div-by-zero) (else 'ok))) (set-register-contents! eceval 'exp '(begin (/ 1 0))) (start eceval) (newline) (assert (get-register-contents eceval 'val) 'error-div-by-zero) (define (check-apply-car args) (cond ((not (pair? (car args))) 'error-car-no-pair) (else 'ok))) (set-register-contents! eceval 'exp '(begin (car 3))) (start eceval) (newline) (assert (get-register-contents eceval 'val) 'error-car-no-pair)