Chapter 4, Metalinguistic Abstraction

Exercise 4.52


1
2
3
4
5
6
7
8
9
10
11
12
(define (if-fail? exp) (tagged-list? exp 'if-fail))
(define (if-fail-first exp) (cadr exp))
(define (if-fail-second exp) (caddr exp))

(define (analyze-if-fail exp)
  (let ((first (analyze (if-fail-first exp)))
		(second (analyze (if-fail-second exp))))
	(lambda (env succeed fail)
	  (first env
			  succeed
			 (lambda()
			   (second env succeed fail))))))

For testing, First I defined these functions in global environment:

1
2
3
4
5
6
7
8
9
(define (require p)
    (if (not p) (amb)))

(define (an-element-of l)
  (require (not (null? l)))
  (amb (car l) (an-element-of (cdr l))))

(define (even? x) (= (remainder x 2) 0))
(define (odd? x) (not (even? x)))

Now, testing:

(Check last interesting example which i tested additionaly apart from the given in book)

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
;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5))))
           (require (even? x))
           x)
         'all-odd)

;;; Starting a new problem 

;;; Amb-Eval value:
all-odd

;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5 8))))
           (require (even? x))
           x)
         'all-odd)

;;; Starting a new problem 

;;; Amb-Eval value:
8

;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5))))
           (require (even? x))
           x)
         (let ((x (an-element-of '(1 3 5 18))))
           (require (even? x))
           x))

;;; Starting a new problem 

;;; Amb-Eval value:
18

;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5))))
           (require (even? x))
           x)
         (let ((x (an-element-of '(1 3 5))))
           (require (even? x))
           x))

;;; Starting a new problem 
;;; There are no more values of
(if-fail (let ((x (an-element-of (quote (1 3 5))))) (require (even? x)) x) (let ((x (an-element-of (quote (1 3 5))))) (require (even? x)) x))

;;; Amb-Eval input: