forked from samirose/sicp-compiler-project
-
Notifications
You must be signed in to change notification settings - Fork 0
/
lexical-env.sls
112 lines (90 loc) · 3.75 KB
/
lexical-env.sls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
#!r6rs
(library
(lexical-env)
(export make-empty-lexical-env global-lexical-env?
add-new-lexical-frame add-new-local-frame add-new-local-temporaries-frame
find-variable frame-index var-index additional-info global-address?
env-get-additional-info env-var-index-offset)
(import (rnrs base)
(rnrs lists)
(lists))
(define (make-empty-lexical-env) '())
(define (global-lexical-env? lexical-env)
(and (not (null? lexical-env))
(null? (cdr lexical-env))))
(define (make-lexical-frame variables additional-info-map)
(list (cons 1 0) variables additional-info-map))
(define (make-local-frame lexical-env variables additional-info-map)
(let ((vars-offset
(if (global-lexical-env? lexical-env)
0
(let* ((curr-frame (car lexical-env))
(curr-frame-length (length (frame-variables curr-frame)))
(curr-var-index-offset (var-index-offset curr-frame)))
(+ curr-var-index-offset curr-frame-length)))))
(list (cons 0 vars-offset) variables additional-info-map)))
(define (frame-index-offset frame)
(caar frame))
(define (var-index-offset frame)
(cdar frame))
(define (env-var-index-offset lexical-env)
(if (null? lexical-env)
0
(var-index-offset (car lexical-env))))
(define (frame-variables frame)
(cadr frame))
(define (frame-additional-info-map frame)
(caddr frame))
(define (frame-get-additional-info var frame)
(cond ((assq var (frame-additional-info-map frame)) => cdr)
(else '())))
(define (env-get-additional-info var lexical-env)
(if (null? lexical-env)
'()
(frame-get-additional-info var (car lexical-env))))
(define (add-new-lexical-frame lexical-env variables additional-info-map)
(cons (make-lexical-frame variables additional-info-map)
lexical-env))
(define (add-new-local-frame lexical-env variables additional-info-map)
(if (null? lexical-env)
(error "Internal compiler error: cannot add new local frame to an empty environment" variables)
(cons (make-local-frame lexical-env variables additional-info-map)
lexical-env)))
(define (add-new-local-temporaries-frame lexical-env n)
(add-new-local-frame lexical-env (make-list '() n) '()))
(define (make-lexical-address frame-index var-index lexical-env additional-info)
(list frame-index var-index lexical-env additional-info))
(define (frame-index lexical-address)
(car lexical-address))
(define (var-index lexical-address)
(cadr lexical-address))
(define (global-address? lexical-address)
(global-lexical-env? (caddr lexical-address)))
(define (additional-info lexical-address)
(cadddr lexical-address))
(define (find-variable var lexical-env)
(if (null? lexical-env)
#f
(let scan ((env lexical-env)
(vars (frame-variables (car lexical-env)))
(frame-index 0)
(var-index (env-var-index-offset lexical-env)))
(cond ((null? vars)
(let ((next-env (cdr env)))
(if (null? next-env)
#f
(let ((curr-frame (car env))
(next-frame (car next-env)))
(scan next-env
(frame-variables next-frame)
(+ frame-index (frame-index-offset curr-frame))
(var-index-offset next-frame))))))
((eq? (car vars) var)
(make-lexical-address
frame-index
var-index
env
(frame-get-additional-info var (car env))))
(else
(scan env (cdr vars) frame-index (+ var-index 1)))))))
)