SICP/ex-5_23-30.scm

(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)