/
chap_35.scm
102 lines (94 loc) · 2.51 KB
/
chap_35.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
;;
;; Chapter 3.5 - Improving Variable Access
;;
(require "./3imp")
; p.64
(define (compile x e next)
(cond
[(symbol? x)
(list 'refer (compile-lookup x e) next)]
[(pair? x)
(record-case x
[quote (obj)
(list 'constant obj next)]
[lambda (vars body)
(list 'close
(compile body (extend* e vars) '(return))
next)]
[if (test then else)
(let ([thenc (compile then e next)]
[elsec (compile else e next)])
(compile test e (list 'test thenc elsec)))]
[set! (var x)
(let ([access (compile-lookup var e)])
(compile x e (list 'assign access next)))]
[call/cc (x)
(let ([c (list 'conti
(list 'argument
(compile x e '(apply))))])
(if (tail? next)
c
(list 'frame next c)))]
[else
(recur loop ([args (cdr x)]
[c (compile (car x) e '(apply))])
(if (null? args)
(if (tail? next)
c
(list 'frame next c))
(loop (cdr args)
(compile (car args)
s
(list 'argument c)))))])]
[else
(list 'constant x next)]))
; p.65
(define (extend* e r) (cons r e))
(define (compile-lookup var e)
(recur nxtlib ([e e] [rib 0])
(recur nxtelt ([vars (car e)] [elt 0])
(cond
[(null? vars) (nxtrib (cdr e) (+ rib 1))]
[(eq? (car vars) var) (cons rib elt)]
[else (nxtelt (cdr vars) (+ elt 1))]))))
; p.66
(define (VM a x e r s)
(record-case x
[halt () a]
[refer (var x)
(VM (car (lookup var e)) x e r s)]
[constant (obj x)
(VM obj x e r s)]
[close (body x)
(VM (closure body e) x e r s)]
[test (then else)
(VM a (if a then else) e r s)]
[assign (var x)
(set-car! (lookup var e) a)
(VM a x e r s)]
[conti (x)
(VM (continuation s) x e r s)]
[nuate (s var)
(VM (car (lookup var e)) '(return) e r s)]
[frame (ret x)
(VM a x e '() (call-frame ret e r s))]
[argument (x)
(VM a x e (cons a r) s)]
[apply ()
(record (body e) a
(VM a body (extend* e r) '() s))]
[return ()
(record (x e r s) s
(VM a x e r s))]))
(define (closure body e) (list body e))
; p.67
(define (continuation s)
(closure (list 'nuate s '(0 . 0)) '()))
(define (lookup access e)
(recur nxtrib ([e e] [rib (car access)])
(if (= rib 0)
(recur nxtelt ([r (car e)] [elt (cdr access)])
(if (= elt 0)
r
(nxtelt (cdr r) (- elt 1))))
(nxtrib (cdr e) (- rib 1)))))