From 36f9f625ea642fcc0fb865276e89a4ee24cc8aab Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Wed, 24 Feb 2021 12:50:17 -0500
Subject: [PATCH] Implement till 4.52

---
 ex-4_45-xx.scm        | 70 ++++++++++++++++++++++++++++++++++++++++---
 misc/sicp-ambeval.scm | 20 +++++++++++++
 2 files changed, 86 insertions(+), 4 deletions(-)

diff --git a/ex-4_45-xx.scm b/ex-4_45-xx.scm
index e42fe20..0f2aaf6 100644
--- a/ex-4_45-xx.scm
+++ b/ex-4_45-xx.scm
@@ -319,9 +319,71 @@
 ; because we used list-amb to get amb behavior. We would need list-ramb which would
 ; require shuffling the items inside the evalutor or use something like apply.
 
-(display "\nex-4.51\n")
+(display "\nex-4.51 - permanent-set!\n")
 
-(display "\nex-4.52\n")
-; (display "\nex-4.53\n")
-; (display "\nex-4.54\n")
+(amball '(begin
+(define count 0)
+(let ((x (amb 'a 'b 'c))
+      (y (amb 'a 'b 'c)))
+  (permanent-set! count (+ count 1))
+  (require (not (eq? x y)))
+  (list x y count))
+))
+
+; With set! all counts would be 1. With permanent-set! every tried combination
+; increments the counts. Hence, all counts are unique and count increments up
+; to 9. (c c) would be nine and (b c) is eight.
+
+(define (last xs)
+  (if (null? (cdr xs))
+    (car xs)
+    (last (cdr xs))))
+
+(assert (first result) '(a b 2))
+(assert (last result) '(c b 8))
+
+(display "\nex-4.52 - if-fail\n")
+
+; Exercise 4.52.  Implement a new construct called if-fail that permits the
+; user to catch the failure of an expression. If-fail takes two expressions. It
+; evaluates the first expression as usual and returns as usual if the
+; evaluation succeeds. If the evaluation fails, however, the value of the
+; second expression is returned, as in the following example:
+
+(define (analyze-if-fail exp)
+  (let ((a (analyze (if-fail-first exp)))
+        (b (analyze (if-fail-second exp))))
+    (lambda (env succeed fail)
+      (a env
+         (lambda (a-value fail2) (succeed a-value fail))
+         (lambda () (b env succeed fail))))))
+
+;;; Amb-Eval input:
+(amball '(begin
+
+(define (even? n)
+  (= (remainder n 2) 0))
+
+(if-fail (let ((x (amb 1 3 5)))
+           (require (even? x))
+           x)
+         'all-odd)
+))
+
+(assert (first result) 'all-odd)
+
+(amball '(begin
+(if-fail (let ((x (amb 1 3 5 8)))
+           (require (even? x))
+           x)
+         'all-odd)
+))
+
+(assert (first result) 8)
+
+
+(display "\nex-4.53\n")
+
+
+(display "\nex-4.54\n")
 
diff --git a/misc/sicp-ambeval.scm b/misc/sicp-ambeval.scm
index 9766d18..e83b6bf 100644
--- a/misc/sicp-ambeval.scm
+++ b/misc/sicp-ambeval.scm
@@ -105,6 +105,9 @@
 (define (assignment? exp)
   (tagged-list? exp 'set!))
 
+(define (permanent-assignment? exp)
+  (tagged-list? exp 'permanent-set!))
+
 (define (assignment-variable exp) (cadr exp))
 
 (define (assignment-value exp) (caddr exp))
@@ -377,8 +380,10 @@
         ((quoted? exp) (analyze-quoted exp))
         ((variable? exp) (analyze-variable exp))
         ((assignment? exp) (analyze-assignment exp))
+        ((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)))
@@ -432,6 +437,10 @@
              ;; failure continuation for evaluating the predicate
              fail))))
 
+(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-sequence exps)
   (define (sequentially a b)
     (lambda (env succeed fail)
@@ -480,6 +489,17 @@
                             (fail2)))))
              fail))))
 
+(define (analyze-permanent-assignment exp)
+  (let ((var (assignment-variable exp))
+        (vproc (analyze (assignment-value exp))))
+    (lambda (env succeed fail)
+      (vproc env
+             (lambda (val fail2)
+                 (set-variable-value! var val env)
+                 (succeed 'ok
+                          (lambda () (fail2))))
+             fail))))
+
 ;;;Procedure applications
 
 (define (analyze-application exp)