SICP/ex-4_11-xx.scm

(load "util.scm")
(load "misc/evaluator.scm")

(display "\nex-4.11 - alternative-frame-implementation\n")

; Test implementation from book.
(define env-0 the-empty-environment)
(define env-1 (extend-environment '(a b) '(1 2) env-0))
(define env-2 (extend-environment '(c d) '(3 4) env-1))

(assert (lookup-variable-value 'b env-2) 2)
(set-variable-value! 'b 42 env-2)
(assert (lookup-variable-value 'b env-2) 42)
(define-variable! 'e 5 env-2)
(assert (lookup-variable-value 'e env-2) 5)

(define (make-frame variables values)
  (map cons variables values))
(define (frame-variables frame) (map car frame))
(define (frame-values frame) (map cdr frame))
(define (add-binding-to-frame! var val frame)
  (if (null? (cdr frame))
    (set-cdr! frame (cons (cons var val) '()))
    (add-binding-to-frame! var val (cdr frame))))

(define frame-var car)
(define frame-val cdr)

(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond ((null? vars)
             (env-loop (enclosing-environment env)))
            ((eq? var (car vars))
             (car vals))
            (else (scan (cdr vars) (cdr vals)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

(define (set-variable-value! var val env)
  (define (env-loop env)
    (define (scan frame)
      (cond ((null? frame)
             (env-loop (enclosing-environment env)))
            ((eq? var (frame-var (car frame)))
             (set-cdr! (car frame) val))
            (else (scan (cdr frame)))))
    (if (eq? env the-empty-environment)
        (error "Unbound variable -- SET!" var)
        (let ((frame (first-frame env)))
          (scan frame))))
  (env-loop env))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan frame)
      (cond ((null? frame)
             (add-binding-to-frame! var val (first-frame env)))
            ((eq? var (frame-var (car frame)))
             (set-cdr! (car frame) val))
            (else (scan (cdr frame)))))
    (scan frame)))

(define env-0 the-empty-environment)
(define env-1 (extend-environment '(a b) '(1 2) env-0))
(define env-2 (extend-environment '(c d) '(3 4) env-1))

(assert (lookup-variable-value 'b env-2) 2)
(set-variable-value! 'b 42 env-2)
(assert (lookup-variable-value 'b env-2) 42)
(define-variable! 'e 5 env-2)
(assert (lookup-variable-value 'e env-2) 5)

(display "\nex-4.12 - abstract-traversal\n")

(define (find-pair-frame var frame)
  (assoc var frame))

(define (find-pair-env var env)
  (define (env-loop env)
    (if (eq? env the-empty-environment)
      #f
      (let ((pair (assoc var (first-frame env))))
        (if (pair? pair)
          pair
          (env-loop (enclosing-environment env))))))
  (env-loop env))

(define (lookup-variable-value var env)
  (let ((pair (find-pair-env var env)))
    (if (eq? pair #f)
      (error "Unbound variable" var)
      (frame-val pair))))

(define (set-variable-value! var val env)
  (let ((pair (find-pair-env var env)))
    (if (pair? pair)
      (set-cdr! pair val)
      '())))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (let ((pair (assoc var frame)))
      (if (pair? pair)
        (set-cdr! pair val)
        (add-binding-to-frame! var val frame)))))

(define env-0 the-empty-environment)
(define env-1 (extend-environment '(a b) '(1 2) env-0))
(define env-2 (extend-environment '(c d) '(3 4) env-1))

(assert (find-pair-env 'd env-2) (cons 'd 4))
(assert (lookup-variable-value 'b env-2) 2)
(set-variable-value! 'b 42 env-2)
(assert (lookup-variable-value 'b env-2) 42)
(define-variable! 'e 5 env-2)
(assert (lookup-variable-value 'e env-2) 5)

(display "\nex-4.13 - make-unbound!\n")

; It seems like the reason for removing a binding is when one wants get access
; to the same symbol in an outer environment. Therefore, we implement
; make-unbound! so that it only deletes the symbol from the first frame in
; which it is defined.

(define (frame-without-var var frame)
  (cond
    ((null? frame) '())
    ((eq? var (frame-var (car frame))) (cdr frame))
    (else (cons (car frame) (frame-without-var var (cdr frame))))))

(define (make-unbound-first! var env)
  (let ((len (length (first-frame env))))
    (set-car! env (frame-without-var var (first-frame env)))
    (if (= len (length (first-frame env)))
      #f
      #t)))

(assert (make-unbound-first! 'd env-2) #t)
(assert (make-unbound-first! 'e env-2) #t)
(assert (make-unbound-first! 'b env-2) #f)
(assert (make-unbound-first! 'c env-2) #t)
(assert (first-frame env-2) '())

(define (make-unbound! var env)
  (define (loop env)
    (if (eq? env the-empty-environment)
      #f
      (if (make-unbound-first! var env)
        #t
        (loop (enclosing-environment env)))))
  (loop env))

(define env-0 the-empty-environment)
(define env-1 (extend-environment '(a b) '(1 2) env-0))
(define env-2 (extend-environment '(c d) '(3 4) env-1))
(define env-3 (extend-environment '(a b) '(3 6) env-2))

(assert (lookup-variable-value 'b env-3) 6)
(assert (make-unbound! 'b env-3) #t)
(assert (lookup-variable-value 'b env-3) 2)
(assert (make-unbound! 'b env-3) #t)
(assert (make-unbound! 'b env-3) #f)

(display "\nex-4.14 - map\n")

; Louis's implementation of map will not work because the evaluator will
; evaluate the lambda expression into a procedure list. The Scheme interpreter
; does not know how to evaluate that list. Hence, the operation fails.

(display "[answered]\n")

(display "\nex-4.15 - halts?\n")

(define (run-forever) (run-forever))

(define (try p)
  (if (halts? p p)
      (run-forever)
      'halted))

; Suppose (try try) runs forever then halts? evaluates to wrong and try returns
; halt. That is a contradiction. Suppose (try try) halts. Then halts? evaluates
; to true and try runs forever; again a contradiction. Therefore, a general
; procedure halts? cannot exist.

(display "[answered]\n")

(display "\nex-4.16 - scan-out-defines\n")

(define (lookup-variable-value var env)
  (let ((pair (find-pair-env var env)))
    (if (eq? pair #f)
      (error "Unbound variable" var)
      (let ((value (frame-val pair)))
        (if (eq? value '*unassigned*)
          (error "Unassigned variable" var)
          value)))))

(define (scan-out-defines body)
  (define (get-defines body)
    (cond
      ((null? body) '())
      ((definition? (car body)) (cons (car body) (get-defines (cdr body))))
      (else (get-defines (cdr body)))))
  (define (expression->new-expression exp)
    (if (definition? exp)
      (define->set exp)
      exp))
  (define (define->let-assignment def)
    (list (definition-variable def) '*unassigned*))
  (define (define->set def)
    (list 'set! (definition-variable def) (definition-value def)))
  (let* ((defines (get-defines body))
         (let-assignments (map define->let-assignment defines))
         (let-expression (list 'let let-assignments))
         (expressions (map expression->new-expression body)))
    (append let-expression expressions)))

(define body
  '((define x 3)
    (if #t 1 2)
    (define b 2)
    (display "hello")))

(define body-transformed
  '(let ((x *unassigned*)
         (b *unassigned*))
     (set! x 3)
     (if #t 1 2)
     (set! b 2)
     (display "hello")))

(assert (scan-out-defines body) body-transformed)

; I would install scan-out-defines into make-procedure. We might run into a
; situation where we update the body of a procedure and call procedure-body
; twice.

(define (make-procedure parameters body env)
  (list 'procedure parameters (scan-out-defines body) env))

(display "\nex-4.17\n")

; Why is there an extra frame in the transformed program? We have implemented
; let via an additional transformation. Therefore, there is another
; lambda-expression that results in an extra frame.

; Explain why this difference in environment structure can never make a
; difference in the behavior of a correct program? The transformation keeps the
; order of the assignments. Hence, the behavior will not change.

; Design a way to make the interpreter implement the ``simultaneous'' scope
; rule for internal definitions without constructing the extra frame? We could
; simply add a list of (define symbol *unassigned*) at the beginning of the
; body and get the same behavior without an extra frame.

(display "[answered]\n")

(display "\nex-4.18 - alternative-scan-out\n")

(define (solve f y0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (stream-map f y))
  y)

; Transformation from text:
(lambda (f y0 dt)
  (let ((y '*unassigned*)
        (dy '*unassigned*))
    (set! y (integral (delay dy) y0 dt))
    (set! dy (stream-map f y))
    y))

; Transformation from this exercise:
(lambda (f y0 dt)
  (let ((y '*unassigned*)
        (dy '*unassigned*))
    (let ((a (integral (delay dy) y0 dt))
          (b (stream-map f y)))
      (set! y a)
      (set! dy b)
      y)))

; The second transformation will not work because when b is evaluated y is not
; yet assigned. The first transformation works because y was already set when
; dy is set.

(display "[answered]\n")

(display "\nex-4.19\n")

; (display "\nex-4.20\n")