blob: 4917a405f30151464d6134c30fa68be89069df0a (
plain)
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
|
(define-module (environment)
#: export (lookup-variable-value
setup-environment
set-variable-value!
define-variable!
extend-env))
(add-to-load-path ".")
(use-modules (prelude/primitives))
;;; env
(define (enclosing-env environ) (cdr environ))
(define (first-frame environ) (car environ))
(define the-empty-env '())
(define (empty-env? environ) (eq? environ the-empty-env))
;; frames
(define (make-frame variables values)
(cons variables values))
(define frame-variables car)
(define frame-values cdr)
(define (add-binding-to-frame! var val frame)
(begin
(set-car! frame (cons var (frame-variables frame)))
(set-cdr! frame (cons val (frame-values frame)))))
(define (extend-env vars vals base-env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals) base-env)
(error "Too few or too many arguments supplied" vars vals)))
;;; variable lookup
(define (lookup-variable-value var env)
(cond
[(empty-env? env) (error "Unbound variable" var)]
[else
(let ([f (first-frame env)])
(let scan ([variables (frame-variables f)]
[values (frame-values f)])
(cond
[(null? variables)
(lookup-variable-value var
(enclosing-env env))]
[(eq? var (car variables)) (car values)]
[else (scan (cdr variables) (cdr values))])))]))
;;; environment modification
(define (set-variable-value! var val env)
(cond
[(empty-env? env) (error "Unbound variable" var)]
[else
(let ([f (first-frame env)])
(let scan ([variables (frame-variables f)]
[values (frame-values f)])
(cond
[(null? variables) (set-variable-value!
var
val
(enclosing-env env))]
[(eq? var (car variables)) (set-car! values val)]
[else (scan (cdr variables) (cdr values))])))]))
(define (define-variable! var val env)
(let ([f (first-frame env)])
(define (scan vars vals)
(cond
[(null? vars) (add-binding-to-frame! var val f)]
[(eq? var (car vars)) (set-car! vals val)]
[else (scan (cdr vars) (cdr vals))]))
(scan (frame-variables f)
(frame-values f))))
(define (setup-environment)
(let ([initial-env (extend-env
(primitive-names)
(primitive-objs)
the-empty-env)])
(define-variable! 'true #t initial-env)
(define-variable! 'false #f initial-env)
initial-env))
|
