felixm/SICP
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement 5.42

Browse Source
This commit is contained in:
Felix Martin
2021-04-23 21:29:05 -04:00
parent 54bc6725f3
commit ff4fa9e844
2 changed files with 74 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
misc/sicp-compiler-lexical-addressing.scm
View File

@@ -88,26 +88,37 @@
`((assign ,target (const ,(text-of-quotation exp)))))))
(define (compile-variable exp ct-env target linkage)
(end-with-linkage linkage
(make-instruction-sequence '(env) (list target)
`((assign ,target
(op lookup-variable-value)
(const ,exp)
(reg env))))))
(let ((adr (find-variable exp ct-env)))
(if (eq? adr 'not-found)
(end-with-linkage linkage
(make-instruction-sequence '(env) (list target 'env)
`((assign env (op get-global-environment) (reg env))
(assign ,target
(op lookup-variable-value)
(const ,exp)
(reg env)))))
(end-with-linkage linkage
(make-instruction-sequence '(env) (list target)
`((assign ,target
(op lexical-address-lookup)
(const ,adr)
(reg env))))))))
(define (compile-assignment exp ct-env target linkage)
(let ((var (assignment-variable exp))
(get-value-code
(compile (assignment-value exp) 'val 'next)))
(end-with-linkage linkage
(preserving '(env)
get-value-code
(make-instruction-sequence '(env val) (list target)
`((perform (op set-variable-value!)
(const ,var)
(reg val)
(reg env))
(assign ,target (const ok))))))))
(let* ((var (assignment-variable exp))
(get-value-code (compile (assignment-value exp) ct-env 'val 'next))
(adr (find-variable var ct-env)))
(if (eq? adr 'not-found)
(error "var not found -- compile-assignment" var)
(end-with-linkage linkage
(preserving '(env)
get-value-code
(make-instruction-sequence '(env val) (list target)
`((perform (op lexical-address-set!)
(const ,adr) ;; (const ,var) before
(reg val)
(reg env))
(assign ,target (const ok)))))))))
(define (compile-definition exp ct-env target linkage)
(let ((var (definition-variable exp))