Add exercise 4.52 (if-fail)

mceval/amb-natural-language.rkt

@@ -391,3 +391,50 @@ try-again
 
 ;; Using set! instead of permanent-set! resets the counter back to 0
 ;; on each backtrack of x or y, so will always be 1.
+
+
+;; Exercise 4.52
+
+;;; Amb-Eval input:
+
+;;; 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:
+0
+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:
+0
+8
+
+;;; Amb-Eval input:
+try-again
+
+
+;;; Amb-Eval value:
+4
+all-odd
+
+;;; Amb-Eval input:
+try-again
+
+;;; There are no more values of
+7
+(if-fail (let ((x (an-element-of (quote (1 3 5 8))))) (require (even? x)) x) (quote all-odd))
+

mceval/ambeval.rkt

@@ -32,6 +32,7 @@
         ((permanent-assignment? exp) (analyze-permanent-assignment exp))
         ((definition? exp) (analyze-definition exp))
         ((if? exp) (analyze-if exp))
+        ((if-fail? exp) (analyze-if-fail exp))
         ((lambda? exp) (analyze-lambda exp))
         ((begin? exp) (analyze-sequence (begin-actions exp)))
         ((cond? exp) (analyze (cond->if exp)))
@@ -228,6 +229,14 @@
                                        (try-next (rest-choices choices)))))))
       (try-next cprocs))))
 
+;; if-fail is used to catch failure of an expression
+(define (analyze-if-fail exp)
+  (let ((tproc (analyze (if-fail-test exp)))
+        (cproc (analyze (if-fail-consequent exp))))
+    (lambda (env succeed fail)
+      ;; Use cproc instead of the passed fail procedure
+      (tproc env succeed (lambda () (cproc env succeed fail))))))
+
 ;;;Driver loop
 
 (define input-prompt ";;; Amb-Eval input:")

mceval/environment.rkt

@@ -186,6 +186,7 @@
         (list 'abs abs)
         (list 'max max)
         (list 'remainder remainder)
+        (list 'even? even?)
         (list 'integer? integer?)
         (list 'sqrt sqrt)
         (list 'eq? eq?)

mceval/syntax.rkt

@@ -480,3 +480,12 @@
   (cadr exp))
 (define (cons-second-exp exp)
   (caddr exp))
+
+
+;; Exercise 4.52
+(define (if-fail? exp)
+  (tagged-list? exp 'if-fail))
+(define (if-fail-test exp)
+  (cadr exp))
+(define (if-fail-consequent exp)
+  (caddr exp))