Chapter 4, Metalinguistic Abstraction
Exercise 4.12
That’s interesting.
Note: I implemented it on top of previous exercise.
I think the way book has given the code, it seemed that they already hinted that we traverse in environment and frame to find the correct pair.
So, implementing a generic find is the way to go!
find
excepts 3 arguments:
contains?
: when an element is passed it checks whether that element contains the required “thing”! If found, it returns that “thing” or returns false.next
: thats to go to the next element - in our case we need this to go to next environment, or next pair.data
Now, an interesting happened! I realised that assoc
can be implemented using find
! So, need not to use mit scheme’s version or ch-3 code for assoc
find-pair
, implemented using find
again, returns the pair that contains the variable else returns false.
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
(define (find contains? next data)
(if (null? data)
#f
(let ((found (contains? data)))
(if found
found
(find contains? next (next data))))))
(define (assoc var table)
(find (lambda(tbl)
(let ((pair (car tbl)))
(if (eq? (car pair) var)
pair
#f)))
cdr
table))
(define (find-pair var env)
(find (lambda(e)
(assoc var (frame-pairs (first-frame e))))
enclosing-environment
env))
(define (lookup-variable-value var env)
(let ((pair (find-pair var env)))
(if pair
(cdr pair)
(error "Unbound variable" var))))
(define (set-variable-value! var val env)
(let ((pair (find-pair var env)))
(if pair
(set-cdr! pair val)
(error "Unbound variable" var))))
(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))
)))
Output:
Well, I tried few examples from previous exercise that involves creation of variables, lambdas…
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
;;; 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:
metacircular-evaluator-loaded
;;; M-Eval input:
;;; M-Eval value:
ok
;;; M-Eval input:
(fib 10)
;;; M-Eval value:
55
;;; M-Eval input:
(for iter '(a b) iter)
;;; M-Eval value:
b
;;; M-Eval input:
(define proc (lambda () '((1 a) (2 b))))
;;; M-Eval value:
ok
;;; M-Eval input:
(for item (proc) (display item))
(1 a)(2 b)
;;; M-Eval value:
#!unspecific
;;; M-Eval input:
(for item (proc) (display item) 'done)
(1 a)(2 b)
;;; M-Eval value:
done
;;; M-Eval input:
(fib 5)
;;; M-Eval value:
5