111 lines
3.7 KiB
Scheme
111 lines
3.7 KiB
Scheme
(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")
|
|
|