-
Notifications
You must be signed in to change notification settings - Fork 2
/
lexical-env.scm
194 lines (158 loc) · 6.31 KB
/
lexical-env.scm
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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
(define-library (lexical-env)
(export make-empty-lexical-env
global-lexical-env?
add-new-top-level-frame
add-new-lexical-frame
add-new-local-frame
add-new-local-temporaries-frame
find-variable
frame-index
var-index
update-additional-info
additional-info
global-address?
env-get-additional-info
env-find-additional-info
env-var-index-offset)
(import (scheme base)
(scheme cxr)
(lists))
(begin
(define (make-empty-lexical-env) '())
(define (add-frame lexical-env frame)
(cons frame lexical-env))
(define (head-frame lexical-env)
(car lexical-env))
(define (rest-frames lexical-env)
(cdr lexical-env))
(define (global-lexical-env? lexical-env)
(and (not (null? lexical-env))
(null? (base-env (head-frame lexical-env)))))
(define (make-frame-with-variables
frame-index-offset
var-index-offset
variables
base-env
additional-info-map)
(list
(list frame-index-offset var-index-offset (length variables))
(reverse variables)
base-env
additional-info-map))
(define (make-local-temporaries-frame var-index-offset n base-env)
(list (list 0 var-index-offset n) '() base-env '()))
(define (make-update-additional-info-frame lexical-env update-additional-info)
(let ((base-frame (head-frame lexical-env)))
(list
(list 0 (var-index-offset base-frame) (var-count base-frame))
(reversed-frame-variables base-frame)
(base-env base-frame)
(update-additional-info (frame-additional-info-map base-frame)))))
(define (make-lexical-frame variables base-env additional-info-map)
(make-frame-with-variables 1 0 variables base-env additional-info-map))
(define (make-local-frame var-index-offset variables base-env additional-info-map)
(make-frame-with-variables 0 var-index-offset variables base-env additional-info-map))
(define (frame-indices frame)
(car frame))
(define (frame-index-offset frame)
(car (frame-indices frame)))
(define (var-index-offset frame)
(cadr (frame-indices frame)))
(define (var-count frame)
(caddr (frame-indices frame)))
(define (last-var-index frame)
(+ (var-count frame) -1 (var-index-offset frame)))
(define (env-var-index-offset lexical-env)
(if (null? lexical-env)
0
(var-index-offset (head-frame lexical-env))))
(define (reversed-frame-variables frame)
(cadr frame))
(define (base-env frame)
(caddr frame))
(define (frame-additional-info-map frame)
(cadddr frame))
(define (frame-get-additional-info var frame)
(map cadr
(filter
(lambda (entry) (eq? (car entry) var))
(frame-additional-info-map frame))))
(define (env-get-additional-info var lexical-env)
(if (null? lexical-env)
'()
(frame-get-additional-info var (head-frame lexical-env))))
(define (env-find-additional-info pred lexical-env)
(find pred (frame-additional-info-map (head-frame lexical-env))))
(define (add-new-lexical-frame lexical-env variables additional-info-map)
(add-frame
lexical-env
(make-lexical-frame variables lexical-env additional-info-map)))
(define (add-new-top-level-frame lexical-env var-index-offset variables additional-info-map)
(add-frame
lexical-env
(make-local-frame var-index-offset variables lexical-env additional-info-map)))
(define (next-free-local-var-index lexical-env)
(if (global-lexical-env? lexical-env)
0
(let* ((curr-frame (head-frame lexical-env))
(curr-frame-length (var-count curr-frame))
(curr-var-index-offset (var-index-offset curr-frame)))
(+ curr-var-index-offset curr-frame-length))))
(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)
(add-frame
lexical-env
(make-local-frame
(next-free-local-var-index lexical-env)
variables
lexical-env
additional-info-map))))
(define (add-new-local-temporaries-frame lexical-env n)
(if (null? lexical-env)
(error "Internal compiler error: cannot add new local temporaries frame to an empty environment" n)
(add-frame
lexical-env
(make-local-temporaries-frame (next-free-local-var-index lexical-env) n lexical-env))))
(define (update-additional-info lexical-env proc)
(if (null? lexical-env)
(error "Internal compiler error: cannot update additional info of empty environment")
(add-frame
lexical-env
(make-update-additional-info-frame lexical-env proc))))
(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 (reversed-frame-variables (head-frame lexical-env)))
(frame-index 0)
(var-index (last-var-index (head-frame lexical-env))))
(cond ((null? vars)
(let ((next-env (rest-frames env)))
(if (null? next-env)
#f
(let ((curr-frame (head-frame env))
(next-frame (head-frame next-env)))
(scan next-env
(reversed-frame-variables next-frame)
(+ frame-index (frame-index-offset curr-frame))
(last-var-index next-frame))))))
((eq? (car vars) var)
(make-lexical-address
frame-index
var-index
env
(frame-get-additional-info var (head-frame env))))
(else
(scan env (cdr vars) frame-index (- var-index 1)))))))
))