SICP/ex-5_39-xx.scm

(load "util.scm")
(load "misc/sicp-compiler-lexical-addressing.scm")

(define (compile-to-file code target linkage file-name)
  (set! label-counter 0)
  (define (write-list-to-port xs port)
    (if (null? xs)
      '()
      (begin
        (display (car xs) port)
        (display "\n" port)
        (write-list-to-port (cdr xs) port))))
  (if #t ; #t means write to file; #f means don't write to file
    (let* ((compile-result (compile code (empty-compile-time-env) target linkage))
           (assembly-insts (statements compile-result))
           (port (open-output-file file-name)))
      (write-list-to-port assembly-insts port)
      (display "[")
      (display file-name)
      (display "]\n")
      (close-output-port port))
      (begin
        (display "[")
        (display file-name)
        (display "]\n"))))

(display "\nex-5.39 - lexical-addressing\n")

(define (make-address frame-number index-number)
  (list frame-number index-number))
(define (frame-number address) (car address))
(define (index-number address) (cadr address))

(define test-env '((1 2 3) (4 5 6) (7 8 9)))

(define (lexical-address-frame frame-number env)
  (cond
    ((null? env)
     (error "frame does not exist - LEXICAL-ADDRESS-FRAME" adr env))
    ((= frame-number 0) (car env))
    (else (lexical-address-frame (- frame-number 1) (cdr env)))))

(define (lexical-address-lookup adr env)
  (define (iter-frame index-number frame)
    (cond
      ((null? frame) (error "index does not exist - LEXICAL-ADDRESS-LOOKUP" adr env))
      ((and (= index-number 0) (eq? (car frame) '*unassigned*))
       (error "var not assigned - LEXICAL-ADDRESS-LOOKUP" adr env))
      ((= index-number 0) (car frame))
      (else (iter-frame (- index-number 1) (cdr frame)))))
  (let ((frame (lexical-address-frame (frame-number adr) env)))
    (iter-frame (index-number adr) frame)))

(define (lexical-address-set! adr val env)
  (define (iter-frame index-number frame)
    (cond
      ((null? frame) (error "index does not exist - LEXICAL-ADDRESS-LOOKUP" adr env))
      ((= index-number 0) (set-car! frame val))
      (else (iter-frame (- index-number 1) (cdr frame)))))
  (let ((frame (lexical-address-frame (frame-number adr) env)))
    (iter-frame (index-number adr) frame)))

(assert (lexical-address-lookup (make-address 0 0) test-env) 1)
(lexical-address-set! (make-address 0 0) 42 test-env)
(assert (lexical-address-lookup (make-address 0 0) test-env) 42)
(assert (lexical-address-lookup (make-address 2 2) test-env) 9)
(lexical-address-set! (make-address 2 2) 43 test-env)
(assert (lexical-address-lookup (make-address 2 2) test-env) 43)


(display "\nex-5.40 - compile-time-env\n")

(define (empty-compile-time-env) '())

(define (extend-compile-time-env parameters base-env)
  (display base-env) (newline)
  (display parameters) (newline)
  (cons parameters base-env))

(compile-to-file
  '(let ((x 3) (y 4))
    (lambda (a b c d e)
      (let ((y (* a b x))
            (z (+ c d x)))
        (* x y z))))
  'val 'next "f-lex-adr.scm")

(display "\nex-5.41 - find-variable\n")

; Exercise 5.41.  Write a procedure find-variable that takes as arguments a
; variable and a compile-time environment and returns the lexical address of
; the variable with respect to that environment. For example, in the program
; fragment that is shown above, the compile-time environment during the
; compilation of expression <e1> is ((y z) (a b c d e) (x y)). Find-variable
; should produce

(define (find-variable var env) '9)

(assert (find-variable 'c '((y z) (a b c d e) (x y)))
        (make-address 1 2))

(assert (find-variable 'x '((y z) (a b c d e) (x y)))
        (make-address 2 0))

(assert (find-variable 'w '((y z) (a b c d e) (x y)))
        'not-found)

(display "\nex-5.42\n")
; (display "\nex-5.43\n")