]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex4_11.rkt
rewrite `quote->cons' using `match'.
[sicp.git] / src / sicp / ex4_11.rkt
1 #lang r5rs
2
3 (define (error x)
4   (display x)
5   (newline))
6
7 (define (make-frame variables values)
8   (if (not (= (length variables)
9               (length values)))
10       (error "Number of variables and values should be the same -- MAKE-FRAME")
11       (map cons variables values)))
12
13 (define (frame-variables frame)
14   (map car frame))
15
16 (define (frame-values frame)
17   (map cdr frame))
18
19 (define (add-binding-to-frame! var val frame)
20   (define (add-to-end-of-frame! b f)
21     (if (null? (cdr f))
22         (set-cdr! f b)
23         (add-to-end-of-frame! b (cdr f))))
24   (add-to-end-of-frame! (cons var val) frame))
25
26 (define (lookup-variable-value var env)
27   (define (env-loop env)
28     (define (scan frame)
29       (if (null? frame)
30           (env-loop (enclosing-environment env))
31           (let ((p (car frame)))
32             (if (eq? var (car p))
33                 (cdr p)
34                 (scan (cdr frame))))))
35     (if (eq? env the-empty-environment)
36         (error "variable not defined")
37         (let ((f (first-frame env)))
38           (scan f))))
39   (env-loop env))
40
41 (define (set-variable-value! var val env)
42   (define (env-loop env)
43     (define (scan frame)
44       (if (null? frame)
45           (env-loop (enclosing-environment env))
46           (let ((p (car frame)))
47             (if (eq? var (car p))
48                 (set-cdr! p val)
49                 (scan (cdr frame))))))
50     (if (eq? env the-empty-environment)
51         (error "variable not defined")
52         (let ((f (first-frame env)))
53           (scan f))))
54   (env-loop env))
55
56 (define (define-variable! var val env)
57   (let ((frame (first-frame env)))
58     (define (scan frame)
59       (if (null? frame)
60           (add-binding-to-frame var val frame)
61           (let ((p (car frame)))
62             (if (eq? (car p) var)
63                 (set-cdr! p val)
64                 (scan (cdr frame))))))
65     (scan frame)))