Chapter 4, Metalinguistic Abstraction

Exercise 4.11


One thing to note is use of assoc that we saw in chapter-3 for table lookup(list of pairs).

Another point is we need a dummy symbol ‘table in frame - i forgot it and figured later when things didn’t work :(

(On a side note - I feel cons, car, cdr for list manipulations are not very pleasant to work)

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
;; we need cons to contain list of pairs.
;; the reason is same as when we build tables in ch-3:
;; if we add at beginning of list or pairs
;; it will change the initial point of the pairs.
;; thus we need a place to point to the head of this list. 
(define (make-frame variables values)
  (cons 'table (map cons variables values)))

;;not required in this impl
;;(define (frame-variables frame) (car frame))
;;(define (frame-values frame) (cdr frame))

(define (frame-pairs frame) (cdr frame))

(define (add-binding-to-frame! var val frame)
  (set-cdr! frame (cons (cons var val) (cdr frame))))

(define (lookup-variable-value var env)
  (define (env-loop env)
	(if (eq? env the-empty-environment)
		(error "Unbound variable" var)
		;;assoc - we saw in ch-3 to lookup in a table.
		(let ((pair (assoc var (frame-pairs (first-frame env)))))
          (if pair
			  (cdr pair)
			  (env-loop (enclosing-environment env))))))
  (env-loop env))

(define (set-variable-value! var val env)
  (define (env-loop env)
	(if (eq? env the-empty-environment)
		(error "Unbound variable" var)
		;;assoc - we saw in ch-3 to lookup in a table.
		(let ((pair (assoc var (frame-pairs (first-frame env)))))
          (if pair
			  (set-cdr! pair val)
			  (env-loop (enclosing-environment env))))))
  (env-loop env))

(define (define-variable! var val env)
  (let ((pair (assoc var (frame-pairs (first-frame env)))))
	(if pair
		(set-cdr! pair val)
		(add-binding-to-frame! var val (first-frame env))
		)))

For testing I executed few examples from previous exercises that I worked:

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
;;; M-Eval input:
(for iter '(a b) iter)

;;; M-Eval value:
metacircular-evaluator-loaded

;;; M-Eval input:

;;; M-Eval value:
b

;;; M-Eval input:
(define (fib n)
  (let fib-iter ((a 1)
                 (b 0)
                 (count n))
    (if (= count 0)
        b
        (fib-iter (+ a b) a (- count 1)))))

;;; M-Eval value:
ok

;;; M-Eval input:
(fib 10)

;;; M-Eval value:
55